#####################################################################
# 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';

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.0 / Apache 2.0.43 / mod_perl 1.99_08
2. Perl 5.6.1 / Apache 1.3.27 / mod_perl 1.27

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_max());
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;
}