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