#!perl
# Copyright (c) 2002 Indy Singh/IndigoSTAR Software all rights reserved


BEGIN {
$| = 1;
open (STDERR, ">&STDOUT");
#print "Content-type: text/html\n\n<pre>\n";
}

use strict;
use Config;
use CGI;

my $ipmscript = "$Config{'binexp'}/ipm.bat";
use lib "$Config{'binexp'}";
require $ipmscript;

my $debug = 0;

my @repository_list = ipm_GetRepositoryList();
my ($repository_name, $repository_path);
($repository_name, $repository_path) = $repository_list[0] =~ /(.*?)\s*=\s*(.*)/;


my $q = new CGI;
print   $q->header,
        $q->start_html("IndigoSTAR GUI Package Manager");
print '<table border="0" cellpadding="0" cellspacing="0" width="100%">
  <tr>
    <td valign="middle" width="100%" bgcolor="#000080"><font size="+1" face="Verdana,Arial"
    color="#FFFFFF">IndigoSTAR GUI Package Manager</font></td>
  </tr>
</table>
';


if ($q->param()) {
    if ($q->param('action') eq "install" && $q->param('CurrentQuery') eq "INSTALL") {
        ProcessPRKRequest($q);
    }
    elsif ($q->param('action') eq "Remove") {
        vpm_InstallRemovePackages("remove", "", $q->param('installed_packages'));
    }
    elsif ($q->param('action') eq "Install") {
        vpm_InstallRemovePackages("install", "", $q->param('repository_packages'));
    }
    elsif ($q->param('action') eq "viewlog") {
        ViewLog($q);
    }
    elsif ($q->param('action') eq "Select") {
        my $selected = $q->param('selected_repository');
        ($repository_name, $repository_path) = $selected =~ /(.*?)\s*=\s*(.*)/;
        ipm_SaveRepositoryList(uniq("$repository_name = $repository_path", @repository_list));
        DisplayForm($q);
        DumpFormParameters($q) if $debug;
    }
    elsif ($q->param('action') eq "Add") {
        $repository_name = $q->param('repository_name');
        $repository_path = $q->param('repository_path');
        $q->param('repository_name', "");
        $q->param('repository_path', "");
        @repository_list = uniq("$repository_name = $repository_path", @repository_list);
        ipm_SaveRepositoryList(@repository_list);
        DisplayEditForm($q);
    }
    elsif ($q->param('action') eq "Edit") {
        DisplayEditForm($q);
    }
    elsif ($q->param('action') eq "Close") {
        DisplayForm($q);
    }
    elsif ($q->param('action') eq "Delete") {
        my $selected = $q->param('selected_repository');
        $selected =~ s%\\%\\\\%g;   # \ -> \\
        $selected =~ s%/%\\/%g;     # / -> \/
        $selected =~ s%\$%\\\$%g;   # $ -> \$

        print "<pre>list in = \n", join("\n", @repository_list), "\n";

        @repository_list = grep {! /$selected/} @repository_list;

        print "selected = $selected\n";
        print "list out = \n", join("\n", @repository_list), "\n";
        print "</pre>\n";

        if (@repository_list) {
            ($repository_name, $repository_path) = $repository_list[0] =~ /(.*?)\s*=\s*(.*)/;
        } else {
            ($repository_name, $repository_path) = ("", "");
        }
        ipm_SaveRepositoryList(@repository_list);
        DisplayEditForm($q);
    }
}
else {
    DisplayForm($q);
}





############################################################################



sub DisplayEditForm
{
    my ($q) = @_;

    print "<h2>Edit repository list</h2>";

    print   $q->start_form;

    print   "Selected repository: ", 
            $q->br,
            $q->popup_menu(-name=>'selected_repository',
                   -values=>\@repository_list,
                   -override=>1,
                   -default=>"$repository_name = $repository_path"),
            $q->br,
            $q->br;

    print   $q->submit("action", "Select"), " ",
            $q->submit("action", "Delete"), " ",
            $q->submit("action", "Add"), " ",
            $q->submit("action", "Close"),
            $q->br,
            $q->br;

    print   "New repository name:",
            $q->br,
            $q->textfield(-name=>'repository_name',
                            "-size" => 50,
                            "-maxlength" => 512),
            $q->br,
            "New repository path:",
            $q->br,
            $q->textfield(-name=>'repository_path',
                            "-size" => 50,
                            "-maxlength" => 512),
            $q->br,
            $q->br;

    print '<p>A repository path is one of the following:<br>
            a directory URL (e.g. http://Jenda.Krynicky.cz/perl or http://www.perl.com/CPAN-local) or,<br>
            an absolute local directory (e.g. C:\perl\myrepository) or,<br>
            a local directory, relative to the perl home directory (e.g foo\\bar).</p>';

    print $q->end_form;
}




sub DisplayForm
{
    my ($q) = @_;

    my @installed_packages = ipm_ListInstalledPackages();
    my $count_installed = @installed_packages;
    my @repository_packages = ipm_ListPackages($repository_path);
    my $count_repository = @repository_packages;

    my $listboxsize = $count_installed > $count_repository ? $count_installed : $count_repository;
    if ($ENV{'HTTP_USER_AGENT'} =~ /Opera/) {
        # Opera browser does not display a list box with 2410 items
        $listboxsize = 30; 
    }
    # A big list box can also blow-up IE 6.0/Win98 for one user at least
    $listboxsize = 30;

    print   $q->start_form;

    print   "Selected repository: ", 
            $q->br,
            $q->popup_menu(-name=>'selected_repository',
                   -values=>\@repository_list,
                   -default=>"$repository_name = $repository_path"),
            $q->br,
            $q->submit("action", "Select"), " ",
            $q->submit("action", "Edit"),
            $q->br,
            $q->br;

    print $q->table({-border=>undef},
            $q->Tr({-align=>"CENTER",-valign=>"TOP"},
            [
               $q->th(['Repository Packages', 'Installed Packages']),

               $q->td( [$q->submit("action", "Install"), $q->submit("action", "Remove")] ),

               $q->td([
        $q->scrolling_list(-name=>'repository_packages',
                                -values=>\@repository_packages,
                                -size=>$listboxsize,
                                -multiple=>'true',
                                ),
        $q->scrolling_list(-name=>'installed_packages',
                                -values=>\@installed_packages,
                                -size=>$listboxsize,
                                -multiple=>'true',
                                ),
                    ]),
            ]
            )
         );


    print $q->end_form;
}








sub DumpFormParameters
{
    my ($q) = @_;

    print $q->hr();
    if ($q->param()) {
        print "Form input<br>\n";
        my @field_names = $q->param();
        my $name;
        foreach $name (@field_names) {
            print "$name = ", $q->param($name), $q->br, "\n";
            if ($name =~ m/select\.(.*)/) {
            }
        } # foeach
    } # if
    else {
        print "No form input<br>\n";
    }
    print $q->hr();
}





sub uniq
{
    my @uniq;
    my %x;
    foreach (@_) {
        push(@uniq,$_) unless( $x{$_}++ );
    }
    return @uniq;    
}



sub ViewLog
{
    my ($q) = @_;

    my $filename = $q->param('filename');
    my $data;
    open (IN, $filename);
    if (!open (IN, "$filename")) {
        # this is a refresh on a cleaned up file
        $data = "DONE\n";
    }
    else {
        read (IN, $data, (-s IN));
        close IN;
    }

    if ($data !~ /DONE\n$/m) {
        print "<META HTTP-EQUIV=\"Refresh\" CONTENT=\"1\">\n";
        print "Please wait...<br>\n";
        print "STATUS: Processing request...<br>\n";
    }
    else {
        print "<A HREF=\"$ENV{'SCRIPT_NAME'}\" onClick=parent.TOC.history.go(0)>PLEASE CLICK HERE TO RETURN</A><br>\n";
        print "STATUS: COMPLETE<br>\n";
        unlink($filename);
    }
    print $q->hr();
    #print "The time = ", scalar(localtime()), "<br>\n";
    #print "log file results:<hr>\n";
    $data =~ s/\n/<br>\n/sg;
    print $data;
    print "</body></html>\n";
}





sub vpm_InstallRemovePackages
{
        my ($action, $save_location, @packages) = @_;

        my $selected = $q->param('selected_repository');
        ($repository_name, $repository_path) = $selected =~ /(.*?)\s*=\s*(.*)/;
        chdir($Config{'prefix'});   # relative repository names are relative to prefix

        my $packages = join(" ", @packages);
        $packages =~ s/ \[.*?\]//g;

        my $tempdir = $ENV{'TEMP'} || $ENV{'TMP'} || $Config{'prefix'};
        my $outfile = "$tempdir\\dpm_out$$.tmp";
        WriteFile($outfile, "Problemo! Install/Remove process failed to start\n");

        print "Please wait...<br>\n";
        print "STATUS: Processing request...<br>\n";
        print $q->hr();

        print "<META HTTP-EQUIV=\"Refresh\" CONTENT=\"1;URL=http://$ENV{'HTTP_HOST'}$ENV{'REQUEST_URI'}?action=viewlog&filename=$outfile\">\n";
        my $saveparam = $save_location ? "-save_location=$save_location" : "";
        my $command = "$Config{'perlpath'} $ipmscript $saveparam -location $repository_path $action $packages >$outfile";

        #print "Starting command '$command' <br>\n" if $debug;
        if(not Win32::IsWinNT()){
        	close STDOUT; close STDERR;    # need this for Win98
        }
        system_nowindow($command);
}



sub ProcessPRKRequest
{
    #TODO call vpm_InstallRemovePackages

    my ($q) = @_;
    # if it looks like a default.prk install action, run it
    my @field_names = $q->param();
    my @ppdlist;
    my $name;
    foreach $name (@field_names) {
        if ($name =~ m/select\.(.*)/) {
            push (@ppdlist, $1);
        }
    }

    my $command = "$Config{'perlpath'} $ipmscript install -location " .
                $q->param('location') . 
                join(" ", @ppdlist);
    print "command = $command<br>\n";
    print $q->hr();
}




use Win32::Process; use Win32; 
sub ErrorReport{
    Win32::MsgBox(Win32::FormatMessage( Win32::GetLastError() ),16,'Error');
}


sub system_nowindow
{
    my ($cmd) = @_;
    # create a hidden process, allows io redirection
    # eg application >outfile
    # Under Win98 works in cgi mode, but not in console mode
    my ($shell, $ProcessObj);
    $shell = "$ENV{ComSpec}";

    Win32::Process::Create($ProcessObj,
            "$shell",
            "$shell /c $cmd",
            0,
            NORMAL_PRIORITY_CLASS | 
            #CREATE_NO_WINDOW,       # need this for NT, no effect in 98
		    #DETACHED_PROCESS,       # need this for 98, but bombs NT
		    (Win32::IsWinNT() ? CREATE_NO_WINDOW : DETACHED_PROCESS),
#            ".")|| return 0;
            ".")|| print Win32::FormatMessage( Win32::GetLastError() );

    #$ProcessObj->Wait(INFINITE);
    return 1;
}




############################################################################


############################################################################
package DPM::Handle;
require Tie::Handle;

my @ISA = ( "Tie::Handle" );

sub TIEHANDLE
{
    #TIEHANDLE classname, LIST
    my ($class, @list) = @_;
    my $self = {};
    $self->{'buffer'} = $list[0];
    return bless($self, $class);
}

sub WRITE
{
    my ($self, $buffer, $len, $offset) = @_;
    ${$self->{'buffer'}} .= substr($buffer, $len, $offset);
}

sub PRINT
{
    my ($self, @list) = @_;
    ${$self->{'buffer'}} .= join('', @list);
}

sub PRINTF
{
    my ($self, $format, @list) = @_;
    ${$self->{'buffer'}} .= sprintf($format, @list);
}

