Category: Win32
Author/Contact Info ~~David~~
Description: I have to run a ton of things from the Windows scheduler. This app lets you run a bunch of scripts from the command line when supplied with 1 as the script argument. If run without any argument (such as double-clicked), it opens up the TK interface to add programs...
Update: added threading and better logging date / time stamp
use strict;
use warnings;

use Tk;
use File::Slurp;
use Cwd;
use DateTime;
use threads;

#=====================================================================
+==#
#-                             Globals                                
+ -#
#=====================================================================
+==#

my $cwd         = getcwd();             # get current working director
+y
my $files       = $cwd."\\files.txt";   # location of files.txt which 
+holds array of run data...
my @files       = ();                   # array of files and associate
+d data
my $runNow      = shift @ARGV;          # this is to provide auto runn
+ing by windows scheduler
my $num_lines   = 20;                   # number of lines to display
my $log_file    = $cwd."\\log.txt";     # log file name
my $timeZone    = 'America/Boise';      # time zone
my $toggle      = 1; 


#=====================================================================
+==#
#-                             Main                                   
+ -#
#=====================================================================
+==#

my @file   = read_file ( $files ) if ( -f $files );
chomp @file;

# create an array of file parameters for populating fields in GUI
foreach ( @file ){
    $_ =~ s/[\n;]//g;
    my @array = split ( /,/ , $_ );
    foreach ( @array ){ $_ =~ s/[\n\s]//g unless ( $_ =~ /C/ ) };
    push ( @files, \@array );
}

# if there are files to run, and we are running via command line, run 
+the files and then quit
if ( $runNow and @files ) { runFiles( \@files ); exit };

# if we aren't running by command line, lets make the tk interface


#=====================================================================
+==#
#-                             TK Stuff                               
+ -#
#=====================================================================
+==#

my $mw = MainWindow->new;
   $mw -> title("PerlRunner");
my $top_frame = $mw -> Frame( -borderwidth => 2 )->pack( -side => "top
+", -fill => "x" );
my $mid_frame = $mw -> Frame( -borderwidth => 2 )->pack( -side => "top
+", -fill => "x" );
my $bot_frame = $mw -> Frame( -borderwidth => 2 )->pack( -side => "top
+", -fill => "x" );

#Create Labels
my %labelColumns = (
    'On'        => 0,
    'Program'   => 1,
    'Browse'    => 2,
    'M'         => 3,
    'T'         => 4,
    'W'         => 5,
    'R'         => 6,
    'F'         => 7,
    'Sa'        => 8,
    'Su'        => 9,
);

# crate label headings
my %labels;
foreach ( keys %labelColumns ){
    $labels{$_} = $mid_frame -> Label( -text => "$_", -relief => "ridg
+e", -padx => 5 ) 
        -> grid( -column => $labelColumns{$_}, -row => 0, -padx => 0 )
+;
}

$labels{'On'} -> bind( '<Button1 ButtonRelease>', \&Toggle );

# create input spots
my ( @on, @prog, @M, @T, @W, @R, @F, @Sa, @Su, @time, @brow );

for ( 1 .. $num_lines ){
    my $index = $_ - 1;
    
    $mid_frame -> Checkbutton( -variable => \$files[$index][$labelColu
+mns{'On'}] )
        ->grid( -row=>$_, -column=>$labelColumns{'On'}, -padx => 5, -p
+ady => 5 );
    $prog[$_] = $mid_frame->Entry( -width => 100, -textvariable => \$f
+iles[$index][$labelColumns{'Program'}] )
        ->grid( -row=>$_, -column=>$labelColumns{'Program'}, -padx => 
+5, -pady => 5);
    $mid_frame->Button( -width => 3, -height => 1, -text => "...", -co
+mmand => sub{browse($index)} )
        ->grid( -row=>$_, -column=>$labelColumns{'Browse'}, -padx => 5
+, -pady => 5);    
    $files[$index][$labelColumns{'Browse'}] = undef;
    
    # Day Checkbuttons
    foreach my $days ( qw !M T W R F Sa Su! ){ 
        $mid_frame -> Checkbutton( -variable => \$files[$index][$label
+Columns{$days}] )
            ->grid( -row=>$_, -column=>$labelColumns{$days}, -padx => 
+0, -pady => 5 );
    }

}

$bot_frame->Button( -width => 6, -height => 2, -text => "Save", -comma
+nd => \&save )
        ->grid( -row=> 1, -column=> 1, -padx => 5, -pady => 5); 
$bot_frame->Button( -width => 7, -height => 2, -text => "Run Now", -co
+mmand => sub{runFiles( \@files )} )
        ->grid( -row=> 1, -column=> 2, -padx => 5, -pady => 5); 

MainLoop();


#=====================================================================
+==#
#-                             Subs                                   
+ -#
#=====================================================================
+==#

sub runFiles {

    my $files   = shift;
    my @files   = @$files;
    
    my $dateMT  = DateTime->now(time_zone => $timeZone);
    my $day     = $dateMT -> day_of_week;
    my $dayInd  = $day + 2;  #monday is actually the 3'rd index in the
+ array 
    
    my @filesToRun;   # this will be an array of files to run today...
    foreach ( @files ){
        if ( @{$_}[0] ){
            if ( @{$_}[$dayInd] ) { push ( @filesToRun, @{$_}[1] ) }
        }
    }
    
    my @thr;
    foreach ( @filesToRun ) {
        push( @thr, threads->new( \&runFile, $_ ) );
    }
    if ( $runNow ){
        foreach ( @thr ) { $_->join() } ;
    }
}

sub runFile{
    my $file = shift;
    logMe( $file, "RUN" );
    system( $file ) == 0  or logMe( $file, $! );
    logMe( $file, "END" );
}



sub logMe{

    my $file = shift;
    my $err  = shift;
    my $date =  DateTime->now(time_zone => $timeZone);
       $date =~ s/T/ /;

    my $string = "$date\t$err\t$file\n";
    print $string;
    append_file ( $log_file, $string );

}


sub browse{

    my $index           = shift;
    my $filePath        = $mw->getOpenFile ();
    $filePath           =~ s/\//\\/g if $filePath;   # change slash to
+ windows default
    $files[$index][1]   = $filePath if $filePath;
    my $progBox         = $index+ 1;
    $prog[$progBox]     -> configure( -textvariable => \$files[$index]
+[1]);
};


sub save{

    open ( AFILE, ">$files" );
    foreach ( @files ){
        if ( @$_[1] ){      # want to save the data if there is a prog
+ram entered
            no warnings;    # undef is part of the paramter string, so
+ hide warnings here
            my $line = join (",", @$_ );
               $line .= "\n";
            print AFILE $line;
        }
    }
    close AFILE;
}

sub Toggle{
    if ( $toggle == 1 ){
        foreach ( @files ){ @{$_}[0] = 0 };
        $toggle = 0;
        return;
    }
    
    if ( $toggle == 0 ){
        
        foreach ( @files ){ 
            if ( @{$_}[1] ){
                @{$_}[0] = 1;
            }
        }
        $toggle = 1;
    }
}
Replies are listed 'Best First'.
Re: Tk Interface To Run Apps
by graff (Chancellor) on Sep 20, 2008 at 18:17 UTC
    Just a minor nit-pick -- the day-of-week stuff could be handled a little more easily:
    ... #Create Labels and headings my @wkdays = qw/M T W R F Sa Su/; my %labelColumns; my $i = 0; foreach ( qw/On Program Browse/, @wkdays ) { $labelColumns{$_} = $i++; $mid_frame -> Label( -text => "$_", -relief => "sunken", -padx => +5 ) -> grid( -column => $labelColumns{$_}, -row => 0, -padx => 0 ) +; } ... # Time Checkbuttons for my $dy ( @wkdays ) { $mid_frame -> Checkbutton( -variable => \$files[$index][$label +Columns{$dy}]) ->grid( -row=>$_, -column=>$labelColumns{$dy}, -padx => 0, + -pady => 5 ); } ...
    If/when you decide to change an option or something for those mid_frame Checkbuttons, you'll appreciate having only one line of code to change, instead of 7.
      Your right. I was thinking that I might want to change the order in the future, but your way makes it just as easy and shorter...
      ~~David~~