"Fossies" - the Fresh Open Source Software Archive 
Member "info2html-2.0/infocat" (17 Aug 2006, 5277 Bytes) of package /linux/www/old/info2html-2.0.tar.gz:
As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style:
standard) with prefixed line numbers and
code folding option.
Alternatively you can here
view or
download the uninterpreted source code file.
1 #!/usr/bin/perl
2 #---------------------------------------------------------
3 # infocat
4 #---------------------------------------------------------
5 #
6 # PURPOSE
7 # This perl script prints a catalog of the info files
8 # available via info2html at this site.
9 #
10 # AUTHOR
11 # Jon Howell <jonh@cs.dartmouth.edu>
12 #
13 # HISTORY
14 # 1997.05.16 V 1.0
15 # 1998.05.05 V 1.2 became part of info2html distribution
16 # Jon Howell <jonh@cs.dartmouth.edu>
17 # 2006-08-16 V 2.0 The sorting routines are more complex now,
18 # in an effort to produce more concise output.
19 # Also: CSS added, HTML modernized a bit.
20 # Sean M. Burke <sburke@cpan.org>
21 #-------------------------------------------------------
22
23 # set here the full path of the info2html.conf
24 $VERSION = "2.0";
25 $INFO2HTMLCONF = "./info2html.conf";
26 require 5;
27 require($INFO2HTMLCONF); #-- configuration settings
28 use CGI;
29 $ENV{'REQUEST_METHOD'} or
30 print "Note: I'm really supposed to be run as a CGI!\n";
31
32 #-- patterns
33 $NODEBORDER = '\037\014?'; #-- delimiter of an info node
34 $REDIRSEP = '\177'; #-- delimiter in tag tables
35 $WS = '[ \t]+'; #-- white space +
36 $WSS = '[ \t]*'; #-- white space *
37 $TE = '[\t\,\.\n]'; #-- end of a tag
38 $TAG = '[^\t\,\.\n]+'; #-- pattern for a tag
39 $FTAG = '[^\)]+'; #-- pattern for a file name in
40 #-- a cross reference
41
42 #---------------------------------------------------------
43 # Escape
44 #---------------------------------------------------------
45 # This procedures escapes some special characeters. The
46 # escape sequence follows the WWW guide for escaped
47 # characters in URLs
48 #---------------------------------------------------------
49 sub Escape{
50 local($Tag) = @_;
51 #-- escaping is not needed anymore KG/28.6.94
52 # $Tag =~ s/ /%20/g; # space
53 # $Tag =~ s/\+/%AB/g; # +
54 #-- oh yes it is -- jonh 5/16/97
55 #$Tag;
56 return CGI::escape($Tag);
57 }
58
59 #----------------------------------------------------------
60 # DeEscape
61 #----------------------------------------------------------
62 sub DeEscape{
63 local($Tag) = @_;
64 #-- deescaping is not needed anymore. KG/28.6.94
65 #$Tag =~ s/%AB/+/g;
66 #$Tag =~ s/%20/ /g;
67 #-- yes it is jonh 5/16/97
68 #$Tag;
69 return CGI::unescape($Tag);
70 }
71
72 #
73 #------------------- MAIN -----------------------------
74 #
75 print CGI::header('-type'=>'text/html',
76 '-expires'=>60*60*24);
77 # expires each day, in case I add new .info files
78 # to the @INFODIR path.
79 # -- jonh 1998.05.04
80
81 print "<html><title>Info2HTML Catalog</title>\n";
82 print "$HTML_HEAD_STUFF</head><body class='infocat'>\n";
83
84 my( %Desc2BaseExt, %BaseFreq, %BaseExt2Base );
85
86 foreach $dir (@INFODIR) {
87 opendir(DIR, $dir) or next;
88 while ($baseext = readdir(DIR)) {
89 next if $infofile eq '.' or $infofile eq '..';
90 my $base;
91 if ($baseext =~ m/^(.+)\.info\.bz2$/ ) {
92 $base = $1;
93 next unless open INFOFILE, "bzcat $dir/$baseext|";
94 $collect = 0;
95 }
96 elsif ($baseext =~ m/^(.+)\.info\.gz$/ ) {
97 $base = $1;
98 next unless open INFOFILE, "gzip -dc $dir/$baseext|";
99 $collect = 0;
100 }
101 elsif ($baseext =~ m/^(.+)\.info$/) {
102 $base = $1;
103 next unless open INFOFILE, $dir."/".$baseext;
104 $collect = 0;
105 }
106 else {
107 next;
108 }
109 $filedesc = "";
110 $BaseFreq{$base}++;
111 $BaseExt2Base{$baseext} = $base;
112 while (<INFOFILE>) {
113 last if (m/END-INFO-DIR-ENTRY/);
114 # featurebug: we read only the first dirblock
115
116 s/^\* //;
117 if ($collect and not ($_ =~ m/^[\s\n]*$/)) {
118 $filedesc .= "<br>" if ($collect < 4);
119 $filedesc .= $_;
120 --$collect;
121 $filedesc .= " <b class='elided'>...</b>\n" unless $collect;
122 }
123 $collect=4 if (m/START-INFO-DIR-ENTRY/);
124 # 4 = max number of entries per file that we show
125 }
126 close INFOFILE;
127 $Desc2BaseExt{ $filedesc || $baseext } = $baseext;
128 }
129 closedir(DIR);
130 }
131
132 print "<h2>GNU info on the following topics is available here:</h2>\n";
133 print "<ul>\n";
134
135 # Now output the list, cleverly sorting and linking...
136 foreach my $desc (sort { lc($a) cmp lc($b) } keys %Desc2BaseExt) {
137 my $baseext = $Desc2BaseExt{$desc};
138 my $base = $BaseExt2Base{$baseext};
139 my $thisdesc = $desc;
140 my $fn = $baseext;
141
142 if( $BaseFreq{$base} == 1 ) { # the common case: we get to be terse
143 $fn = $base;
144
145 if( $thisdesc =~ m{^([^ :]+):\s+\(([^ :\(\)]+)\)\.?}s
146 # Like: "crunkapalooza: (crunkapalooza). Crunkulate things!"
147 and lc($2) eq lc($base) and lc($2) eq lc($1)
148 ) {
149 # a common subcase: the first line is pointlessly verbose, so trim:
150 $thisdesc =~ s{^([^ :]+):\s+\(([^ :\(\)]+)\)\.?}{$1: }s;
151 } else {
152 $thisdesc = $base if $thisdesc eq $baseext;
153 }
154 }
155
156 print "<li class='infocatline'><a href=\"info2html?($fn)Top\">",
157 $thisdesc, "</a>\n" ;
158 }
159
160 print "</ul>\n", <<"EOF";
161 \n<div class='generator'>
162 <hr>
163 <em>automatically generated by </em>
164 <a href="$DOC_URL">info2html v$VERSION</a>
165 </div></body></html>
166 EOF
167