Hi, I wanted to parse the last line of  a file and to draw 3 different color 
progress bar.

If he last line begins by tftpd the progress bar will grow in yellow.
        "       "       by ftpd                 ""         in blue
                        by DHCPD                ""        in green.
                        
my code seems to have a problem if there is a line with tftpd but it is not the 
last line the progress bar is still growing, why?
Another question about geometry manager is:

How can I do to only have 3 progress bar ie if the 3 progress bar are already 
present and if there is another tftpd, or ftpd, or DHCPD, in the last line, I 
wanted to delete the first corresponding progress bar.My file is growing anyway.
Because now it add always a progress bar so it make growing my GUI.

I send you my code thanks.                      
                                
#!/usr/local/bin/perl -w

use Tk;
use Win32::DriveInfo;
use Tk::ProgressBar;
use Win32::API;
use Win32;


#---------------- User Defined Declarations -----------------

my $status_var = 0;
my $lw=40; #width of labels
my $ethernet_address ='Ceci est un test'; #fixed for now
my $IP_address; #self-explanatory
my $client_name; #as is this
my $boot_file; #another -textvariable to be used
my $install_file_path;
my $SYSLOG='C:/CYGWIN_SYSLOG.TXT'; #your file to be parsed
my $dialog; #declare here, not in the sub
my $msdelay=5000; #5 second delay..until callback
my $mtime=1; #initialize to something other than $thistime
my $thistime=0; #variable to hold current 'stat' check
my $language="ENGLISH";
 

#------------------------ Main Program -----------------------
my $mw = MainWindow->new( -title => "Serveur d'installation "
                         );
$mw->geometry('570x500');
&setlanguage;
&makemenu;
&makeButtons;
&makeframe;

&makelabels;

my $Percent_Done = 100;           # Starting point


&makeProgressBar;

$image = $mw->Photo(-file => "logo_alcatel.gif");


&check_syslog($SYSLOG);
$mw->repeat($msdelay,[\&check_syslog,$SYSLOG]);



MainLoop;

#------------------------ Subroutines ------------------------
sub setlanguage
{
#static variables defined in main and changed in this sub

  if ($language eq 'ENGLISH')
 {
    $language_EA='Client Ethernet address';
    $language_IP='IP Address';
    $language_CN='Client Name';
    $language_BF='Boot File';
    $language_FP='Installation File Path';
  }
  elsif ($language eq 'FRENCH')
 {
    $language_EA='Adress Ethernet du Client';
    $language_IP='Adresse Ip Du Client';
    $language_CN='Nom du Client';
    $language_BF='Fichier';
    $language_FP='Chemin installation';
  }

}



sub restart_serv
{
        
        if( Win32::IsWin95() )
        
        {
                
                #for (sort keys %ENV) { print "$_is $ENV{$_}\n" }

                $PROG = "c:\\cygwin\\usr\\sbin\\inetd.exe";
                if (-f $PROG)
                {                               
                        system($PROG)
                }
                
                else
                {

                        require Tk::Dialog;
                        $dialog =$mw-> Dialog( -title => 'INETD ALERT ',
                        -text => "Fail to execute Inetd daemon",                
                        -font => "Arial 14 normal",
                        -justify => 'center',
                        -default_button => 'OK',
                        -bitmap =>'error',
                        -buttons => [qw/OK/] );

        
                        $dialog->Show;

                }

                #or die " je n'ai pas pu redémarrer : $!\n";

                

                


        }
        
        elsif( Win32::IsWinNT() )

        {

                system("net stop inetd");
                system("net start inetd"); 

        

        }

}

sub setdeletefile
{
        open(FILE, ">c:/cygwin_syslog.txt");
        close(FILE);
        $Status_Text = "$count lines read (0 %)";
        $mw->update;

}

sub makeframe
{
         $myframe=$mw->Frame(-label => "",
                   -relief => 'groove',
                   -borderwidth => 2)->pack(-anchor=>'w',pady =>40);
        

}

sub makelabels
{       
        
        #$mw->Label(-text=>"")->pack(-anchor=>'w',-side => 'top');
        #$mw->Label(-text=>"")->pack(-anchor=>'w',-side => 'top');
        #$mw->Label(-text=>"")->pack(-anchor=>'w',-side => 'top');
        $myframe->Label(-textvariable=>\$language_EA)->pack(-anchor=>'w');
        my $label1=$myframe->Label(-relief=>'sunken',
                              -textvariable=>\$ethernet_address,
                              -width=>$lw,
                              -anchor=>'w',
                              -bg=>'white')->pack(-anchor=>'w');

        $myframe->Label(-textvariable=>\$language_IP)->pack(-anchor=>'w');
        my $label2=$myframe->Label(-relief=>'sunken',
                              -textvariable=>\$IP_address,
                              -width=>$lw,
                              -anchor=>'w',
                              -bg=>'white')->pack(-anchor=>'w');
    
        $myframe->Label(-textvariable=>\$language_CN)->pack(-anchor=>'w');
        my $label3=$myframe->Label(-relief=>'sunken',
                              -textvariable=>\$client_name,
                              -width=>$lw,
                              -anchor=>'w',
                              -bg=>'white')->pack(-anchor=>'w');
    
        $myframe->Label(-textvariable=>\$language_BF)->pack(-anchor=>'w');
        my $label4=$myframe->Label(-relief=>'sunken',
                              -textvariable=>\$boot_file,
                              -width=>$lw,
                              -anchor=>'w',
                              -bg=>'white')->pack(-anchor=>'w');

        $myframe->Label(-textvariable=>\$language_FP)->pack(-anchor=>'w');
        my $label5=$myframe->Label(-relief=>'sunken',
                              -textvariable=>\$install_file_path,
                              -width=>$lw,
                              -anchor=>'w',
                              -bg=>'white')->pack(-anchor=>'w');

        #$mw->Label(-text => '')->pack(-anchor=>'w',-side => 'top',pady =>5);
        
}

sub check_syslog
{
        
        use Net::Ping;
        $p = Net::Ping->new();

        $host = "cu5s46";
        unless ($p->ping($host)) 
        {       
                require Tk::Dialog;
                $dialog =$mw-> Dialog( -title => 'NETWORK ALERT ',
                                       -text => "The network is down",          
                                       -font => "Arial 14 normal",
                                       -justify => 'center',
                                       -default_button => 'OK',
                                       -bitmap =>'error',
                                       -buttons => [qw/OK/] );

        
                $dialog->Show;
        }


        $p->close;      


        $PROG2="C:/cygwin/usr/sbin/in.tftpd.exe";
        unless(-f $PROG2)
        {
                        
                require Tk::Dialog;
                $dialog =$mw-> Dialog( -title => 'TFTPD ALERT ',
                                        -text => "Fail to execute TFTPD daemon",       
 
                                        -font => "Arial 14 normal",
                                        -justify => 'center',
                                        -default_button => 'OK',
                                        -bitmap =>'error',
                                        -buttons => [qw/OK/] );

        
                $dialog->Show;
        }






        $PROG3 = "C:/WINDOWS/arp.exe";
                unless(-f $PROG3)

                { 

                        require Tk::Dialog;
                        $dialog =$mw-> Dialog( -title => 'ARP ALERT ',
                        -text => "Program arp.exe not found \n".
                                  "You must reinstall\n".  
                                  "Microsoft TCP/IP",           
                        -font => "Arial 14 normal",
                        -justify => 'center',
                        -default_button => 'OK',
                        -bitmap =>'error',
                        -buttons => [qw/OK/] );

        
                        $dialog->Show;

                }


        $PROG4="C:/cygwin/usr/sbin/in.ftpd.exe";
        unless(-f $PROG4)
        {
                        
                require Tk::Dialog;
                $dialog =$mw-> Dialog( -title => 'FTPD ALERT ',
                                        -text => "Fail to execute FTPD daemon", 
                                        -font => "Arial 14 normal",
                                        -justify => 'center',
                                        -default_button => 'OK',
                                        -bitmap =>'error',
                                        -buttons => [qw/OK/] );

        
                $dialog->Show;
        }

        



        if( Win32::IsWin95() )
        {
        
                my ($f)=@_;
                $thistime=(stat($f))[9];
                return if ($thistime == $mtime);

                $mtime=$thistime;
                my $dummy;
                unless (open (FILE, $f))
                {
                        warn "Couldn't open file $f: $!";
                        return;
                }
                @lines=<FILE>;
                close (FILE);

                ($dummy, $IP_address, $read, $status)=split(":",$lines[$#lines-1]);
                $IP_address=~s/^\s*(.*)\s*$/$1/;
                ($client_name)=split(/\./,$IP_address);
                $read=~/.*bootp(.*)\s*/;
                $boot_file=$1;
                $read=~/.*(\/bootp.*)\s*/;
                $install_file_path=$1;

        

        }
        elsif( Win32::IsWinNT() )

        {
                #use Win32::EventLog;
        }


        open SYSLOG,"<c:/cygwin_syslog.txt" || die "can't open: $!";
        while (<SYSLOG>)
         {
                chomp;
                if (/^tftpd/)
                {
                
                        use Test;
                        my $var = 0;
                        my $pb  = $mw->ProgressBar(-bd => 3,
                                                   -relief => 'raised',
                                                   -fg => 'yellow',
                                                   -variable => \$var)->pack(-side 
=>'left',-anchor =>'w');
                
                        $pb->cget('-from');
                        $pb->cget('-to');

                        for my $v (map(10*$_+3,1..10))
                        {
                                $var = $v;
                                $pb->cget('-value');
                                $mw->update;
                                sleep 2; # This line added by Sisyphus
                        }
                        

                }


                
        if (/^ftpd/)
        {

                my $var = 0;
                my $pb  = $mw->ProgressBar(-bd => 3,
                                                   -relief => 'raised',
                                                   -fg => 'blue',
                                                -variable => \$var)
                                                ->pack(-side => 'left',-anchor =>'w');


                $pb->cget('-from');
                $pb->cget('-to');

                        for my $v (map(10*$_+3,1..10))
                        {
                                $var = $v;
                                $pb->cget('-value');
                                $mw->update;
                                sleep 2; # This line added by Sisyphus
                        }
                        

                }
        
                


        if (/^DHCP/)
        {

                my $var = 0;
                my $pb  = $mw->ProgressBar(-bd => 3,
                                                   -relief => 'raised',
                                                   -fg => 'green',
                                                -variable => \$var)
                                                ->pack(-side => 'left',-anchor =>'w');


                $pb->cget('-from');
                        $pb->cget('-to');

                        for my $v (map(10*$_+3,1..10))
                        {
                                $var = $v;
                                $pb->cget('-value');
                                $mw->update;
                                sleep 2; # This line added by Sisyphus
                        }
                        

                }
        
        }       


                
}


#------------------------ SUBROUTINE makemenu -------------------------

sub makemenu{
                my $menubar = $mw->Menu(-type => 'menubar',
                                        -relief=>'flat');

                $mw->configure(-menu => $menubar);

                my $mnu0 = $menubar->cascade(-label => '~Control',
                                             -tearoff => 0,
                                             -font => "Arial 8 normal"
                                             );

                $mnu0->command( -label => '~Quitter',
                                -font => "Arial 8 normal",
                                -command =>sub{$mw->destroy()});

                $mnu0->command( -label => '~Redemarrer',
                                -font => "Arial 8 normal",
                                -command =>sub{restart_serv});


                $mnu0->separator();

                my $mnu1 = $menubar->cascade(-label => '~Options',
                                             -tearoff => 0,
                                             -font => "Arial 8 normal"
                                             );

                my $cc = $mnu1->cascade(-label=>'~Language');

                $cc-> radiobutton (-label=>'Generic Alcatel',
                                   -variable => \$language,
                                   -value=>"ENGLISH",
                                   -command=>\&setlanguage);
                $cc-> radiobutton (-label=>'Au Francais',
                                   -variable => \$language,
                                   -value=>"FRENCH",
                                   -command=>\&setlanguage);

                #my $cc2 = $mnu1->cascade(-label=>'~Drive');

                #my $num_elements = @drives = Win32::DriveInfo::DrivesInUse();

                #for ($i=0;$i<$num_elements;$i++)
                #{

                        #$cc2-> radiobutton (-label=>$drives[$i]);
                #}

                #$mnu1->separator();

                my $mnu2 = $menubar->cascade(-label => '~Alcatel',
                                             -tearoff => 0,
                                             -font => "Arial 8 normal"
                                             );

                $mnu2->command( -label => 'A~bout',
                                 -font => "Arial 8 normal",
                                -command =>sub{about()}
                               );
        

} #end sub makemenu

sub about {

                unless (Exists($dialog)){
                require Tk::Dialog;
                $dialog =$mw-> Dialog( -title => 'About',
                                       -text => "Server d'installation Alcatel".       
                                         "Business Systems\n"
                                                . "$VERSION\n " .
                                                "Written by Jorge Goncalves, " .
                                               "goncal11\@col.bsf.com Version 1.0",
                                                -font => "Arial 8 normal",
                                                -justify => 'center',
                                                -default_button => 'Ok!',
                                                -bitmap =>'info',
                                                -image => $image,
                                                -buttons => [qw/Ok!/] );

        }
                 $dialog->Show;
} #end sub dialog



#-------------------------------SUBROUTINE PROGRESS
#BAR-------------------------
#-------

sub makeProgressBar
{
                

                
        #$mw->Button( -text => 'Cygwin_Syslog Size',
                     #-command => [\&READ_FILE,$0] ,
                     #-bg => 'skyblue2' ) -> pack( -anchor =>'nw');


                #$mw->Label( -textvariable => \$Status_Text , -text =>
                #'Progression')
                   # ->pack(-anchor=>'w');
                #my $bar = $mw->ProgressBar( -variable => \$Percent_Done,
                                            #-relief => 'sunken',
                                            #-width  => 15,
                                            #-length => 300,
                                            #-colors => [0, 'red'])
                                               #25, 'yellow',
                                               #50, 'red',
                                                #75,'black'] )
                                    #->pack(-anchor =>'nw');

        #$mw->Button( -text => 'Status servers',
         #           -command => [\&READ_FILE2,$0] ,
          #          -bg => 'skyblue2' ) -> pack( -anchor =>'nw');
                
                $mw->Label( -text => 'DHCP',
                     
                     -bg => 'green' ) -> pack(-side =>'top', -anchor =>'w',-pady =>3);

                $mw->Label( -text => 'TFTP',
                     
                     -bg => 'yellow' ) -> pack( -side =>'top', -anchor =>'w',-pady 
=>3);
                
                                
                $mw->Label( -text => 'FTP ',
                     
                     -bg => 'blue' ) -> pack( -side =>'top', -anchor =>'w',-pady =>3); 
                 




                #$mw->Label(-text=>"Etats des serveurs")->pack(-anchor=>'w');
                #my $bar2 = $mw->ProgressBar( -variable => \$Percent_Done2,
                 #                          -relief => 'sunken',
                  #                          -width  => 15,
                   #                        -length => 300,
                    #                       -colors => [0, 'green',
                     #                          30, 'yellow',
                      #                        60, 'blue',
                        #                       ] )
                         #           ->pack(-anchor =>'nw');

                

                
        
 }
sub READ_FILE
 {
        #my $Input_File = shift;
        my $Input_File='C:/CYGWIN_SYSLOG.TXT';
        my $total = -s $Input_File;     # Total bytes to process
        my $one_percent = int( $total/100 );
        my $count;                      # Lines read
        my $at;                         # Position in file
        my $target = $one_percent;      # Progress update target

        open( IN, $Input_File );
        while( <IN> )
         {
           $at += length( $_ );         # Bytes read
           $count++;                    # Lines read
           if( $at >= $target )
            {                           # Time to report progress
              my $percent = int( $at * 100 / $total );
              if( $percent != $Percent_Done )
               {                        # Only update 100 times
                 $Percent_Done = $percent;
                 $Status_Text = "$count lines read ($percent%)";
                 $mw->update;
               }
            }
        # Process input text
        }
        $Percent_Done = 100;

        #system("perl test.pl");

}


sub READ_FILE2
 {
        #my $Input_File = shift;
        my $Input_File='C:/CYGWIN_SYSLOG.TXT';
        my $total = -s $Input_File;     # Total bytes to process
        my $one_percent = int( $total/100 );
        my $count;                      # Lines read
        my $at;                         # Position in file
        my $target = $one_percent;      # Progress update target

        open( IN, $Input_File );
        while( <IN> )
         {
           $at += length( $_ );         # Bytes read
           $count++;                    # Lines read
           if( $at >= $target )
            {                           # Time to report progress
              my $percent = int( $at * 100 / $total );
              if( $percent != $Percent_Done2 )
               {                        # Only update 100 times
                 $Percent_Done2 = $percent;
                 $Status_Text = "$count lines read ($percent%)";
                 $mw->update;
               }
            }
        # Process input text
        }
        $Percent_Done2 = 100;

        #system("perl test.pl");

}







sub makeButtons
{


        my $bouton=$mw->Button(-bitmap => 'error',
                               -relief =>'raised',
                               -height =>'27',
                               -width => '27',
                               -cursor => 'pirate',
                               -command=>\&restart_serv)->pack(-side => 'left',
                                                                -anchor => 'n',
                                                                -padx => 3);
                                                                      

        my $bouton=$mw->Button(-bitmap => 'gray12',
                               -relief =>'raised',
                               -height =>'27',
                               -width => '27',
                               -cursor => 'pirate',
                               -command=>\&setdeletefile)->pack(-side => 'left',
                                                              -anchor => 'n',
                                                              -padx => 3);     

        my $bouton=$mw->Button(-bitmap => 'question',
                               -relief =>'raised',
                               -width => '27',
                               -cursor => 'question_arrow',
                               -command=>\&about)->pack(-anchor => 'n',
                                                        -side => 'left',
                                                        -padx => 3,
                                                        );   
  


                                                                            
               
                                                                

}
-- 
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]

Reply via email to