#!C:/Perl/bin
#####################################################################
# A Perl script to fetch and install via ppm mod_perl on Win32
# Copyright 2002, by Randy Kobes.
# This script 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 ExtUtils::MakeMaker;
use LWP::Simple;
use File::Copy;
use Config;
use Safe;
use Digest::MD5;
require Win32;
require File::Spec;

die "This only works for Win32" unless $^O =~ /Win32/i;
die "No mod_perl ppm package available for this Perl" if ($] < 5.006001);

my ($apache2, $apache, $apache22);
my @drives = drives();

# find a possible Apache2 directory
APACHE2: {
    for my $drive (@drives) {
        for my $p ('Apache2', 'Program files/Apache2', 
                   'Program Files/Apache Group/Apache2') {
            my $candidate = File::Spec->catpath($drive, $p);
            if (-d $candidate) {
                $apache2 = $candidate;
                last APACHE2;
            }
        }
    }
}
if ($apache2) {
    $apache2 = fix_path($apache2);
    my $ans = prompt(qq{Install mod_perl-2 for "$apache2"?}, 'yes');
    $apache2 = undef unless ($ans =~ /^y/i);
}

# if no Apache2, try to find Apache1
unless ($apache2) {
  APACHE: {
        for my $drive (@drives) {
            for my $p ('Apache', 'Program Files/Apache', 
                       'Program Files/Apache Group/Apache') {
                my $candidate = File::Spec->catpath($drive, $p);
                if (-d $candidate) {
                    $apache = $candidate;
                    last APACHE;
                }
            }
        }
    }
}
if ($apache) {
    $apache = fix_path($apache);
    my $ans = prompt(qq{Install mod_perl 1 for "$apache"?}, 'yes');
    $apache = undef unless ($ans =~ /^y/i);
}

# check Apache versions 
if ($apache or $apache2) {
    my $vers;
    if ($apache) {
        $vers = qx{"$apache/apache.exe" -v};
        die qq{"$apache" does not appear to be version 1.3}
            unless $vers =~ m!Apache/1.3!;
    }
    else {
        my $vers;
        for my $binary(qw(Apache.exe httpd.exe)) {
            my $b = File::Spec->catfile($apache2, 'bin', $binary);
            next unless -x $b;
            $vers = qx{$b -v};
            last;
	}
        die qq{Cannot determine the Apache version} unless $vers;
        die qq{"$apache2" does not appear to be version 2.x}
            unless $vers =~ m!Apache/2.!;
        $apache22 = 1 if $vers =~ m!Apache/2.2!;
    }
}
# prompt to get an Apache installation directory
else {
    my $dir = prompt("Where is your apache installation directory?", '');
    die 'Need to specify the Apache installation directory' unless $dir;
    $dir = fix_path($dir);
    die qq{"$dir" does not exist} unless (-d $dir);
    if ($dir =~ /Apache2/) {
        my $ans = prompt(qq{Install mod_perl 2 for "$dir"?}, 'yes');
        $apache2 = $dir if ($ans =~ /^y/i);
    }
    else {
        my $ans = prompt(qq{Install mod_perl 1 for "$dir"?}, 'yes');
        $apache = $dir if ($ans =~ /^y/i);
    }
    unless ($apache or $apache2) {
        my $mpv = prompt('Which mod_perl version would you like [1 or 2]?', 2);
        if ($mpv == 1) {
            $apache = $dir;
        }
        elsif ($mpv == 2) {
            $apache2 = $dir;
        }
        else {
            die 'Please specify either "1" or "2"';
        }
    }
}

die 'Please specify an Apache directory' unless ($apache or $apache2);
my $theoryx5 = 'http://theoryx5.uwinnipeg.ca';
my $ppms = $theoryx5 . '/ppms/';
my $ppmsx86 = $ppms . 'x86/';
my $ppmpackages = $theoryx5 . '/ppmpackages/';
my $ppmpackagesx86 = $ppmpackages . 'x86/';
my ($ppd, $tgz, $ppdfile, $tgzfile, $checksums, $so_fetch, $so_fake);
my $so = 'mod_perl.so';
my $cs = 'CHECKSUMS';

# set appropriate ppd and tar.gz files
if ($] < 5.008) {
    $checksums = $ppmpackagesx86 . $cs;
    if ($apache2) {
        die 'No mod_perl 2 package available for this perl version';
    }
    else {
        my $ans = prompt('Do you need EAPI support for mod_ssl?', 'no');
        if ($ans =~ /^n/i) {
            $ppdfile = 'mod_perl.ppd';
            $tgzfile = 'mod_perl.tar.gz';
            $so_fake = 'mod_perl.so';
        }
        else {
            $ppdfile = 'mod_perl-eapi.ppd';
            $tgzfile = 'mod_perl-eapi.tar.gz';
            $so_fake = 'mod_perl-eapi.so';
        }
        $ppd = $ppmpackages . $ppdfile;
        $tgz = $ppmpackagesx86 . $tgzfile;
        $so_fetch = $ppmpackagesx86 . $so_fake;
    }
}
else {
    $checksums = $ppmsx86 . $cs;
    if ($apache2) {
        my $ans = prompt('Do you want the latest mod_perl 2 development version?', 'no');
        if ($ans =~ /^n/i) {
            if ($apache22) {
                $ppdfile = 'mod_perl.ppd';
                $tgzfile = 'mod_perl.tar.gz';
                $so_fake = 'mod_perl.so';
            }
            else {
                $ppdfile = 'mod_perl-2.0.ppd';
                $tgzfile = 'mod_perl-2.0.tar.gz';
                $so_fake = 'mod_perl-2.0.so';
            }
        }
        else {
            $ppdfile = 'mod_perl-dev.ppd';
            $tgzfile = 'mod_perl-dev.tar.gz';
            $so_fake = 'mod_perl-dev.so';
        }
        $ppd = $ppms . $ppdfile;
        $tgz = $ppmsx86 . $tgzfile;
        $so_fetch = $ppmsx86 . $so_fake;
    }
    else {
        my $ans = prompt('Do you need EAPI support for mod_ssl?', 'no');
        if ($ans =~ /^n/i) {
            $ppdfile = 'mod_perl-1.ppd';
            $tgzfile = 'mod_perl-1.tar.gz';
            $so_fake = 'mod_perl-1.so';
        }
        else {
            $ppdfile = 'mod_perl-eapi-1.ppd';
            $tgzfile = 'mod_perl-eapi-1.tar.gz';
            $so_fake = 'mod_perl-eapi-1.so';
        }
        $ppd = $ppms . $ppdfile;
        $tgz = $ppmsx86 . $tgzfile;
        $so_fetch = $ppmsx86 . $so_fake;
    }
}

my $tmp = $ENV{TEMP} || $ENV{TMP} || '.';
chdir $tmp or die "Cannot chdir to $tmp: $!";

# fetch the ppd and tar.gz files
print "Fetching $ppd ...";
getstore($ppd, $ppdfile);
print " done!\n";
die "Failed to fetch $ppd" unless -e $ppdfile;
print "Fetching $tgz ...";
getstore($tgz, $tgzfile);
print " done!\n";
die "Failed to fetch $tgz" unless -e $tgzfile;
print "Fetching $so_fetch ...";
getstore($so_fetch, $so_fake);
print " done!\n";
die "Failed to fetch $so_fetch" unless -e $so_fake;
print "Fetching $checksums ...";
getstore($checksums, $cs);
print " done!\n";
die "Failed to fetch $checksums" unless -e $cs;

# check CHECKSUMS for the tar.gz and so files
my $cksum = load_cs($cs);
die "Could not load $cs: $!" unless $cksum;
die qq{CHECKSUM check for "$tgzfile" failed.\n} 
    unless (verifyMD5($cksum, $tgzfile));
die qq{CHECKSUM check for "$so_fake" failed.\n}
    unless (verifyMD5($cksum, $so_fake));
unless ($so_fake eq $so) {
    rename($so_fake, $so) or die "Rename of $so_fake to $so failed: $!";
}

# edit the ppd file to reflect a local installation
my $old = $ppdfile . '.old';
rename ($ppdfile, $old) 
    or die "renaming $ppdfile to $old failed: $!";
open(my $oldfh, $old) or die "Cannot open $old: $!";
open(my $newfh, ">$ppdfile") or die "Cannot open $ppdfile: $!";
while (<$oldfh>) {
    next if /<INSTALL/;
    s/$tgz/$tgzfile/;
    print $newfh $_;
}
close $oldfh;
close $newfh;

# install mod_perl via ppm
my $ppm = $Config{bin} . '\ppm';
my @args = ($ppm, 'install', $ppdfile);
print "\n@args\n";
system(@args) == 0 or die "system @args failed: $?";

# figure out where to place mod_perl.so
my $modules = $apache ? "$apache/modules" : "$apache2/modules";
$modules = prompt("Where should $so be placed?", $modules);
die "Please install $so to your Apache modules directory manually"
    unless $modules;
$modules = fix_path($modules);

unless (-d $modules) {
    my $ans = prompt(qq{"$modules" does not exist. Create it?}, 'yes');
    if ($ans =~ /^y/i) {
        mkdir $modules or die "Cannot create $modules: $!";
    }
    else {
        $modules = undef;
    }
}
# move mod_perl.so to the Apache modules directory
if ($modules) {
    print "\nMoving $so to $modules ...";
    move($so, qq{$modules})
        or die "Moving $so to $modules failed: $!";
    print " done!\n";
}
else {
    die "Please install $so to your Apache modules directory manually"
}

# clean up, if desired
my $ans = prompt("Remove temporary installation files from $tmp?", 'yes');
if ($ans =~ /^y/i) {
    unlink ($ppdfile, $old, $tgzfile, $cs, $so) 
        or warn "Cannot unlink files from $tmp: $!";
}

# get the name and location of the perlxx.dll
(my $dll = $Config{libperl}) =~ s!\.lib$!.dll!;
$dll = $Config{bin} . '/' . $dll;
$dll =~ s!\\!/!g;

# suggest a minimal httpd.conf configuration
my $ap = $apache || $apache2;
print <<"END";

mod_perl was successfully installed.
To try it out, put the following directives in your
Apache httpd.conf file (under $ap/conf):
    
LoadFile "$dll"
LoadModule perl_module modules/$so

in the section where other apache modules are loaded.
You may also have to add $Config{bin}
to your PATH environment variable.
    
For more information, visit http://perl.apache.org/.

END

# routine to verify the CHECKSUMS for a file
# adapted from the MD5 check of CPAN.pm

sub load_cs {
    my $cs = shift;
    my ($cksum, $fh);
    unless (open $fh, $cs) {
        warn "Could not open $cs: $!";
        return;
    }
    local($/);
    my $eval = <$fh>;
    $eval =~ s/\015?\012/\n/g;
    close $fh;
    my $comp = Safe->new();
    $cksum = $comp->reval($eval);
    if ($@) {
        warn $@;
        return;
    }
    return $cksum;
}

sub verifyMD5 {
    my ($cksum, $file) = @_;
    my ($fh, $is, $should);
    unless (open($fh, $file)) {
        warn "Cannot open $file: $!";
        return;
    }
    binmode($fh);
    unless ($is = Digest::MD5->new->addfile($fh)->hexdigest) {
        warn "Could not compute checksum for $file: $!";
        close($fh);
        return;
    }
    close($fh);
    if ($should = $cksum->{$file}->{md5}) {
        my $test = $is eq $should ? 1 : 0;
        printf qq{Checksum for "$file" is %s\n}, 
            ($test == 1) ? 'OK.' : 'NOT OK.';
        return $test;
    }
    else {
        warn "Checksum data for $file not present in CHECKSUMS.\n";
        return;
    }
}

sub fix_path {
    my $file = shift;
    $file = Win32::GetShortPathName($file);
    $file =~ s!\\!/!g;
    return $file;
}

sub drives {
    my @drives = ();
    eval{require Win32API::File;};
    return map {"$_:\\"} ('C' .. 'Z') if $@;
    my @r = Win32API::File::getLogicalDrives();
    return unless @r > 0;
    for (@r) {
        my $t = Win32API::File::GetDriveType($_);
        push @drives, $_ if ($t == 3 or $t == 4);
    }
    return @drives > 0 ? @drives : undef;
}