##################################################################### # A Perl script to retrieve and join split files # making up a Win32 Perl/Apache binary distribution # # Files created by hjsplit (http://www.freebyte.com/hjsplit/) # with the joining accomplished by hj-join # # This script is Copyright 2003, by Randy Kobes, # and may be distributed under the same terms as Perl itself. # Please report problems to Randy Kobes <randy@theoryx5.uwinnipeg.ca> ##################################################################### use strict; use warnings; use Net::FTP; use Safe; use Digest::MD5; use IO::File; use ExtUtils::MakeMaker; #die 'This is intended for Win32' unless ($^O =~ /Win32/i); my $theoryx5 = 'theoryx5.uwinnipeg.ca'; my $bsize = 102400; my $kb = sprintf("%d", $bsize / 1024); my $cs = 'CHECKSUMS'; my $join = 'join32.exe'; #my $join = 'join.exe'; print <<"END"; This script will fetch and then join the files needed for creating and installing a Perl/Apache Win32 binary distribution from ftp://$theoryx5/pub/other/. If the file transfer is interrupted before all the neccessary files are obtained, run the script again in the same directory; files successfully fetched earlier will not be downloaded again. A hash mark represents transfer of $kb kB. Available distributions are: 1. Perl 5.8.4 / Apache 2.0.50 / mod_perl 1.99_15 (dev) 2. Perl 5.6.1 / Apache 1.3.27 / mod_perl 1.27 It is recommended to install Perl and Apache into fresh locations, so that current files are not overwritten and that old files do not linger which may confuse the new installation. END my $dist; my $ans = prompt("Desired distribution (1, 2, or 'q' to quit)?", 1); CHECK: { ($ans =~ /^q/i) and die 'Installation aborted'; ($ans == 1) and do { $dist = 'Perl-5.8-win32-bin'; last CHECK; }; ($ans == 2) and do { $dist = 'perl-win32-bin'; last CHECK; }; die 'Please answer either 1, 2, or q'; } my $exe = $dist . '.exe'; my $ftp = Net::FTP->new($theoryx5); $ftp->login('anonymous', "$dist\@perl.apache.org") or die "Cannot login to $theoryx5"; $ftp->cwd("pub/other/$dist") or die "Cannot cwd to pub/other/$dist"; my $max; die "Unable to determine number of files to get" unless ($max = get_ma +x()); my @files = (); # fetch the CHECKSUMS file print qq{Fetching "$cs" ...}; $ftp->ascii; $ftp->get($cs); print " done!\n"; die qq{Failed to fetch "$cs"} unless (-e $cs); push @files, $cs; # evaluate CHECKSUMS my $cksum; die qq{Cannot load "$cs" file} unless ($cksum = load_cs($cs) ); $ftp->binary; $ftp->hash(1, $bsize); # fetch the join program die qq{Cannot fetch "$join"} unless (fetch($join)); push @files, $join; # fetch the split files print "\nFetching $max split files ....\n\n"; for (1 .. $max) { my $num = $_ < 10 ? "00$_" : "0$_"; my $file = $dist . '.exe.' . $num; push @files, $file; die qq{Cannot fetch "$file"} unless (fetch($file)); } print "\nFinished fetching split files.\n"; $ftp->quit; # now join them if (-e $exe) { unlink($exe) or warn qq{Cannot unlink $exe: $!}; } my @args = ($join); system(@args); die qq{Joining files to create "$exe" failed} unless (-e $exe); # remove the temporary files, if desired $ans = prompt('Remove temporary files?', 'yes'); if ($ans =~ /^y/i) { unlink(@files) or warn "Cannot unlink temporary files: $!\n"; } # run the exe, if desired $ans = prompt("Run $exe now?", 'yes'); if ($ans =~ /^y/i) { @args = ($exe); system(@args); } else { print "\nDouble click on $exe to install.\n"; } # fetch a file, unless it exists and the checksum checks sub fetch { my $file = shift; local $| = 1; if (-e $file) { if (verifyMD5($file)) { print qq{Skipping "$file" ...\n}; return 1; } else { unlink $file or warn qq{Could not unlink "$file"\n}; } } my $size = sprintf("%d", $ftp->size($file) / 1024); print "\nFetching $file ($size kB) ...\n"; $ftp->get($file); print "Done!\n"; unless (-e $file) { warn qq{Unable to fetch "$file"\n}; return; } unless (verifyMD5($file)) { print qq{CHECKSUM check for "$file" failed.\n}; unlink $file or warn qq{Cannot unlink "$file": $!\n}; return; } return 1; } # routines to verify the CHECKSUMS for a file # adapted from the MD5 check of CPAN.pm # load the CHECKSUMS file into $cksum sub load_cs { my $cs = shift; my $fh = IO::File->new; unless ($fh->open($cs)) { warn qq{Could not open "$cs": $!\n}; return; } local($/); my $eval = <$fh>; $fh->close; $eval =~ s/\015?\012/\n/g; my $comp = Safe->new(); my $cksum = $comp->reval($eval); if ($@) { warn qq{eval of "$cs" failed: $@\n}; return; } return $cksum; } # verify a CHECKSUM for a file sub verifyMD5 { my $file = shift; my ($is, $should); my $fh = IO::File->new; unless ($fh->open($file)) { warn qq{Cannot open "$file": $!}; return; } binmode($fh); unless ($is = Digest::MD5->new->addfile($fh)->hexdigest) { warn qq{Could not compute checksum for "$file": $!}; $fh->close; return; } $fh->close; if ($should = $cksum->{$file}->{md5}) { my $test = ($is eq $should); printf qq{ Checksum for "$file" is %s\n}, ($test) ? 'OK.' : 'NOT OK.'; return $test; } else { warn qq{Checksum data for "$file" not present in $cs.\n}; return; } } # get number of split files sub get_max { my $dir = $ftp->ls(); my $count = 0; foreach (@$dir) { $count++ if m!$dist.exe.\d+$!; } return $count; }
In reply to Re^2: perl and web
by rvosa
in thread perl and web
by Anonymous Monk
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |