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