@rem = '--*-Perl-*--
@echo off
if exist .\perl\bin\perl.exe goto perlexefound
echo.
echo ERROR: Can not find .\perl\bin\perl.exe
echo This installation is incomplete.
echo Make sure that the downloaded file is complete.
echo Make sure that your unzip pogram extracts subdirectories
echo and preserves long filenames.
echo.
goto endofperl

:perlexefound
.\perl\bin\perl -w -I.\perl\lib setup.bat %1 %2 %3 %4 %5 %6 %7 %8 %9
goto endofperl
@rem ';
#!perl -w
#################################################################
#
#   script to set up path and shortcuts to the Perl installation
#   run this bat file from the directory where perl is installed
#
#################################################################

@rem = (); # eliminate warning

use Config;
use Win32::API;
use Win32::Shortcut;
use Win32::Registry;
use strict;
use DSUtil;

# usage setup.bat -n [install_directory]
# -d for default answers
# example 1: setup        prompt for install dir
# example 2: setup -d .   install in current directory
# example 3: setup -d     install in default c:\indigoperl directory

my $debug = 0;
my $debug_pretent_tobe_95 = 0;
my $configUser = 0;  # set up user path and shortcuts instead of shared ones
my $shortcutfoldername = "IndigoPerl";


print "\nThis script will install and configure IndigoPerl with Apache and PHP\n\n";
print "Environment variable PERLLIB is set to $ENV{PERLLIB}\n\n" if $ENV{PERLLIB};
print "Environment variable PER5LLIB is set to $ENV{PERL5LIB}\n\n" if $ENV{PERL5LIB};

open (LOG, ">>install.log");
my $date = localtime(time());
print LOG "\n**** Installer started at $date ****\n";

my %opt;
while (@ARGV && $ARGV[0] =~ s/^-//) {
    $opt{shift @ARGV} = 1;
}

my $install_directory = CopyFilesToTarget();
UpdateConfig("$install_directory\\perl\\lib\\Config.pm", "$install_directory\\perl");
BuildHtml("$install_directory\\perl");
MakeShortcuts($shortcutfoldername, $configUser, $install_directory);
UpdateHttpdConfig("$install_directory");
AddPath("$install_directory\\perl\\bin");
my $required_path = Win32::GetShortPathName ("$install_directory\\perl\\bin");
$ENV{PATH} = "$required_path;$ENV{PATH}";
InstallApacheService("$install_directory\\apache") if Win32::IsWinNT();
StartApache("$install_directory\\apache", "$install_directory\\perl\\bin");
print "Done\n";
if ($opt{d}) {
    sleep(5);
} else {
    print "Press enter to continue"; <STDIN>;
}
exit 0;

sub UpdateConfig
{
	my ($filename, $newprefix) = @_;

	my $data;
    my $count;

    open (IN, $filename) || die "Can't open $filename\n";
    my ($atime, $mtime) = (stat(IN))[8,9];
	#binmode IN;
    read (IN, $data, (-s IN));
    close IN;

    #prefix='c:\perl'
    my ($oldprefix) = $data =~ m/^prefix='(.*?)'/m;
    if ($oldprefix eq $newprefix) {
        $count = 0;
    } else {
        print "oldprefix = $oldprefix newprefix = $newprefix\n";
        $oldprefix =~ s/\\/\\\\/g;   # escape \ characters
	    $count = $data =~ s/$oldprefix/$newprefix/g;
    }

	print "Config.pm $filename: ", $count ? $count : 0, " changes\n";
	if ($count) {
		chmod 0644, $filename;
		open (OUT, ">$filename") || print "ERROR: Can't create $filename\n";
		#binmode OUT;
		print OUT $data;
		close OUT;
        # keep the timestamp to avoid rebuilds
        utime $atime, $mtime, $filename;
	}
}


sub CopyFilesToTarget
{
    # COPY FILES TO TARGET DIRECTORY
    my $cwd = Win32::GetCwd();
    my $installation_directory = "";

    if (!$opt{d}) {
        if (@ARGV) {
            $installation_directory = shift @ARGV;
        }
        else {
            print "Enter installation directory.\n";
            print "Enter '.' to install in current directory ($cwd).\n";
            print "or press enter to install in default directory (C:\\indigoperl):";
            die if (!defined $installation_directory);  # jic
            $installation_directory = <STDIN>;
            chomp $installation_directory;
        }
    }
    else {
        if (@ARGV) {
            $installation_directory = shift @ARGV;
        }
        else {
            $installation_directory = "";
        }
    }

    $installation_directory = "C:\\indigoperl" if ($installation_directory eq "");
    $installation_directory = $cwd if ($installation_directory eq ".");

    print "Installation directory is $installation_directory\n";
    print LOG "Installation directory is $installation_directory\n";

    if ($installation_directory !~ /^\Q$cwd\E$/i) {
        print "Copying files to $installation_directory\n";
        print LOG "Copying files to $installation_directory\n";
        system("xcopy /e/i/d/k/r/h/q . \"$installation_directory\"");
        if (!-d $installation_directory) {
            print "ERROR Failed to copy files to $installation_directory\n";
            print LOG "ERROR Failed to copy files to $installation_directory\n";
            print "Make sure to run this installer in an Admin account\n";
            exit 0;
        }
    } else {
        $installation_directory = $cwd;
        print "Copying files to $installation_directory - skipped\n";
        print LOG "Copying files to $installation_directory - skipped\n";
    }

    my $f = "$installation_directory/apache";
    if (Win32::IsWin95() && -e "$f/bin-98" && -e "$f/bin") {
        rename ("$f/bin", "$f/bin-NT");
        rename ("$f/bin-98", "$f/bin");
        rename ("$f/bin-NT/iconv", "$f/bin/iconv");
    }
    elsif (Win32::IsWinNT() && -e "$f/bin-NT" && -e "$f/bin") {
        rename ("$f/bin", "$f/bin-98");
        rename ("$f/bin-NT", "$f/bin");
        rename ("$f/bin-98/iconv", "$f/bin/iconv");
    }
    return $installation_directory;
}



sub mk_shortcut
{
    my ($description, $path, $args, $dir, $show, $folderpath, $os) = @_;

    return if ($os eq "NT" && !Win32::IsWinNT());
    return if ($os eq "98" && !Win32::IsWin95());
 
    my $LINK=new Win32::Shortcut();
    print "Making shortcut $description\n";
    $LINK->{'Description'}=$description;
    $LINK->{'Path'}=$path;
    $LINK->{'Arguments'}=$args;
    $LINK->{'WorkingDirectory'}=$dir;
    $LINK->{'ShowCmd'}=$show;
    $LINK->Save("$folderpath\\$description.lnk");
    $LINK->Close();
}


sub MakeShortcuts
{
    my ($shortcutfoldername, $configUser, $install_directory) = @_;
    my $perl_directory = "$install_directory\\perl";
    my $apache_directory = "$install_directory\\apache";
    print LOG "Creating shortcuts in folder $shortcutfoldername\n";

    my ($key);
    if ($configUser || Win32::IsWin95()) {
        $key = 'HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\Programs';
    } else {
        $key = 'HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\Common Programs';
    }

    my $folderdir = DS::GetReg($key);
    my $folderpath = "$folderdir\\$shortcutfoldername";
    my $startup_folderpath = "$folderdir\\StartUp";
    print "Creating shortcut folder $folderpath\n";
    mkdir ($folderpath, 0777);
    if (!-d $folderpath) {
        print "ERROR Failed to create shortcut folder $folderpath\n";
        print LOG "ERROR Failed to create shortcut folder $folderpath\n";
        print "Make sure to run this installer in an Admin account\n";
        exit 0;
    }

    # mk_shortcut ($description, $path, $args, $dir, $show, $folderpath, $os)

    mk_shortcut("Apache Documentation", "$install_directory\\apache_documentation.url", "", "c:\\", SW_SHOWNORMAL, $folderpath, 'any');

    mk_shortcut("Apache Service - Start", "$apache_directory\\bin\\apache.exe", " -k start", $apache_directory, SW_SHOWMINNOACTIVE, $folderpath, 'NT');
    mk_shortcut("Apache Service - Stop", "$apache_directory\\bin\\apache.exe", " -k stop", $apache_directory, SW_SHOWMINNOACTIVE, $folderpath, 'NT');
    mk_shortcut("Apache Service - Restart", "$apache_directory\\bin\\apache.exe", " -k restart", $apache_directory, SW_SHOWMINNOACTIVE, $folderpath, 'NT');
    mk_shortcut("Apache Monitor", "$apache_directory\\bin\\ApacheMonitor.exe", "", $apache_directory, SW_SHOWMINNOACTIVE, $folderpath, 'NT');
    mk_shortcut("Apache Monitor", "$apache_directory\\bin\\ApacheMonitor.exe", "", $apache_directory, SW_SHOWMINNOACTIVE, $startup_folderpath, 'NT');
 
    mk_shortcut("Perl Console", "$install_directory\\perlconsole.url", "", "c:\\", SW_SHOWNORMAL, $folderpath, 'any');
    mk_shortcut("Perl Documentation", "$perl_directory\\html\\index.html", "", "$perl_directory\\html", SW_SHOWNORMAL, $folderpath, 'any');
    mk_shortcut("PHP Documentation", "$install_directory\\PHP_documentation.url", "", "c:\\", SW_SHOWNORMAL, $folderpath, 'any');
    mk_shortcut("Uninstall", "$install_directory\\uninstall.bat", "", $install_directory, SW_SHOWNORMAL, $folderpath, 'any');

    mk_shortcut("View Access Log", "notepad.exe", "\"$apache_directory\\logs\\access.log\"", "c:\\", SW_SHOWNORMAL, $folderpath, 'any');
    mk_shortcut("View Config", "notepad.exe", "\"$apache_directory\\conf\\httpd.conf\"", "c:\\", SW_SHOWNORMAL, $folderpath, 'any');
    mk_shortcut("View Error Log", "notepad.exe", "\"$apache_directory\\logs\\error.log\"", "c:\\", SW_SHOWNORMAL, $folderpath, 'any');

    mk_shortcut("View Website", "$install_directory\\localhost.url", "", "c:\\", SW_SHOWNORMAL, $folderpath, 'any');

    my $perl_path = Win32::GetShortPathName ("$install_directory\\perl\\bin");
    my $fh;
    open ($fh, ">$install_directory\\start_apache.bat") || die;
    #print $fh "set PATH=$perl_path;$ENV{PATH}\n";  # this can run out of environment space
    print $fh "\@set PATH=$perl_path;$ENV{WINDIR}\n";
    print $fh "\@cd \"$apache_directory\\bin\"\n";
    print $fh "\@echo Apache is running, press Ctrl+C to stop Apache\n";
    print $fh "\@apache\n";
    print $fh "\@echo DONE\n";
    close $fh;

    mk_shortcut("Start Apache", "$install_directory\\start_apache.bat", "", $install_directory, SW_SHOWMINNOACTIVE, $folderpath, '98');
    mk_shortcut("Start Apache", "$install_directory\\start_apache.bat", "", $install_directory, SW_SHOWMINNOACTIVE, $startup_folderpath, '98');
}





sub AddPath
{
    my ($long_required_path) = @_;
    my $new_path;
    my $debug_addpath = 0;

    # Add required_path to PATH environment if necessary
    print "Adding $long_required_path to path\n";
    print LOG "Adding $long_required_path to path\n";

    my $required_path = Win32::GetShortPathName ($long_required_path);
    if (!$required_path) {
        print "ERROR: AddPath: directory '$long_required_path' must exist before calling AddPath\n";
        return;
    }

    my $current_path = GetPath();
    print LOG "current_path=$current_path\n";

    if ($current_path =~ m/^\Q$required_path\E(;|$)/i) {
        $new_path = $current_path;
    }
    elsif ($current_path =~ m/;\Q$required_path\E(;|$)/i) {
        $new_path = $current_path;
        $new_path =~ s/;\Q$required_path\E//i;
        $new_path = "$required_path;$new_path";
    }
    else {
        $new_path = "$required_path" if $current_path eq "";
        $new_path = "$required_path;$current_path" if $current_path ne "";
    }
    
    if ($new_path ne $current_path) {
        print LOG "new_path=$new_path\n";
        SetPath($new_path);
        if(Win32::IsWinNT() && !$debug_pretent_tobe_95) {
            print "Path will take effect when any new window is opened\n";
            print "\nPLEASE REBOOT YOUR MACHINE TO COMPLETE INSTALLATION\n\n";
        }
        else {
            print "Path will take effect after a reboot\n";
            print "\nPLEASE REBOOT YOUR MACHINE TO COMPLETE INSTALLATION\n\n";
        }
    }
    else {
        print "Path not changed\n";
        print LOG "Path not changed\n";
    }
}



sub GetPath
{
    my $current_path;
    my $autoexec_bat = "c:\\autoexec.bat";
    if(Win32::IsWinNT() && !$debug_pretent_tobe_95) {
       my $key = $configUser ? 'HKCU\Environment\path' :
                 'HKLM\SYSTEM\CurrentControlSet\Control\Session Manager\Environment\path';
       $current_path = DS::GetReg($key);
       return $current_path;
    }
    else {
        my $data = DS::ReadFile($autoexec_bat);
        if ($data =~ m/(.*)(^|\n)(set\s+|)(\s*path\s*=\s*)(.*?)(\n|$)/is) {
            $current_path = $5;
        }
        else {
            $current_path = "";
        }
    }        
    return $current_path;
}



sub SetPath
{
    my ($new_path) = @_;
    my $debug_addpath = 0;
    my $autoexec_bat = "c:\\autoexec.bat";
    my $autoexec_bak = "autoexec.bak";
    if(Win32::IsWinNT() && !$debug_pretent_tobe_95) {
       my $key = $configUser ? 'HKCU\Environment\path' :
                 'HKLM\SYSTEM\CurrentControlSet\Control\Session Manager\Environment\path';
        DS::SetReg($key, "$new_path");
        my $SendMessageTimeout = new Win32::API("user32", "SendMessageTimeout", 
                ['N','N','N','P','N','N','P'], 'N');
        my $dwResult = pack("L", 0);
        $SendMessageTimeout->Call(0xffff, 0x001A, 0, "Environment", 0x0002, 5000,$dwResult);
    }
    else {
        my $data = DS::ReadFile($autoexec_bat);
        DS::WriteFile($autoexec_bak, $data);
        print "Old autoexec.bat =\n'$data'\n" if $debug_addpath;
        if ($data =~ m/(.*)(^|\n)(set\s+|)(\s*path\s*=\s*)(.*?)(\n|$)/is) {
            $data =~ s/(.*)(^|\n)(set\s+|)(\s*path\s*=\s*)(.*?)(\n|$)/$1$2$3$4$new_path$6/is;
            print "New autoexec.bat =\n'$data'\n" if $debug_addpath;
        }
        else {
            # no path in autoexec
            if ($data eq "") {
                $data = "PATH=$new_path\n";
            } else {
                $data .= "\nPATH=$new_path\n";
            }
            print "New autoexec.bat =\n'$data'\n" if $debug_addpath;
        }
        chmod(0777, $autoexec_bat); # JIC
        DS::WriteFile($autoexec_bat, $data);
    }    
}









sub UpdateHttpdConfig
{
    # update httpd.conf, relocate path relative to new location
    #ServerRoot "C:/f/dev/indigoperl/indigoperl/apache"
    #Alias /html "F:/dev/indigoperl/indigoperl/perl/html"

    my ($install_directory) = @_;

    $install_directory =~ s%\\%\/%g;    # \ -> /
    my $apache_directory = "$install_directory/apache";
    my $ServerRoot = $apache_directory;
    my $port = $ARGV[0] || "80";

    my $configFile = "$ServerRoot/conf/httpd.conf";
    my $data = DS::ReadFile($configFile);

    my ($oldServerRoot) = $data =~ m/^\s*ServerRoot\s+\"(.*?)\"/mi;
    my $old_install_directory = $oldServerRoot;
    $old_install_directory =~ s/\/apache$//;

    my ($oldPort) = $data =~ m/^Listen\s+(\d+)$/mi;
    $oldServerRoot || die "Error: Configuration file $configFile is invalid\n";
    if ($ServerRoot ne $oldServerRoot || $port ne $oldPort) {
        $data =~ s/\Q$old_install_directory\E/$install_directory/ig;
        $data =~ s/^Port\s+\d+$/Port $port/gm;
        print "Updating httpd.conf - ServerRoot: $oldServerRoot -> $ServerRoot, Port: $oldPort -> $port\n";
        DS::WriteFile($configFile, $data);
    }
    else {
        print "Updating httpd.conf - no change\n";
    }
}


sub InstallApacheService
{
    my ($apache_directory) = @_;

    print "Installing Apache Service\n";
    print LOG "Installing Apache Service\n";
    my $apache_dir = $apache_directory;
    $apache_dir =~ s|\\|/|g;
    my $config_file = "$apache_dir/conf/httpd.conf";
    my $cmd = "\"$apache_directory\\bin\\apache.exe\" -f \"$config_file\" -k install";
    print LOG "cmd=$cmd\n";
    my $rc = system($cmd);
    print LOG "rc=$rc\n";
}


sub StartApache
{
    my ($apache_directory, $perl_path) = @_;

    if (Win32::IsWinNT()) {
        # cannot start service unless perl/bin was in path
        # when PC was booted
        print "Starting Apache Service\n";
        print LOG "Starting Apache Service\n";
        my $apache_dir = $apache_directory;
        $apache_dir =~ s|\\|/|g;
        my $config_file = "$apache_dir/conf/httpd.conf";
        my $cmd = "\"$apache_directory\\bin\\apache.exe\" -f \"$config_file\" -k start";
        print LOG "cmd=$cmd\n";
        my $rc = system($cmd);
        print LOG "rc=$rc\n";
        print "Starting ApacheMonitor\n";
        print LOG "Starting ApacheMonitor\n";
        $cmd = "\"$apache_directory\\bin\\ApacheMonitor.exe\"";
        print LOG "cmd=$cmd\n";
        #$rc = system($cmd);
        $rc = IS_CreateProcess("$cmd", 1);
        print LOG $rc ? "rc = OK\n" : "rc = FAILED\n";
    }
    else {
        print "Starting Apache Service\n";
        print LOG "Starting Apache Service\n";
        my $apache_dir = $apache_directory;
        $apache_dir =~ s|\\|/|g;
        my $config_file = "$apache_dir/conf/httpd.conf";
        my $cmd = "\"$apache_directory\\bin\\apache.exe\" -f \"$config_file\"";
        print LOG "cmd=$cmd\n";

        $cmd = "$install_directory\\start_apache.bat";
        print LOG "cmd=$cmd\n";

        #$perl_path = Win32::GetShortPathName ($perl_path);
        #$ENV{PATH} = "$perl_path;$ENV{PATH}";
        my $rc = IS_CreateProcess("$cmd", 2);
        print LOG $rc ? "rc = OK\n" : "rc = FAILED\n";
    }
}



sub BuildHtml
{
    my ($perldir) = @_;
    if (-e "perl/html/lib") {
        print "Building HTML files in $perldir\\html - skipped\n";
        return;
    }
    print "Building HTML files in $perldir\\html\n";
    print "... this will take a few minutes\n";
    open (STDERR, ">nul");
	system ("\"$perldir\\bin\\perl\" \"$perldir\\bin\\installhtml\" --podroot=$perldir --podpath=site:lib --htmldir=$perldir/html --libpod=perlfunc,perlguts,perlvar,perlrun,perlop --recurse");
    open (STDERR, ">&STDOUT");

    unlink ("pod2htmd.x~~", "pod2htmi.x~~");
    system("$perldir\\bin\\perl", "$perldir\\bin\\removeemtyhtml.pl", "$perldir/html");
	system("$perldir\\bin\\perl", "$perldir\\bin\\ipm.bat", "maketoc");
}





sub IS_CreateProcess
{
    my ($cmd, $show) = @_;
    # show 0 = hidden, 1, = normal 2 = minimized
    # If the function succeeds, the return value is nonzero.

use Win32::API;     # neeeded for perl2exe
    eval("use Win32::API;");
    my $win32api_avail = !$@;

    my $rc;
    if (!$win32api_avail) {
        print "Warning: Win32::API not available\n";
        $rc = system("start /min $cmd"); # 98/NT starts independent console
        return $rc ? 0 : 1;
    }

    my $dwFlags = 1;   # STARTF_USESHOWWINDOW
    # SW_HIDE=0 SW_SHOWNORMAL=1 SW_SHOWMINIMIZED=2
    my $si = pack("LLLLLLLLLLLL SS LLLL", 
                68,0,0,0, 0,0,0,0, 0,0,0,$dwFlags, 
                $show,0,
                0,0,0,0
                );

    my $processinfo = pack("LLLL", 0,0,0,0);
    my $dwCreationFlags = 16; # CREATE_NEW_CONSOLE
    my $CreateProcess = new Win32::API("kernel32", "CreateProcess", 
        ['P','P','P','P', 'N','N', 'P','P','P','P'], 'N');
 
    $CreateProcess || die;
    my $ok = $CreateProcess->Call(
                0, $cmd,
                0, 0,   # security
                0,  # inherit
                $dwCreationFlags,
                0,      # env
                ".",    # cwd
                $si,
                $processinfo);

    return $ok ? $processinfo : undef;
}







__END__
:endofperl

