@rem = '--*-Perl-*--
@echo off
if exist .\perl\bin\perl.exe goto perlexefound
echo.
echo ERROR: Can not find .\perl\bin\perl.exe
echo.
goto endofperl

:perlexefound
.\perl\bin\perl -w -I.\perl\lib uninstall.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;


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


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

print "This script will uninstall IndigoPerl $]\n\n";

my $install_directory = Win32::GetCwd();
RemoveShortcuts($shortcutfoldername, $configUser);
RemovePath("$install_directory\\perl\\bin");
StopApacheService("$install_directory\\apache") if Win32::IsWinNT();
UninstallApacheService("$install_directory\\apache") if Win32::IsWinNT();

print "\nTo complete the uninstallation manually stop the ApacheMonitor if it is running\n";
print "and remove the folder $install_directory\n";
print "FINISHED.\nPress enter to continue"; <STDIN>;
exit 0;



sub RemoveShortcuts
{
    my ($shortcutfoldername, $configUser) = @_;
    print "Removing shortcut from $shortcutfoldername\n";
    print LOG "Removing shortcut from $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";
    
    if (!-d $folderpath) {
        print "Shortcut folder $folderpath not found\n";
        return;
    }

    unlink (
            "$folderpath\\Apache Documentation.lnk",
            "$folderpath\\Apache Service - Start.lnk",
            "$folderpath\\Apache Service - Stop.lnk",
            "$folderpath\\Apache Service - Restart.lnk",
            "$folderpath\\Apache Monitor.lnk",
            "$startup_folderpath\\Apache Monitor.lnk",

            "$folderpath\\Start Apache.lnk",
            "$startup_folderpath\\Start Apache.lnk",

            "$folderpath\\Perl Console.lnk",
            "$folderpath\\Perl Documentation.lnk",
            "$folderpath\\PHP Documentation.lnk",
            "$folderpath\\Uninstall.lnk",
            "$folderpath\\View Access Log.lnk",
            "$folderpath\\View Config.lnk",
            "$folderpath\\View Error Log.lnk",
            "$folderpath\\View Website.lnk",
            );

    # win98
    unlink (
            "$folderpath\\Start Apache.pif",
            "$folderpath\\Uninstall.pif",
            "$startup_folderpath\\Start Apache.pif",
            );

    rmdir "$folderpath";
}







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

    # Remove required_path from PATH environment if necessary
    print "Removing $long_required_path from path\n";
    print LOG "Removing $long_required_path from 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";

    $new_path = $current_path;
    $new_path =~ s/^\Q$required_path\E$//i;      #  path=x   only
    $new_path =~ s/^\Q$required_path\E;//i;      #  path=x;a;b   beginning
    $new_path =~ s/;\Q$required_path\E$//i;      #  path=a;x;b path=a;b;x middle or end

    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";
        }
        else {
            print "Path will take effect after a reboot\n";
            print "\nPLEASE REBOOT YOUR COMPUTER\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 StopApacheService
{
    my ($apache_directory) = @_;
    # TOD need a way to stop ApacheMonitor

    print "Stopping Apache Service\n";
    print LOG "Stopping 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 stop";
    print LOG "cmd=$cmd\n";
    my $rc = system($cmd);
    print LOG "rc=$rc\n";
}



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

    print "Uninstalling Apache Service\n";
    print LOG "Uninstalling 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 uninstall";
    print LOG "cmd=$cmd\n";
    my $rc = system($cmd);
    print LOG "rc=$rc\n";
}




__END__
:endofperl
