#!/usr/local/bin/perl # cpan.cgi # Display known perl modules and categories require './cpan-lib.pl'; &ReadParse(); # re-fetch modules list if non-existant or it timeout has expired @st = $packages_file; $now = time(); if (!-r $packages_file || $st[9]+$config{'refresh_days'}*24*60*60 < $now) { &download_packages_file(); } # Read the modules list open(LIST, "gunzip -c $packages_file |"); while() { s/\r|\n//g; if ($_ eq '') { $found_blank++; } elsif ($found_blank && /^(\S+)\s+(\S+)\s+(.*)/) { #next if ($donefile{$3}++); $mod = $1; $ver = $2; next if ($mod eq 'about'); local @mod = split(/::/, $mod); if (@mod > 1) { local @cat = @mod[0 .. $#mod-1]; if (!$donecat{join("::", @cat)}++) { push(@mods, { 'name' => \@cat, 'cat' => 1 } ); } } push(@mods, { 'name' => \@mod, 'full' => $mod, 'ver' => $ver eq 'undef' ? '' : $ver } ); } } close(LIST); # Display the current level of modules $bgcolor = defined($gconfig{'cs_page'}) ? $gconfig{'cs_page'} : "ffffff"; $link = defined($gconfig{'cs_link'}) ? $gconfig{'cs_link'} : "0000ee"; $text = defined($gconfig{'cs_text'}) ? $gconfig{'cs_text'} : "000000"; @sel = split(/\0/, $in{'sel'}); &PrintHeader(); print < $text{'cpan_title'} EOF if ($in{'search'}) { # Search for modules matching some name print "",&text('cpan_match', "$in{'search'}"),"

\n"; print "\n"; foreach $m (@mods) { if (!$m->{'cat'} && $m->{'full'} =~ /$in{'search'}/i) { $name = join("::",@{$m->{'name'}}); print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; $matches++; } } print "
", &html_escape($name),"",&html_escape($m->{'ver'}),"
\n"; print "$text{'cpan_none'}
\n" if (!$matches); } else { # Show module tree if (@sel) { print "",&text('cpan_sel', join("::",@sel)),"

\n"; } else { # Show search form print "

\n"; print "\n"; print "
\n"; } print "\n"; if (@sel) { local @up = @sel[0..$#sel-1]; print "\n"; print "\n"; print "\n"; print "\n"; } MOD: foreach $m (@mods) { for($i=0; $i<@sel; $i++) { next MOD if ($sel[$i] ne $m->{'name'}->[$i]); } next if (scalar(@sel) != scalar(@{$m->{'name'}}-1)); $name = join("::",@{$m->{'name'}}); $pars = join("&",map { "sel=$_" } @{$m->{'name'}}); print "\n"; if ($m->{'cat'}) { print "\n"; print "\n"; } else { print "\n"; print "\n"; print "\n"; } print "\n"; } } print "
..
",&html_escape($name),"",&html_escape($name),"",&html_escape($m->{'ver'}),"
\n"; print "\n";