#!/usr/bin/perl
# Visual Package Manager
# Works under MiniSrv
#
# Authors: Mike Smith mikes@activestate.com
#          Jay Thorne jayt@activestate.com
#
#####################################################################
use strict;
use PPM;
use URI::Escape;
use File::Basename;


our $g_More;
our $_debug=0;
our %parameters = ();

GetParameters();
SelectAction();

###########################################################
#   SelectAction
#
#   Goes to the next stage of the registration. The
#   decision is based on the name of the submit button that
#   was clicked in order to submit the last form. Only one
#   button will show up as one of the form variables,
#   therefore that must have been the button pushed.
#
###########################################################
sub SelectAction {
    if ( $parameters{'CurrentQuery'} ) {
	Queries($parameters{'CurrentQuery'});
    }	
    else {
	headerOK();
	print "No Form Action\n";
	print map { "$_ = $parameters{$_}<br>" } keys %parameters;
    }
}	

sub Queries {
    if ($_debug>0) {
	print STDERR "\nNew Query\n" ;
	foreach my $key (keys(%parameters)) {
		print STDERR "$key -> $parameters{$key}\n";
	}
    }
    local $_ = shift;
    QUERY:	{
	    /help/i    and do {HelpScreen(); last QUERY;};
	    /verify/i  and do {VerifyScreen(); last QUERY;};
	    /remove/i  and do {RemoveScreen(); last QUERY;};
	    /install/i and do {InstallScreen(); last QUERY;};
	    /options/i and do {OptionsScreen(); last QUERY;};
	    /reposit/i and do {RepositoryScreen(); last QUERY;};
	    /QUIT/i    and do {QuitScreen(); last QUERY;};
    }
}

#####################################################################
#####################################################################
sub VerifyScreen {
    # all verify functions require a re-paint of the screen
    # 
# list of packages installed
    headerOK();
    if(defined $parameters{'DoQueryFrame'}) {
	my %reps = PPM::ListOfRepositories();
	my $repositorylist="";
	foreach my $name (keys %reps) {
	    if ($reps{$name} =~ /file:/ ) {
		$repositorylist .="<Option value=\"vpm.pl?action=repository&repository=$reps{$name}\">$name\n";
	    }
	    else {
		    $repositorylist .="<option value=\"$reps{$name}\">$name\n";
	    }
	}
	print <<THEEND;
	<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">
	
	<HTML>
	<HEAD>
		<TITLE>Verify Query</TITLE>
	
		$::copyForm
	
	</HEAD>
	
	<BODY bgcolor="#ffffff">
	
    <!-- beginning of content -->
	
    <!-- query table-->
	<center>
	<form method="POST" name="verify_form" action="vpm.pl" target="results">
	<input type="hidden" name="CurrentQuery" value="VERIFY">
	<table  width=600 cellpadding=7 cellspacing=0 border=0 bgcolor="#006699">
	
	<tr>
	<td valign="top" align="left">&nbsp;&nbsp;</td>
	<td colspan=2 valign="middle" align="left"><font face="verdana, arial, helvetica" size="2" color="#ffffff">
	<strong>Repository URL</strong>
    &nbsp;&nbsp;
    <select name=Repository>
	$repositorylist 
    </select>
	</td>
	<td>&nbsp;</td>
	</tr>
	
	<tr>
	<td valign="top" align="left">&nbsp;&nbsp;</td>
	<td colspan=2 valign="middle" align="left"><font face="verdana, arial, helvetica" size="2" color="#ffffff">
	<strong>Sort By</strong>
	&nbsp;&nbsp;
	<input type="radio"  name="sort" value="package" CHECKED>
	Package&nbsp;
	
	<input type="radio"  name="sort" value="author">
	Author&nbsp;	 
	<input type="radio"  name="sort" value="date">
	Install Date&nbsp;&nbsp;
	<input type="button" onClick="copyForm(parent.query.document.forms['verify_form'], parent.results.document.forms['VPMform']); parent.results.document.forms['VPMform'].ButtonPressed.value = 'Refresh'; parent.results.document.forms['VPMform'].submit();" name="REFRESH" value="Refresh"> 


	</font></td>
	<td>&nbsp;</td>
	</tr>
	<tr>

	
		<td>&nbsp;</td>
	<td  valign="middle" align="left">
    <input type="button" onClick="copyForm(parent.query.document.forms['verify_form'], parent.results.document.forms['VPMform']); parent.results.document.forms['VPMform'].elements['Select'].value = '1'; parent.results.document.forms['VPMform'].ButtonPressed.value = 'Refresh'; parent.results.document.forms['VPMform'].submit();" name="Select" value="Select All">
    <input type="button" onClick="copyForm(parent.query.document.forms['verify_form'], parent.results.document.forms['VPMform']); parent.results.document.forms['VPMform'].elements['clear'].value = '1'; parent.results.document.forms['VPMform'].ButtonPressed.value = 'Refresh'; parent.results.document.forms['VPMform'].submit();" name="clear" value="Clear all">
    </td>
    <td  valign="middle" align="right">
    <input type="button" onClick="copyForm(parent.query.document.forms['verify_form'], parent.results.document.forms['VPMform']); parent.results.document.forms['VPMform'].ButtonPressed.value = 'Verify'; parent.results.document.forms['VPMform'].submit();" name="VERIFY" value="Verify">
    <input type="button" onClick="copyForm(parent.query.document.forms['verify_form'], parent.results.document.forms['VPMform']); parent.results.document.forms['VPMform'].ButtonPressed.value = 'Update'; parent.results.document.forms['VPMform'].submit();" name="UPDATE" value="Update">

	</td>
	<td>&nbsp;</td>
	</tr>
	
	</table>
	</form>
	</center>
    <!-- query table-->
    <!-- end of content -->
	</BODY>
	</HTML>

THEEND
    }
    else {
	if ($parameters{'ButtonPressed'} =~/update/i) {
	    UpdatePackages();
	}
	elsif ( $parameters{'action'} eq 'detail' ) {
	    DetailPackage();
	    return;
	}
	ListInstalledPackages();
    }
}

###############################################################################
# Subroutine: RemoveScreen()
###############################################################################
sub RemoveScreen {
    headerOK();
    RemovePackages();
    ListInstalledPackages();
}
###############################################################################
# Subroutine: RepositoryScreen()
###############################################################################
sub RepositoryScreen {
    headerOK();
    if ( $parameters{'action'} eq 'detail' ) {
        DetailAvailPackage();
        return;
    }
    my $location = $parameters{'location'};
    if ($location =~ /^file:/) {
        $location =~ s@file://@@;
        $location =~ s@\|@:@;
    }
    my $lastchr = substr($location, -1);
    if ($lastchr ne '/' && $lastchr ne '\\') {
        $location .= '/';
    }
    
    print `$^X ${location}default.prk` or print "No Open $!\n";
}
###############################################################################
# Subroutine: InstallScreen()
###############################################################################
sub InstallScreen {
	
    headerOK();

    if ( $parameters{'action'} =~ /install/i ) 	{ 
	InstallThesePackages(); 
	return; 
    }

    if($parameters{'action'} eq "SEARCH") {
	ListAvailablePackages();
	return;
    }
    my %reps = PPM::ListOfRepositories();
    my $repositorylist="";
    foreach my $name (keys %reps) 
    {
	my $safe = uri_escape($reps{$name}, '^A-Za-z');
	$repositorylist .="<option value=\"$safe\">$name\n";
    }

    my $queryString = "'/vpm.pl?CurrentQuery=INSTALL&action=SEARCH&repository=' + parent.query.document.forms['VPMform'].repository.options[parent.query.document.forms['VPMform'].repository.selectedIndex].value";
    
    print <<ENDOFINSTALL;
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">
<HTML> 
	<HEAD> 
	<TITLE>Install Query</TITLE> 
	$::copyForm
	</HEAD> 
<BODY bgcolor="#ffffff">
<center>
<form method="POST" name="VPMform" action="vpm.pl" target="results">
<input type="hidden" name="currentQuery" value="INSTALL">
<table  width=600 cellpadding=7 cellspacing=0 border=0 bgcolor="#006699">
<tr> <td valign="top" align="left">&nbsp;&nbsp;</td> 
<td colspan=2 valign="middle" align="left">
<font face="verdana, arial, helvetica" size="2" color="#ffffff"
<strong>Repository URL</strong> &nbsp;&nbsp; 
<select name="repository">
$repositorylist 
</select> 
&nbsp;<input type="button" value="&nbsp; Refresh &nbsp;" onclick="parent.results.document.location = $queryString;"></td> <td>&nbsp;</td> </tr> </table> </form> </center></BODY> </HTML>

ENDOFINSTALL
	}

###############################################################################
# Subroutine: ListAvailablePackages()
###############################################################################
sub ListAvailablePackages() {
    my $Table = '';
    my $TableHead = '';
    my %summary = PPM::RepositorySummary('location' => $parameters{'repository'});
    if(scalar keys %summary) {
	foreach my $repository (keys %summary) {
	    my %packages = map { lc $_ => $_ } keys %{$summary{$repository}};
	    foreach my $lcname (sort keys %packages) {
		my $author;
		my $email;
		my $version;
		if($summary{$repository}->{$packages{$lcname}}->{'AUTHOR'} =~ m/(.*\s+)+\((.*?)\)/) {
		    $author = $1;
		    $email = $2;
		}
		    $version = $summary{$repository}->{$packages{$lcname}}->{'VERSION'};
		    while ($version =~ /,0$/) {
			$version =~ s/,0$//;
		    }
		    $version =~ tr/,/./;

		my $safe_location = uri_escape($parameters{'repository'}, '^A-Za-z');
									
		$Table .= <<HERE;
	<tr> 
		<td> <input type="checkbox" name="select.$packages{$lcname}"> </td>
		<td> <a href="vpm.pl?CurrentQuery=repository&action=detail&name=$packages{$lcname}&location=$safe_location">$packages{$lcname}</a> </td>
		<td> <a href="mailto:$email">$author </a> </td>
		<td> $version </td>
	</tr>

HERE
	    }
	}
	$TableHead = "<th>Package</th><th>Author</th><th>Version</th>";
    }
    else {
        %summary = PPM::RepositoryPackages('location' => $parameters{'repository'});
	if(scalar keys %summary) {
	    foreach my $pkg_name (@{$summary{$parameters{'repository'}}}) {
		my $lcname = lc($pkg_name);
		$Table .= <<HERE;
	<tr> 
	    <td> <input type="checkbox" name="select.$pkg_name"> </td>
	    <td> <a href="vpm.pl?CurrentQuery=repository&action=detail&name=$pkg_name&location=$parameters{'repository'}">$pkg_name</a> </td>
	</tr>

HERE

	    }
	    $TableHead = "<th>Package</th>";
	}
	else {
	    $Table = <<HERE;
	<TR>
	    <TD> There are no packages available at $parameters{'repository'} !<BR>
	    Please choose a different repository.
	    </TD>
	</TR>
HERE
	    $TableHead = '';
	}
    }

    print qq(<html><body bgcolor="#ffffff"><center><form action="/vpm.pl" method="POST">);
    print qq(<input type="hidden" name="CurrentQuery" value="INSTALL">\n);
    print qq(<input type="hidden" name="location" value="$parameters{'repository'}">\n);
    print qq(<input type="hidden" name="action" value="install">\n);
    print qq(<table width="600" cellpadding="3" cellspacing="0" border="1">\n);
    print qq(<tr><td><input type="Submit" name="Submit" value="Install These Packages"></td>\n);
    print qq($TableHead</tr>\n);
    
    print $Table;

    print qq(</table></form></center></body></html>\n);
		
}

#####################################################################
#####################################################################
sub OptionsScreen {
    headerOK();
    UpdateOptions() if $parameters{'changes'};
    UpdateRepositories() if( $parameters{'add'} || $parameters{'remove'} );
    DisplayOptions();
}

#####################################################################
#####################################################################
sub UpdateOptions {
    print STDERR "applying changes\n";
    my %opts=();
    $opts{"MORE"}=$g_More;
    $opts{"IGNORECASE"}="No";
    $opts{"CLEAN"}="No";
    $opts{"CONFIRM"}="No";
    $opts{"FORCE_INSTALL"}="No";
    $opts{"ROOT"}=$parameters{'root'};
    $opts{"BUILDDIR"}=$parameters{'build'};
    $opts{"IGNORECASE"} = "Yes" if ( $parameters{'Case'} eq "yes" );
    $opts{"CLEAN"} = "Yes" if ( $parameters{'Clean'} eq "yes" ) ;
    $opts{"CONFIRM"} = "Yes" if ( $parameters{'Confirm'} eq "yes" ) ;
    $opts{"FORCE_INSTALL"} = "Yes" if ( $parameters{'Force_install'} eq "yes" ) ;
    PPM::SetPPMOptions("options" => \%opts, "save" => 1);
}
	
#####################################################################
#####################################################################
sub UpdateRepositories {
    if ( $parameters{'add'} ) {
	return if ($parameters{'Newrepository'} eq "");
	my $repository = undef;

	if ($parameters{'Friendly'} ne "") {
	    $repository = $parameters{'Friendly'};
	}
	else {
	    $repository = $parameters{'Newrepository'}; 
	}
	
	PPM::AddRepository( "repository" =>$repository ,"location" => $parameters{'Newrepository'}, "save" => 1);
    } 
    else { 
	# remove selected items
	return if  ($parameters{'repository'} eq "");
	my ($name,$location) = split(/::/,$parameters{'repository'});
	PPM::RemoveRepository("repository" =>$name , "save" => 1);
    }
}

#####################################################################
#####################################################################
sub InstallThesePackages {
    my $SelectedPackages = GetSelectedList();
    my $location=$parameters{'location'};
    my $lastchr = substr($location, -1);
    if ($lastchr ne '/' && $lastchr ne '\\') {
	$location .= '/';
    }

    $SelectedPackages =~ s/^%%//;
    my @packages = sort (split (/%%/, $SelectedPackages));
    print q(<BODY bgcolor="#ffffff">
	    <center>
	    <table  width="600" border="0"><tr><td>);
    if ($#packages >= 0) {
	if ($#packages == 0) {
	    print "VPM is installing package <b>$packages[0]</b> from <b>'${location}'</b>.<BR>";
	}
	else {
	    print "VPM is installing the following packages from <b>'${location}'</b>:<BR><BR>";
	    foreach my $package (@packages) {
		print "&nbsp;&nbsp;&nbsp;&nbsp;<b>$package</b><BR>";
	    }
	}
	print "<BR>Depending on the speed of your Internet connection or CD-ROM drive, and the size of the package you are installing, this may take anywhere from a few seconds to several minutes.  Please wait...<BR><BR>\n";
    }

    my $status= '';
    my $buffer;
    {
# Catch all ouput to STDOUT in this block so that we can later 
# format it to our likeing
	local *STDOUT;
	tie *STDOUT, 'VPM::Handle', \$buffer;
	foreach my $package (@packages) {
	    next if (! $package); 
	    $status = PPM::InstallPackage('package' =>  $package, 'location' => $parameters{'location'} );
	    print "PPM Status: $status\n";
	    if ($status eq '0') {
		print "Error installing package <b>$package</b> from '${location}': $PPM::PPMERR <br>\n";
	    }
	    else {
		print "Package <b>$package</b> from '${location}' successfully installed.<p>\n";
	    }
	}
	untie *STDOUT;
    }

# format the output and send it to STDOUT
    $buffer =~ s/\n/<br>\n/mg;
    print $buffer;
    print q(</td></tr></table></center></body></html>);
}
	
	
	
#####################################################################
#####################################################################
sub DisplayOptions {
    # display screens
    PPM::reread_config();
    my %opts = PPM::GetPPMOptions();
    my($clean,$case,$confirm,$force_install)="";
    my ($builddir)=$opts{'BUILDDIR'};
    my ($rootdir)=$opts{'ROOT'};
    $g_More = $opts{'MORE'};
    $case = "CHECKED" if ( $opts{'IGNORECASE'} eq "Yes");
    $clean = "CHECKED" if ( $opts{'CLEAN'} eq "Yes");
    $confirm = "CHECKED" if ( $opts{'CONFIRM'} eq "Yes");
    $force_install = "CHECKED" if ( $opts{'FORCE_INSTALL'} eq "Yes");
    my %reps = PPM::ListOfRepositories();
    my $repositorylist="";
    foreach my $name (keys %reps) {
	$repositorylist .="<option \"$name::$reps{$name}\">$name\n";
    }
    print <<ENDOFOPTSCREEN;
	
<html> <head> <title>Options</title> </head> 
<body onLoad="if (parent.navstrip){parent.navstrip.imgPlace('img4'); parent.navstrip.imgPlaceOff('img1'); parent.navstrip.imgPlaceOff('img2'); parent.navstrip.imgPlaceOff('img3'); parent.navstrip.imgPlaceOff('img5'); parent.navstrip.imgPlaceOff('img6')}" bgcolor="#ffffff"> 

	<center>

		
		<form name="VPMform" action="vpm.pl" method="POST">
		<input type="hidden" name="CurrentQuery" value="OPTIONS">
		
		<table width=600 bgcolor="#006699" cellspacing="0" cellpadding="4" border="0">
		<tr> <td nowrap valign="top"  align="right"> 
		<font size="2" face="verdana, arial, helvetica" color="#ffff00">Build Dir&nbsp;&nbsp; </font></td> 
		<td	valign="top">
		<input type="text" size="20" name="build" value="$builddir"> 
		</td>
		<td width="100%" valign="left" align="top"><input type="submit" size="20" value="&nbsp;&nbsp;Apply&nbsp;&nbsp;&nbsp;" name="changes"></td>
		</tr> <tr> <td valign="top"  align="right"> <font size="2" face="verdana, arial, helvetica" color="#ffff00">Root Dir&nbsp;&nbsp; </font></td> <td valign="top"> <!-- begin root value -->
		<input type="text" size="20" name="root" value="$rootdir">
		</td>
		
<td>&nbsp;</td>		
		
		
		</tr>
		<tr> <td valign="top"  align="right"> <font size="2" face="verdana, arial, helvetica" color="#ffff00">Case&nbsp;&nbsp; </font></td> <td valign="top"> <font size="2" face="verdana, arial, helvetica" color="#ffffff">
		<input type="checkbox" name="Case" value="yes" $case>
		</font></td>

<td>&nbsp;</td>


		</tr> <tr> <td valign="top" align="right"> <font size="2" face="verdana, arial, helvetica" color="#ffff00">Clean&nbsp;&nbsp; </font></td> <td valign="top"> <font size="2" face="verdana, arial, helvetica" color="#ffffff">
		<input type="checkbox" name="Clean" value="yes" $clean>
		</font> </td>



<td>&nbsp;</td>	

		</tr>
		
		<tr> 
			<td valign="top" align="right"> 
			<font size="2" face="verdana, arial, helvetica" color="#ffff00">Confirm&nbsp;&nbsp; </font></td> <td valign="top"> 
			<font size="2" face="verdana, arial, helvetica" color="#ffffff">
			<input type="checkbox" name="Confirm" value="yes" $confirm> 
			</font> 
			</td> 



<td>&nbsp;</td>	




		</tr>
		
		<tr> 
		    <td valign="top" align="right"> 
		    <font size="2" face="verdana, arial, helvetica" color="#ffff00">Force installs&nbsp;&nbsp; </font></td> <td valign="top"> 
		    <font size="2" face="verdana, arial, helvetica" color="#ffffff">
		    <input type="checkbox" name="Force_install" value="yes" $force_install> 
		    </font> 
		    </td> 

<td>&nbsp;</td>	



		</tr>
		
		<tr> 
		<td>
		&nbsp;
		
		</td>

<td>&nbsp;</td>	

<td>&nbsp;</td>	



</tr> 
</table>
</form>

		
		<form name="VPMform" action="vpm.pl" method="POST">
		<input type=hidden name=CurrentQuery value="OPTIONS">

		<table width=600 bgcolor="#006699" cellspacing="0" cellpadding="4" border="0">
		<tr> <td nowrap align="right" valign="top">
		<font size="2" face="verdana, arial, helvetica" color="#ffff00"> &nbsp;
		</font></td>
		<td>&nbsp;</td>
		<td width="100%" valign="top" align="left">
		<!-- begin add -->
		
		&nbsp;
		
		</td> </tr>
		
		<tr> <td nowrap align="right" valign="top"> 
		<font size="2" face="verdana, arial, helvetica" color="#ffff00"> 
		Repository Name </font></td> 
		<td><input type="text" size="24" maxlength="30" name="Friendly"> </td>
		<td width="100%" valign="bottom" align="left"> &nbsp; </td> </tr> 
		<tr><td align="right" valign="top"> 
		<font size="2" face="verdana, arial, helvetica" color="#ffff00"> Repository URL </font></td>
		<td>
		<input type="text" size="24" name="Newrepository">
		</td> <td width="100%"valign="bottom" align="left"> 
		<input type="submit" size="20" value="&nbsp;&nbsp;&nbsp;&nbsp;Add&nbsp;&nbsp;&nbsp;&nbsp;" name="add"> 
		</td>
		</tr>

		<tr>
		<td valign="top"> <font size="2" face="verdana, arial, helvetica" color="#ffff00">
		Repository List
		</font> </td>
		 <td valign="top">
		<select name="repository" size=5>
		$repositorylist
</select>
		</td>
		<td valign="top" align="left">
		<input type="submit" size="20" value="Remove" name="remove">&nbsp;&nbsp;
		</td>
		</tr> </table> </form>
		</center> </body> </html>


ENDOFOPTSCREEN
# " <-- Fix colorization
}
	
	
#####################################################################
#####################################################################
sub QuitScreen {
    headerOK();
    print "<BODY bgcolor=\"#ffffff\">\n\n<center>VPM has terminated, you may now close your browser.</center>\n";
    # hack: set an envvar for the miniserver to know we're done
    $ENV{EXITSRV} = 1;
}
	
#####################################################################
#####################################################################
sub RemovePackages {
    my $SelectedPackages="";
    foreach my $key ( keys ( %parameters ) ) { 
	if ($key =~ /select\.(.*)/ ) {
	    $SelectedPackages .= "%%$1";
	}
    }
    my %installed = PPM::InstalledPackageProperties();
    my $status="";
    foreach my $package (sort (keys (%installed))) {
	next if $SelectedPackages !~ /$package/; 
	# skip if not on the list of packages
	$status = PPM::RemovePackage('package' => $package);
	if ($status eq '1') {
	    print "<center>Package <b>$package</b> Removed <br><br></center>\n";
	}
	else {
	    print "<center>Package <b>$package</b> Error on Remove: $status<br><br></center>\n";
	}
    }
}



#####################################################################
#####################################################################
sub UpdatePackages {
    my $SelectedPackages="";
    
    foreach my $key ( keys ( %parameters ) ) { 
	if ($key =~ /select\.(.*)/ ) {
	    $SelectedPackages .= "%%$1";
	}
    }
    my %installed = PPM::InstalledPackageProperties();
    my $status="";
    my %reps = PPM::ListOfRepositories();
    my $location = $reps{$parameters{'Repository'}};
    if ($location =~ /^file:/) {
        $location =~ s@file://@@;
        $location =~ s@\|@:@;
    }
    foreach my $package (sort (keys (%installed))) {
	next if $SelectedPackages !~ /$package/; 
	# skip if not on the list of packages
	$status=PPM::UpgradePackage('package' => $package, 'location' => $location);
	if ($status eq '0') {
	    print "<BODY bgcolor=\"#ffffff\">\nPackage <b>$package</b> is up-to-date.<br>\n";
	}
	else {
	    $status = format_version($status);
	    print "<BODY bgcolor=\"#ffffff\">Package <b>$package</b> updated to version $status<br>\n";
	}
    }
}


#####################################################################
#####################################################################
sub GetSelectedList {
    my $SelectedPackages= '';
    foreach my $key ( keys ( %parameters ) ) { 
	if ($key =~ /select\.(.*)/ ) {
	    $SelectedPackages .= "%%$1";
	}
    }
    return $SelectedPackages;
}



#####################################################################
#####################################################################
sub ListInstalledPackages {
    my $printAvail=0;
    if ( $parameters{'CurrentQuery'} =~ /verify/i ) {
	$printAvail = 1;
    }

    PPM::reread_config(); # to make sure we have the current list
    my %installed = PPM::InstalledPackageProperties();
    my $status="";
    my @sorted;
    
    
    if($parameters{'sort'} eq 'author') {
	@sorted = sort { lc($installed{$a}->{'AUTHOR'}) cmp lc($installed{$b}->{'AUTHOR'}) } 
	    keys %installed;
    } elsif($parameters{'sort'} eq 'date') {
	@sorted = sort { lc($installed{$a}->{'DATE'}) cmp lc($installed{$b}->{'DATE'}) } 
	    keys %installed;
    } else {
	@sorted = sort { lc($installed{$a}->{'NAME'}) cmp lc($installed{$b}->{'NAME'}) } 
	    keys %installed ;
    }
    
    # table header
    print <<ENDHEADER;	

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">
<HTML> <HEAD> <TITLE>Install Query</TITLE> </HEAD> 
<BODY bgcolor="#ffffff">
<center>
<form name="VPMform" action="vpm.pl" method="POST">
<input type="hidden" name="ButtonPressed" value="">
<input type="hidden" name="Repository" value="">
<input type="hidden" name="sort" value="">
<input type="hidden" name="REFRESH" value=""> 
<input type="hidden" name="Select" value="">
<input type="hidden" name="clear" value="">
<input type="hidden" name="VERIFY" value="">
<input type="hidden" name="UPDATE" value="">
<input type="hidden" name="REMOVE" value="">
<input type="hidden" name="CurrentQuery" value="$parameters{CurrentQuery}">
<center> <table  width=600 cellpadding=3 cellspacing=0 border=1> <tr> <td valign="top"><font
face="verdana, arial, helvetica" size="2"> &nbsp; </font></td> <td nowrap><font
face="verdana, arial, helvetica" size="2"> Package </font></td> <td nowrap><font
face="verdana, arial, helvetica" size="2"> Author </font></td> <td><font face="verdana,
arial, helvetica" size="2"> Inst. Date </font></td> <td><font face="verdana, arial,
helvetica" size="2"> Version </font></td> 
ENDHEADER

    if ($printAvail) { print <<ENDAVAIL1;
<td><font face="verdana, arial, helvetica" size="2">
Ver. Avail.
</font></td> </tr>
ENDAVAIL1
    }
    print"\n</tr>";	

    # Now for EACH item in the hash
    my ($Packages)=GetSelectedList();
    foreach my $package_name (@sorted) {
	next if length($package_name) == 0;
	my $installed_ver = format_version($installed{$package_name}{'VERSION'});
	my $color = undef;
	my $repversion = undef;
	if ( $parameters{'ButtonPressed'} eq 'Verify' && $Packages =~ /$package_name/  ) {
	    my %reps = PPM::ListOfRepositories();
	    my $location = $reps{$parameters{'Repository'}};
	    if ($location =~ /^file:/) {
		$location =~ s@file://@@;
		$location =~ s@\|@:@;
	    }
	    my %repository=PPM::RepositoryPackageProperties('package' => $package_name, 'location' => $location);
	    $repversion=$repository{'VERSION'};
	    if ($repversion ne $installed{$package_name}{'VERSION'}) {
		$color='#ff0000';
	    }
	    else { 
		$color = "000000"
	    }
	
	    $repversion = format_version($repversion);
	}
	else{
	    $color="000000";
	    $repversion="Unknown";
	}

	my ($author, $email);
	if ($installed{$package_name}{'AUTHOR'} =~ /.*\(.*\)/) {
	    ($author,$email) = $installed{$package_name}{'AUTHOR'} =~ /(.*)\((.*)\)/;
	}
	elsif ($installed{$package_name}{'AUTHOR'} =~ /.*<.*>/) {
	    ($author,$email) = $installed{$package_name}{'AUTHOR'} =~ /(.*)<(.*)>/;
	}
	elsif ($installed{$package_name}{'AUTHOR'} =~ /.*&lt;.*&gt;/i) {
	    ($author,$email) = $installed{$package_name}{'AUTHOR'} =~ /(.*)&lt;(.*)&gt;/i;
	}
	else {
	    $author = $installed{$package_name}{'AUTHOR'};
	    undef $email;
	}
	print qq(<!--Key:$package_name-->\n);
	print qq(<tr><td valign="top"><font face="verdana, arial, helvetica" size="2">\n);
	print qq(<input name="select.$installed{$package_name}{'NAME'}" type="checkbox" value="checked" );
	print "checked " if ($parameters{'Select'} eq '1' || 
						 $parameters{"select.$installed{$package_name}{'NAME'}"} eq 'checked' && 
						 !($parameters{'clear'} eq '1'));
	print " >\n";
	print <<ENDROW;

</font></td>
<td><font face="verdana, arial, helvetica" size="2">
<A href="vpm.pl?CurrentQuery=VERIFY&action=detail&name=$installed{$package_name}{'NAME'}">
$installed{$package_name}{'NAME'}
	</a>
	</font></td>
	<td><font face="verdana, arial, helvetica" size="2">
ENDROW
       

	if (defined $email) {
	    print "<A href=\"mailto:$email\">$author</a>";
        }
        else {
            print "<A>$author</a>";
        }

	
	print <<ENDROW;    
	</font></td>
	<td><font face="verdana, arial, helvetica" size="2">
	$installed{$package_name}{'DATE'}
	</font></td>
	<td>
<!-- insert color="#ff0000" in following font tag if Version Installed doesnt equal Available -->
	<font color="$color">
	<face="verdana, arial, helvetica" size="2">
<!-- begin insert version Installed -->
$installed_ver
<!-- end insert version Installed -->
	</font></td>
ENDROW


	if ($printAvail) { print <<ENDAVAIL;
<td>
<font color="000000" face="verdana, arial, helvetica" size="2"> 
$repversion </font></td>
ENDAVAIL
	}
	print"\n</tr>";	
    }

    print "</FORM></TABLE>\n</center></body></html>\n";
	
}

#
# sorting functions for List screen
#######
#
#TBD
#
#######

#####################################################################
#####################################################################
sub by_package 
{  
	lc($a) cmp lc($b);
}

#####################################################################
#####################################################################
sub by_author 
{ 
	lc($a) cmp lc($b);
}

#####################################################################
#####################################################################
sub by_date 
{ 
	$b cmp $a;
}

#####################################################################
#####################################################################
sub by_ {}



#####################################################################
#####################################################################
sub DetailPackage {
	my $package=$parameters{'name'};
	my %installed = PPM::InstalledPackageProperties();
    my $installed_ver = format_version($installed{$package}{'VERSION'});
	print <<EOH;

<BODY bgcolor="#ffffff">
    
<form name="VPMform" action="vpm.pl" method="POST">
<input type="hidden" name="ButtonPressed" value="">
<input type="hidden" name="Repository" value="">
<input type="hidden" name="sort" value="">
<input type="hidden" name="REFRESH" value=""> 
<input type="hidden" name="Select" value="">
<input type="hidden" name="clear" value="">
<input type="hidden" name="VERIFY" value="">
<input type="hidden" name="UPDATE" value="">
<input type="hidden" name="REMOVE" value="">
<input type="hidden" name="CurrentQuery" value="$parameters{CurrentQuery}">
</form>
<center>
<table width="600" cellpadding="3" cellspacing="0" border="1"> <tr> <td valign="top">

EOH
    print "<b>Name:</b></td><td>$installed{$package}{'NAME'}</tr><tr><td valign=\"top\">\n";
    print "<b>Author:</b></td><td>$installed{$package}{'AUTHOR'}</tr><tr><td valign=\"top\">\n";
    print "<b>Date:</b></td><td>$installed{$package}{'DATE'}</tr><tr><td valign=\"top\">";
    print "<b>Version:</b></td><td>$installed_ver</tr><tr><td valign=\"top\">\n";
    print "<b>Abstract:</b></td><td>$installed{$package}{'ABSTRACT'}</tr><tr><td valign=\"top\">\n";
    if (defined $installed{$package}{'DEPEND'}) {
        print "<b>Dependencies: </b></td><td>";
        foreach my $dep (@{ $installed{$package}{'DEPEND'} }) {
	     print "<b><A href=\"vpm.pl?CurrentQuery=VERIFY&action=verify&name=$dep\">$dep</a><br>\n";
        }
        print "</td></tr>\n";
    }
     print "</table></center></body></html>\n";
}

sub DetailAvailPackage {
    my $package=$parameters{'name'};
    my $location=$parameters{'location'};
    my %properties=PPM::RepositoryPackageProperties('package' => $package, 'location' => $location);
    my $version = format_version($properties{'VERSION'});
    print <<EOH;

<BODY bgcolor="#ffffff">
    
<form name="VPMform" action="vpm.pl" method="POST">
<input type="hidden" name="ButtonPressed" value="">
<input type="hidden" name="Repository" value="">
<input type="hidden" name="sort" value="">
<input type="hidden" name="REFRESH" value=""> 
<input type="hidden" name="Select" value="">
<input type="hidden" name="clear" value="">
<input type="hidden" name="VERIFY" value="">
<input type="hidden" name="UPDATE" value="">
<input type="hidden" name="REMOVE" value="">
<input type="hidden" name="CurrentQuery" value="$parameters{CurrentQuery}">
</form>
<center>
<table width="600" cellpadding="3" cellspacing="0" border="1"> <tr> 
<td valign="top">

EOH
    print "<b>Name:</b></td><td>$properties{'NAME'}</tr><tr><td valign=\"top\">\n";
    print "<b>Author:</b></td><td>$properties{'AUTHOR'}</tr><tr><td valign=\"top\">\n";
    print "<b>Version:</b></td><td>$version</tr><tr><td valign=\"top\">\n";
    print "<b>Abstract:</b></td><td>$properties{'ABSTRACT'}</tr><tr><td valign=\"top\">\n";
    if (defined $properties{'DEPEND'}) {
        print "<b>Dependencies: </b></td><td>";
        foreach my $dep (@{ $properties{'DEPEND'} }) {
             print "<b><A href=\"vpm.pl?CurrentQuery=VERIFY&action=verify&name=$dep\">$dep</a><br>\n";
        }
        print "</td>\n";
    }
    print qq(</tr></table></center></body></html>);
}

###########################################################
#
#   GetParameters
#
#   Determines the REQUEST_METHOD and retrieves the
#   QUERY_STRING using the appropriate method.
#
###########################################################
sub GetParameters {
    my $length = $ENV{'CONTENT_LENGTH'};
    my $queryString = ' ' x$length;
    if($ENV{REQUEST_METHOD} =~ /post/i)
    {
        read (STDIN, $queryString, $length);
    }

    elsif($ENV{REQUEST_METHOD} =~ /get/i)
    {
        $queryString = $ENV{'QUERY_STRING'};		
    }

    parse($queryString);
}


###########################################################
#
#   parse
#
#   Parses the parameters of the request URL.
#
###########################################################
sub parse {
    my($queryString) = $_[0];
    my(@pairs) = split /&/, $queryString;
    my($key, $value);
	%parameters=();  # NB, must clear previous hash for every entry
    foreach my $pair (@pairs)
    {
        ($key, $value) = split /=/, $pair;
		$key = unescape($key);
		$value = unescape($value);
        $parameters{$key} = $value;
    }
}

###########################################################
###########################################################
sub unescape {
    my($todecode) = @_;
    $todecode =~ tr/+/ /;       # pluses become spaces
    $todecode =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge;
    return $todecode;
}

###########################################################
###########################################################
sub HelpScreen {
	headerOK();
	print "Help Placeholder Text";
}




###########################################################
#
#   headerOK
#
#   Ouputs a valid HTTP/1.0 header indicating the request
#   was handled without any errors as far as the webserver
#   is concerned.
#
###########################################################
sub headerOK {
    print "HTTP/1.0 200 OK\n";
    print "Content-type: text/html\n\n";
}

###########################################################
###########################################################
sub dumpParms {
    foreach (keys %parameters) {
        print STDERR "$_=$parameters{$_}\n";
    }
    print STDERR "\n";
}

sub format_version {
	my $version;
	my ($ver1, $ver2, $ver3, $ver4) = split(',', $_[0]);

    $version = "$ver1.$ver2";
    if ($ver3 ne '0' || $ver4 ne '0') {
        $version = "$version.$ver3";
        if ($ver4 ne '0') {
            $version = "$version.$ver4";
        }
    }
    return $version;
}

BEGIN {
$::copyForm = <<'HERE';

<script language="Javascript">
    <!--
    
    function copyForm(srcForm, trgForm) {
	if(!(srcForm && trgForm)) {
	    return;
	}
	for(var i = 0; i < srcForm.elements.length; ++i) {
	    theElement = srcForm.elements[i];
	    if(!theElement.type) { // This is an <option> element, ignore it
		continue;
	    } else if(theElement.type == 'select-one' ||
			  theElement.type == 'select-multiple') {
		for(var i = 0; i < theElement.options.length; ++i) {
		    if(theElement.options[i].selected) {
			    trgForm.elements[theElement.name].value = theElement.options[i].value;
		    }
		}
	    } else if(theElement.type == 'radio') {
		if(theElement.checked) {
			trgForm.elements[theElement.name].value = theElement.value;
		}
	    } else {
		trgForm.elements[theElement.name].value = theElement.value;
	    }
	}
    }

    // -->
</script>

HERE
}

package VPM::Handle;
require Tie::Handle;
use vars qw(@ISA);

@ISA = qw( Tie::Handle );

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

sub WRITE {
#this, scalar, length, offset
#Write length bytes of data from scalar starting at offset. 
    my ($self, $buffer, $len, $offset) = @_;
    ${$self->{'buffer'}} .= substr($buffer, $len, $offset);
}

sub PRINT {
#this, LIST
#Print the values in LIST 
    my ($self, @list) = @_;
    ${$self->{'buffer'}} .= join('', @list);
}

sub PRINTF {
#this, format, LIST
#Print the values in LIST using format 
    my ($self, $format, @list) = @_;
    ${$self->{'buffer'}} .= sprintf($format, @list);
}


1;
