#!/usr/local/bin/perl
# download.cgi
# Get a perl module from somewhere

require './cpan-lib.pl';

if ($ENV{REQUEST_METHOD} eq "POST") { &ReadParseMime(); }
else { &ReadParse(); $no_upload = 1; }
&error_setup($text{'download_err'});

$| = 1;
$theme_no_table = 1 if ($in{'source'} >= 2);
&header($text{'download_title'}, "");
print "<hr>\n";

&tempname();
if ($in{'source'} == 0) {
	# installing from local file (or maybe directory)
	if (!$in{'local'})
		{ &install_error($text{'download_elocal'}); }
	if (!-r $in{'local'})
		{ &install_error(&text('download_elocal2', $in{'local'})); }
	$source = $in{'local'};
	$pfile = $in{'local'};
	$need_unlink = 0;
	}
elsif ($in{'source'} == 1) {
	# installing from upload .. store file in temp location
	if ($no_upload) {
		&install_error($text{'download_eupload'});
		}
	$in{'upload_filename'} =~ /([^\/]+$)/;
	$pfile = &tempname("$1");
	open(PFILE, "> $pfile");
	print PFILE $in{'upload'};
	close(PFILE);
	$source = $in{'upload_filename'};
	$need_unlink = 1;
	}
elsif ($in{'source'} == 2) {
	# installing from URL.. store downloaded file in temp location
	$in{'url'} =~ /\/([^\/]+)\/*$/;
	$pfile = &tempname("$1");
	$progress_callback_url = $in{'url'};
	if ($in{'url'} =~ /^http:\/\/([^\/]+)(\/.*)$/) {
		# Make a HTTP request
		$host = $1; $page = $2; $port = 80;
		if ($host =~ /^(.*):(\d+)$/) { $host = $1; $port = $2; }
		&http_download($host, $port, $page, $pfile, \$error,
			       \&progress_callback);
		}
	elsif ($in{'url'} =~ /^ftp:\/\/([^\/]+)(:21)?(\/.*)$/) {
		$host = $1; $file = $3;
		&ftp_download($host, $file, $pfile, \$error,
			      \&progress_callback);
		}
	else { &install_error(&text('download_eurl', $in{'url'})); }
	&install_error($error) if ($error);
	$source = $in{'url'};
	$need_unlink = 1;
	}
elsif ($in{'source'} == 3) {
	# installing from CPAN.. find the module, and then install it
	$in{'cpan'} || &error($text{'download_emodname'});
	$progress_callback_url = $config{'packages'};
	if (!-r $packages_file || $in{'refresh'}) {
		# Need to download the modules list from CPAN first
		&download_packages_file(\&progress_callback);
		print "<p>\n";
		}

	# Find the module in the modules list
	open(LIST, "gunzip -c $packages_file |");
	while(<LIST>) {
		s/\r|\n//g;
		if ($_ eq '') { $found_blank++; }
		elsif ($found_blank && /^(\S+)\s+(\S+)\s+(.*)/) {
			if ($1 eq $in{'cpan'}) {
				$source = "$config{'cpan'}/$3";
				last;
				}
			}
		}
	close(LIST);
	$source ||
		&install_error(&text('download_ecpan', "<tt>$in{'cpan'}</tt>"));
	$source =~ /\/perl-[0-9\.]+\.tar\.gz$/ &&
	    &install_error(&text('download_eisperl', "<tt>$in{'cpan'}</tt>"));

	# Download the actual module
	$source =~ /\/([^\/]+)\/*$/;
	$pfile = &tempname("$1");
	$progress_callback_url = $source;
	if ($source =~ /^http:\/\/([^\/]+)(\/.*)$/) {
		# Make a HTTP request
		$host = $1; $page = $2; $port = 80;
		if ($host =~ /^(.*):(\d+)$/) { $host = $1; $port = $2; }
		&http_download($host, $port, $page, $pfile, \$error,
			       \&progress_callback);
		}
	elsif ($source =~ /^ftp:\/\/([^\/]+)(:21)?(\/.*)$/) {
		$host = $1; $file = $3;
		&ftp_download($host, $file, $pfile, \$error,
			      \&progress_callback);
		}
	else { &install_error(&text('download_eurl', $in{'url'})); }
	&install_error($error) if ($error);
	$need_unlink = 1;
	}

# Check if the file looks like a perl module
open(TAR, "( gunzip -c $pfile | tar tf - ) 2>&1 |");
while($line = <TAR>) {
	if ($line =~ /^\.\/([^\/]+)\/(.*)$/ || $line =~ /^([^\/]+)\/(.*)$/) {
		$mods{$1}++;
		$file{$2}++;
		}
	$tar .= $line;
	}
close(TAR);
if ($?) {
	unlink($pfile) if ($need_unlink);
	&install_error(&text('download_etar', "<tt>$tar</tt>"));
	}
@mods = keys %mods;
if (@mods != 1 || !$file{'Makefile.PL'}) {
	unlink($pfile) if ($need_unlink);
	&install_error($text{'download_emod'});
	}
if ($mods[0] =~ /^(\S+)\-([0-9\.]+)$/) {
	$mod = $1; $ver = $2;
	}
else {
	$mod = $mods[0];
	}
$mod =~ s/-/::/g;

# Display install options
print "<p><form action=install.cgi>\n";
print "<input type=hidden name=source value='$source'>\n";
print "<input type=hidden name=need_unlink value='$need_unlink'>\n";
print "<input type=hidden name=pfile value='$pfile'>\n";
print "<input type=hidden name=mod value='$mod'>\n";
print "<input type=hidden name=ver value='$ver'>\n";
print "<input type=hidden name=dir value='$mods[0]'>\n";
print "<table border>\n";
print "<tr $tb> <td><b>$text{'download_header'}</b></td> </tr>\n";
print "<tr $cb> <td><table>\n";

print "<tr> <td><b>$text{'download_mod'}</b></td> <td>",
	&html_escape($mod),"</td> </tr>\n";
print "<tr> <td><b>$text{'download_ver'}</b></td> <td>",
	&html_escape($ver),"</td> </tr>\n";
print "<tr> <td><b>$text{'download_src'}</b></td> <td>",
	&html_escape($source),"</td> </tr>\n";
print "<tr> <td><b>$text{'download_act'}</b></td> <td><select name=act>\n";
$in{'mode'} = 3 if ($in{'mode'} eq '');
printf "<option value=0 %s> $text{'download_m'}\n",
	$in{'mode'} == 0 ? "selected" : "";
printf "<option value=1 %s> $text{'download_mt'}\n",
	$in{'mode'} == 1 ? "selected" : "";
printf "<option value=2 %s> $text{'download_mi'}\n",
	$in{'mode'} == 2 ? "selected" : "";
printf "<option value=3 %s> $text{'download_mti'}\n",
	$in{'mode'} == 3 ? "selected" : "";
print "</select></td> </tr>\n";

print "<tr> <td><b>$text{'download_args'}</b></td>\n";
print "<td><input name=args size=40></td> </tr>\n";

print "<tr> <td valign=top><b>$text{'download_envs'}</b></td>\n";
print "<td><table border> <tr $tb> <td><b>$text{'download_name'}</b></td> ",
      "<td><b>$text{'download_value'}</b></td> </tr>\n";
for($i=0; $i<4; $i++) {
	print "<tr $cb>\n";
	print "<td><input name=name_$i size=15></td>\n";
	print "<td><input name=value_$i size=25></td>\n";
	}
print "</table></td> </tr>\n";

print "</table></td></tr></table>\n";
print "<input type=submit value='$text{'download_cont'}'></form>\n";

print "<hr>\n";
&footer("", $text{'index_return'});

sub install_error
{
print "<br><b>$whatfailed : $_[0]</b> <p>\n";
print "<hr>\n";
&footer("", $text{'index_return'});
exit;
}

