#!/usr/bin/perl 

my $CPAN_LOCAL = '/CPAN/';
my $DEF_FILE   = 'README.html';


$ENV{PATH} = join ":" => qw{
    /usr/local/bin
    /usr/local/scripts
    /usr/ucb
    /etc /usr/etc
    /bin /usr/bin 
    /sbin /usr/sbin 
}; 

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

my (
    @choices,		# potential CPAN sites
    %site,		# map for labels
    $site,		# which they got
    $path,		# what file they want
    $doc_title,		# this document
);

$doc_title = "CPAN Multiplex Dispatcher";

use CGI;
use CGI::Carp;

if (open(LOG, ">>/usr/local/etc/httpd/logs/cpan.log")) {
    CGI::Carp::carpout(\*LOG);
} else { 
   warn "Unable to open /usr/local/etc/httpd/logs/cpan.log: $!\n";
}

my $q = new CGI;

unless ($q->param('site')) { 
    chomp(@choices = `/usr/local/bin/getcpan`);
    die "problem getting cpan info" if $? || !@choices;
    for (@choices) { 
	$site{$_} = (m(//(.*?)/))[0];
    }
    my $rem_host = $q->remote_addr;
    my $am_local = $rem_host eq '127.0.0.1';
    unless ($am_local) {
	require Sys::Hostname;
	my $this_host = Sys::Hostname::hostname();
	my $this_addr = join(".",unpack("C4", scalar gethostbyname($this_host)));
	$am_local = $rem_host eq $this_addr;
    }
    if ( $am_local && -r "$CPAN_LOCAL/$DEF_FILE") {
	unshift @choices, $_ = "file:$CPAN_LOCAL";
	$site{$_} = '<local filesystem>';
    } 
}

if ($q->param || $q->path_info) { 
    ($site = $q->param('site') || $choices[0]) =~ s,([^/])$,$1/,;
    my $file = $q->param('file') || $q->path_info || $DEF_FILE;
    my $link = "$site$file";
    $link =~ s,(\w)//+(\w),$1/$2,g;
    warn "Directing $ENV{REMOTE_HOST} to $site for $file\n";
    print $q->redirect($link);
    exit;
}

$q->use_named_parameters();

print $q->header();
print $q->start_html($doc_title);
print $q->start_form(-METHOD => "GET"); # bug in redirect, per merlyn

print <<START_FORM;

    <CENTER> <H1>$doc_title</H1> </CENTER>

    <P> You may always check
	    <A HREF="ftp://ftp.perl.com/CPAN/CPAN.html">perl.com</a>
        in case this doesn't work.

    <P> Please select your nearest CPAN site: 

START_FORM

print $q->popup_menu(
	      -NAME => 'site',
	   -DEFAULT => $choices[0],
	   -VALUES => [ @choices ],
	    -LABELS => \%site,
);

($path = $q->path_info || $DEF_FILE) =~ s/^\///;
print "<P>Pick a file: ";

print $q->textfield(
	-NAME => "file", 
	-SIZE => 50,
     -DEFAULT => $path
);

print $q->submit("Fetch File");
print $q->endform();

print <<EOTRAILER;

<HR>

    <h2>Source Code</h2>
    You can get <b>full source code</b> for 
    <UL>
    <LI><A HREF="/perl/misc/CPAN.cgi">this CGI program</a>
    <LI><A HREF="/perl/misc/getcpan">the CPAN site selector</a>
    <LI><A HREF="/perl/misc/cpan_module">the "latest module" selector</a>
    </UL>

<HR>

<P> <CENTER> Return to the <A HREF="/perl/index.html">
<IMG SRC="/gifs/lcb.xbm"> Perl Home Page</a>.
</CENTER>

EOTRAILER

print $q->end_html();