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

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::GUI;
use Win32::Shortcut;
use Win32::Registry;
use strict;
use DSUtil;
#perl2exe_include "File/Glob.pm"


my $shortcutfoldername = "IndigoPerl";
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";



# usage setup.bat -c | -continue -nodeletefiles
# -continue continue without prompts
# -c continue without prompts
# -nodeletefiles don't delete installation files

my %opt;
while (@ARGV && $ARGV[0] =~ m/^-/) {
    my $opt = shift @ARGV;
    if ($opt =~ /-nodeletefiles/) {
        $opt{'nodeletefiles'} = 1;
    }
    elsif ($opt =~ /-c/) {
        $opt{'continue'} = 1;
    }
    else {
        error_exit("ERROR: Invalid option $opt\n");
    }
}

print "This script will uninstall IndigoPerl\n\n";
if (!$opt{continue}) {
    print "Press enter to continue"; <STDIN>;
}

my $install_directory = "";
$install_directory = shift @ARGV if (@ARGV);
$install_directory = Win32::GetCwd() if ($install_directory eq "");


RemoveShortcuts($shortcutfoldername, $configUser);
RemovePath("$install_directory\\perl\\bin");
StopApacheService("$install_directory\\apache") if Win32::IsWinNT();
StopApacheMonitor() if Win32::IsWinNT();
UninstallApacheService("$install_directory\\apache") if Win32::IsWinNT();
DeleteFiles($install_directory) unless ($opt{'nodeletefiles'});

if ($opt{continue}) {
    sleep(5);
} else {
    print "FINISHED.\nPress enter to continue"; <STDIN>;
}
exit 0;


sub DeleteFiles
{
    my ($dir) = @_;
    print "\nTo complete the uninstallation manually\n";
    print "remove the folder $dir\n";
    #system("rmdir /s $dir");
}

sub StopApacheMonitor
{
    print "Stopping Apache Monitor\n";
    sub IDS_APMONITORCLASS {"ApacheServiceMonitorClass";}
    sub WM_CLOSE {0x0010;}
    my $w = Win32::GUI::FindWindow(IDS_APMONITORCLASS, "");
    #Win32::GUI::PostMessage($w, WM_CLOSE, 0, 0) if ($w);
    Win32::GUI::PostMessage($w, WM_COMMAND, 105, 0) if ($w);
}


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\\Perl Package Manager.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",
            );

    if (!rmdir "$folderpath") {
        print "ERROR Failed to delete shortcut folder $folderpath\n";
        print LOG "ERROR Failed to delete shortcut folder $folderpath\n";
        print "Make sure to run this program in an Admin account\n";
    	error_exit();
    }
}







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 =~ /^(@|)(?<!REM)(\s*set\s+|)(\s*PATH\s*=*\s*)(.*)$/m ) {
            $current_path = $4;
        }
        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);
        print "Old autoexec.bat =\n'$data'\n" if $debug_addpath;
        DS::WriteFile($autoexec_bak, $data);
        #FORMAT: @REM set PATH=whatever
        if ($data =~ s/^(@|)(?<!REM)(\s*set\s+|)(\s*PATH\s*=*\s*)(.*)$/$1$2$3$new_path/m ) {
        }
        else {
            # no path in autoexec
            chomp $data;
            $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\\httpd.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\\httpd.exe\" -f \"$config_file\" -k uninstall";
    print LOG "cmd=$cmd\n";
    my $rc = system($cmd);
    print LOG "rc=$rc\n";
}


sub error_exit
{
    print @_ if (@_);
    print "Press enter to continue"; <STDIN>;
    exit;
}


__END__
:endofperl
