in reply to Restart Long Running Perl Script

Transfer the file, but do not overwrite it. When your program notices that a new version has arrived, it writes its current state out to harddisk and runs the updater, which just switches the files around. 
#!/usr/bin/perl
# 529755.pl

use strict;
use diagnostics;

my $importantdatatomangle = 1;

sub checkfornew {
    my $newversionfilename    = '529755.pl.newversion';
    if (
        -e $newversionfilename    # does the new file exist?
        and
        (time - (stat $newversionfilename)[9] > 2)
        # is it older than 2 sec, i.e. has it been completely
        # transferred to this here box?
    ) {
        # save the current state of the program out to harddisk
        # i.e. $importantdatatomangle
    # ...
        warn "found a new version, running updater";
        exec 'perl updater.pl' or die "could not exec updater: $!";
        # run the updater
        # see perldoc -f exec why I included error checking
    };
};

# main program starts below here
while (1) { # loop for "many hours", actually forever :p
    {
        # do important work
        $importantdatatomangle    = -$importantdatatomangle;
        warn "data is now $importantdatatomangle";
        sleep 5;
        warn "zzzzz";
    };
    checkfornew;    # periodically check for newer version
};

[download]
Actually you have to read the current state from harddisk back into your variables at the very beginning of the program. I'm just setting my variable to 1 out of laziness. 
#!/usr/bin/perl
# updater.pl

use strict;
use diagnostics;

use File::Copy;

# improve this shoddy programming,
# remember to actually check the return values of move for errors

move '529755.pl', '529755.pl~';            # create backup
move '529755.pl.newversion', '529755.pl';    # deploy new version

warn "deployed new version, going to run it now";
exec 'perl 529755.pl' or die "could not exec new version: $!";

[download]
Next time on perlmonks, show what you have programmed so far, or else you get slapped with a wet octopus.

Replies are listed 'Best First'.
Re^2: Restart Long Running Perl Script
by avo (Pilgrim) on Feb 17, 2006 at 09:17 UTC
    Thanks a lot guys. I promise to publish the code. It is a part of a very big Point of Sale system that uses Perl for back and front of house. Unfortunately the code is not open source as it is company property at present. Again thanks !!!
[reply]
Re^2: Restart Long Running Perl Script
by avo (Pilgrim) on Feb 17, 2006 at 09:26 UTC
    Here is a prototype of the file update script. The idea is that the server does CRC xml of all files in a folder, then the client on its side compares the CRC with the local folder that must be updated. Upon difference between the two the client requires the file from server Mime encoded in XML, then updates the local copy. 
    
use strict;
use File::Find;
use Digest::MD5;
use MIME::Base64;
use XML::Twig;
my $twig= XML::Twig->new(); # XML Parser


#lets get all folderz
my %digest;
my $cdir = "./";
my $distrodir = "/socket/.DIST/";
my $current_updates_xml;

find(
    {
        wanted=>sub{
                                     if ($_ !~ /temp|\.log/) {
                                         my $filename = $_;
                                     
                                     if (-f $File::Find::name) {
                                        
                                         open(FILE, "<$File::Find::nam
+e") or die "Can't open '$File::Find::name': $!";
                                        binmode(FILE);
                                        $digest{$cdir}{$filename} = Di
+gest::MD5->new->addfile(*FILE)->hexdigest;
                                         close FILE;
                            
                                     } elsif (-d $File::Find::name) {
                            
                                         $cdir=$File::Find::name;
                                         
                                         $cdir =~ s/^$distrodir//;
                                         
                                         $digest{$cdir} = () unless ($
+cdir."/" eq $distrodir);
                                         
                                     }        
                                     
                            }
            },
        chdir=>1
    },$distrodir);



#generate XML

$current_updates_xml = qq~<?xml version="1.0" standalone="yes"?> <data
+>\n~;

    foreach my $folder (sort {$a cmp $b} keys %digest) {
        $current_updates_xml .= "<folder name=\"$folder\">\n";
            foreach my $file (keys %{$digest{$folder}}) {
                $current_updates_xml .= "<file name=\"$file\" crc=\"$d
+igest{$folder}{$file}\" />\n"
            }
        $current_updates_xml .= "</folder>";
    }
$current_updates_xml .= "</data>\n";

#print $current_updates_xml;



# client side

$twig->parse($current_updates_xml);
my $root = $twig->root;

my %redigest;

foreach my $folder ($root->children('folder')) {
    $redigest{$folder->att('name')} = ();
    foreach my $file ($folder->children('file')) {
        $redigest{$folder->att('name')}{$file->att('name')} = $file->a
+tt('crc');
    }
}

#TEMPORARY SECTION
my $destfolder = "/socket/REDIST/";

my %tofetch;

#create directory structure
foreach my $folder (sort {$a cmp $b} keys %redigest) {
    mkdir $destfolder.$folder unless (-d $destfolder.$folder);
#    print "$folder\n";
    foreach my $file (keys %{$redigest{$folder}}) {
        #compare files
        #print "\t $destfolder$folder/$file (CRC: $redigest{$folder}{$
+file}\n";
        if (-f "$destfolder$folder/$file") {
            
                                        open(FILE, "$destfolder$folder
+/$file") or die "Can't open $destfolder$folder/$file: $!";
                                        binmode(FILE);
                                        $tofetch{$folder}{$file} =  1 
+if (Digest::MD5->new->addfile(*FILE)->hexdigest ne $redigest{$folder}
+{$file});
                                         close FILE;
        } else {
            $tofetch{$folder}{$file} =  1
            
        }
    }
}

#debug
foreach my $folder (keys %tofetch) {
    #print join(", ", keys %{$tofetch{$folder}});
    #print "\n";
    
    foreach my $file (keys %{$tofetch{$folder}}) {
        my $requestxml;
        # = qq~<?xml version="1.0" standalone="yes"?> <data>\n~;
        
        $requestxml .= "<data command=\"getbinfile\" folder=\"$folder\
+" file=\"$file\" />\n";
        my $filexml = server_return($requestxml);
        
        $twig->parse($filexml);
        my $root = $twig->root;
        
        if ($root->att('status') == 1) {
            my $filebindata = $root->att('binfile');
            $filebindata = MIME::Base64::decode($filebindata);
            open(OUT, "> $destfolder$folder/$file") or die "can't open
+ $_[1]: $!";
            syswrite OUT, $filebindata;
            close OUT;
        }
        
    }
}




sub server_return {
    my $distrodir = "/socket/.DIST/";
    my $ixml = shift;
    
$twig->parse($ixml);
my $root = $twig->root;
my $file = $root->att('file');
my $folder = $root->att('folder');
    print $file;
    
    
                        my $encoded;
                        my $status;
                        if (-f "$distrodir$folder/$file") {
                        $encoded = MIME::Base64::encode(slurpfile("$di
+strodir$folder/$file"));
                        $status = 1;
                      } else { $status = 0; }
                        
                        
                        my $oxml = "<?xml version=\"1.0\" standalone=\
+"yes\"?> <data status=\"$status\" binfile=\"$encoded\"/>\n";
                        return $oxml;
}




sub slurpfile 
{
    open(IN,  "< $_[0]") or die "can't open $_[0]: $!";
    binmode (IN);
    seek(IN, 0, 0); sysread (IN, my $slurp, -s IN);
    close(IN);
    return $slurp;
}

    [download]
[reply]
[d/l]

In Section Seekers of Perl Wisdom