cpan/cpan.cgi

   1 #!/usr/local/bin/perl
   2 # cpan.cgi
   3 # Display known perl modules and categories
   4
   5 $trust_unknown_referers = 1;
   6 require './cpan-lib.pl';
   7 &ReadParse();
   8
   9 # re-fetch modules list if non-existant or it timeout has expired
  10 @st = $packages_file;
  11 $now = time();
  12 if (!-r $packages_file ||
  13     $st[9]+$config{'refresh_days'}*24*60*60 < $now) {
  14         &download_packages_file();
  15         }
  16
  17 # Read the modules list
  18 open(LIST, "gunzip -c $packages_file |");
  19 while(<LIST>) {
  20         s/\r|\n//g;
  21         if ($_ eq '') { $found_blank++; }
  22         elsif ($found_blank && /^(\S+)\s+(\S+)\s+(.*)/) {
  23                 #next if ($donefile{$3}++);
  24                 $mod = $1; $ver = $2;
  25                 next if ($mod eq 'about');
  26                 local @mod = split(/::/, $mod);
  27                 if (@mod > 1) {
  28                         local @cat = @mod[0 .. $#mod-1];
  29                         if (!$donecat{join("::", @cat)}++) {
  30                                 push(@mods, { 'name' => \@cat,
  31                                               'cat' => 1 } );
  32                                 }
  33                         }
  34                 push(@mods, { 'name' => \@mod,
  35                               'full' => $mod,
  36                               'ver' => $ver eq 'undef' ? '' : $ver } );
  37                 }
  38         }
  39 close(LIST);
  40
  41 # Show page header and selection javascript
  42 @sel = grep { /^[a-z0-9\-\_\:\.]+$/i } split(/\0/, $in{'sel'});
  43 &popup_header($text{'cpan_title'});
  44
  45 print <<EOF;
  46 <script>
  47 function sel(m)
  48 {
  49 window.opener.ifield.value = m;
  50 window.close();
  51 return false;
  52 }
  53 </script>
  54 </head><body bgcolor=#$bgcolor link=#$link vlink=#$link text=#$text>
  55 EOF
  56
  57 if ($in{'search'}) {
  58         # Search for modules matching some name
  59         print "<b>",&text('cpan_match',
  60                 "<tt>".&html_escape($in{'search'})."</tt>"),"</b><p>\n";
  61         print &ui_columns_start(undef, 100, 1);
  62         foreach $m (@mods) {
  63                 if (!$m->{'cat'} && $m->{'full'} =~ /\Q$in{'search'}\E/i) {
  64                         $name = join("::",@{$m->{'name'}});
  65                         print &ui_columns_row([
  66                                 "<a href='' onClick='sel(\"$name\")'>".
  67                                   "<img src=images/mod.gif border=0></a>",
  68                                 "<a href='' onClick='sel(\"$name\")'>".
  69                                   &html_escape($name)."</a>",
  70                                 &html_escape($m->{'ver'}),
  71                                 ]);
  72                         $matches++;
  73                         }
  74                 }
  75         print &ui_columns_end();
  76         print "$text{'cpan_none'}<br>\n" if (!$matches);
  77         }
  78 else {
  79         # Show module tree
  80         if (@sel) {
  81                 print "<b>",&text('cpan_sel', join("::",@sel)),"</b><p>\n";
  82                 }
  83         else {
  84                 # Show search form
  85                 print &ui_form_start("cpan.cgi");
  86                 print &ui_submit($text{'cpan_search'});
  87                 print &ui_textbox("search", undef, 20),&ui_form_end();
  88                 }
  89         print &ui_columns_start(undef, 100, 1);
  90         if (@sel) {
  91                 # Link to up one level
  92                 local @up = @sel[0..$#sel-1];
  93                 print &ui_columns_row([
  94                         "<a href='cpan.cgi?".
  95                           join("&",map { "sel=$_" } @up),"#",join("::",@sel).
  96                           "'><img src=images/cat.gif border=0></a>",
  97                         "<a href='cpan.cgi?".
  98                           join("&",map { "sel=$_" } @up)."#".
  99                           join("::",@sel)."'>..</a>",
 100                         ""
 101                         ]);
 102                 }
 103         MOD: foreach $m (@mods) {
 104                 for($i=0; $i<@sel; $i++) {
 105                         next MOD if ($sel[$i] ne $m->{'name'}->[$i]);
 106                         }
 107                 next if (scalar(@sel) != scalar(@{$m->{'name'}}-1));
 108                 $name = join("::",@{$m->{'name'}});
 109                 $pars = join("&",map { "sel=$_" } @{$m->{'name'}});
 110                 print "<tr>\n";
 111                 if ($m->{'cat'}) {
 112                         # A category which can be opened
 113                         print &ui_columns_row([
 114                                 "<a name=$name><a href='cpan.cgi?$pars'>".
 115                                   "<img src=images/cat.gif border=0></a>",
 116                                 "<a href='cpan.cgi?$pars'>".
 117                                   &html_escape($name)."</a>",
 118                                 ""
 119                                 ]);
 120                         }
 121                 else {
 122                         # A module
 123                         print &ui_columns_row([
 124                                 "<a href='' onClick='sel(\"$name\")'>".
 125                                   "<img src=images/mod.gif border=0></a>",
 126                                 "<a href='' onClick='sel(\"$name\")'>".
 127                                   &html_escape($name)."</a>",
 128                                 &html_escape($m->{'ver'}),
 129                                 ], [ undef, undef, "align=right" ]);
 130                         }
 131                 }
 132         print &ui_columns_end();
 133         }
 134 &popup_footer();
 135