sub restart{
exec $0;
}
[download]

I have to restart, as the FTP server could provide completely different script than the one currently running. Will exec $0 work on Win32 ?

Will exec $0 work on Win32 ?

Yes.

---

Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.

Lingua non convalesco, consenesco et abolesco. -- Rule 1 has a caveat! -- Who broke the cabal?

"Science is about questioning the status quo. Questioning authority".

In the absence of evidence, opinion is indistinguishable from prejudice.

I don't know much about windows, but if it dosn't work, you could try

sub restart{
  system(1, $0);  # windows trick to launch a new process
  exit;                  # will need to exit original script
}
[download]

but maybe the windows experts will know something better.

---

I'm not really a human, but I play one on earth. flash japh

#!/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]

#!/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]

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 !!!

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]