aboutsummaryrefslogtreecommitdiff
path: root/infocat
blob: fa1934556272a234aba4165415709ea49d2231f6 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
#!/usr/bin/perl
#---------------------------------------------------------
#                      infocat
#---------------------------------------------------------
#
# PURPOSE
#  This perl script prints a catalog of the info files
#  available via info2html at this site.
#
# AUTHORS 
#         2015.12.25    +A.M.Danischewski <adam_ lastname@not gamil.com>
#         2006.08.16    Sean M. Burke <sburke@cpan.org>
# 
# ORIGINAL AUTHOR
#         1997.05.16    Jon Howell <jonh@cs.dartmouth.edu>
# 
# HISTORY
#    1997.05.16  V 1.0 
#    1998.05.05  V 1.2  became part of info2html distribution
#                       Jon Howell <jonh@cs.dartmouth.edu>
#    2006-08-16  V 2.0  The sorting routines are more complex now,
#                       in an effort to produce more concise output.
#                       Also: CSS added, HTML modernized a bit.
#                       Sean M. Burke <sburke@cpan.org>
#    2015-12-25  V 2.1  Hacked into a quasi PHP-CGI, removed  
#                       the manual configuration of the conf file, 
#                       presumes the conf file is in the same dir, 
#                       removed the CGI header and warnings. 
#                       +A.M.Danischewski <adam_ lastname@not gamil.com> 
#                        
#------------------------------------------------------- 

$VERSION = "2.1";
use File::Basename;
$CURRENT_PATH=dirname(__FILE__); 
 ## If you really want your config file in a custom location, 
 ## (e.g. ~/.config) then change this next variable accordingly. 
$INFO2HTMLCONF = $CURRENT_PATH."/info2html.conf"; 
require 5;
require($INFO2HTMLCONF);  #-- configuration settings
use CGI;

#-- patterns
$NODEBORDER    = '\037\014?';      #-- delimiter of an info node
$REDIRSEP      = '\177';           #-- delimiter in tag tables
$WS            = '[ \t]+';         #-- white space +
$WSS           = '[ \t]*';         #-- white space *
$TE            = '[\t\,\.\n]';     #-- end of a tag
$TAG           = '[^\t\,\.\n]+';   #-- pattern for a tag
$FTAG          = '[^\)]+';         #-- pattern for a file name in
                                   #-- a cross reference

#---------------------------------------------------------
#                      Escape
#---------------------------------------------------------
#  This procedures escapes some special characeters. The
#  escape sequence follows the WWW guide for escaped
#  characters in URLs
#---------------------------------------------------------
sub Escape{
  local($Tag) = @_; 
  #-- escaping is not needed anymore  KG/28.6.94
  #  $Tag =~ s/ /%20/g;     #  space
  #  $Tag =~ s/\+/%AB/g;    #  +
  #-- oh yes it is -- jonh 5/16/97
  #$Tag;
  return CGI::escape($Tag);
}

#----------------------------------------------------------
#                    DeEscape
#----------------------------------------------------------
sub DeEscape{
  local($Tag) = @_;
  #-- deescaping is not needed anymore. KG/28.6.94
  #$Tag =~ s/%AB/+/g;
  #$Tag =~ s/%20/ /g;
  #-- yes it is jonh 5/16/97
  #$Tag;
  return CGI::unescape($Tag);
}

# 
#-------------------  MAIN -----------------------------
# 
 ### No more need for CGI headers, we are using PHP 
 ###   V 2.1 Change +A.M.Danischewski 20151225
#print CGI::header('-type'=>'text/html',
					#'-expires'=>60*60*24);
						## expires each day, in case I add new .info files
						## to the @INFODIR path.
						# -- jonh 1998.05.04

print "<html><title>Info2HTML Catalog</title>\n";
print "$HTML_HEAD_STUFF</head><body class='infocat'>\n";

my( %Desc2BaseExt, %BaseFreq, %BaseExt2Base );

foreach $dir (@INFODIR) {
    opendir(DIR, $dir) or next;
    while ($baseext = readdir(DIR)) {
        next if $infofile eq '.' or $infofile eq '..';
        my $base;
        if ($baseext =~ m/^(.+)\.info\.bz2$/ ) {
	    $base = $1;
            next unless open INFOFILE, "bzcat $dir/$baseext|";
            $collect = 0;
        }
        elsif ($baseext =~ m/^(.+)\.info\.gz$/ ) {
	    $base = $1;
            next unless open INFOFILE, "gzip -dc $dir/$baseext|";
            $collect = 0;
        }
        elsif ($baseext =~ m/^(.+)\.info$/) {
	    $base = $1;
            next unless open INFOFILE, $dir."/".$baseext;
            $collect = 0;
        }
        else {
            next;
        }
	$filedesc = "";
	$BaseFreq{$base}++;
	$BaseExt2Base{$baseext} = $base;
	while (<INFOFILE>) {
            last if (m/END-INFO-DIR-ENTRY/);
	     # featurebug: we read only the first dirblock

	    s/^\* //;
	    if ($collect and not ($_ =~ m/^[\s\n]*$/)) {
		$filedesc .= "<br>" if ($collect < 4);
            	$filedesc .= $_;
		--$collect;
		$filedesc .= " <b class='elided'>...</b>\n" unless $collect;
	    }
            $collect=4 if (m/START-INFO-DIR-ENTRY/);
	     # 4 = max number of entries per file that we show
	}
	close INFOFILE;
	$Desc2BaseExt{ $filedesc || $baseext } = $baseext;
    }
    closedir(DIR);
}

print "<h2>GNU info on the following topics is available here:</h2>\n";
print "<ul>\n";

# Now output the list, cleverly sorting and linking...
foreach my $desc (sort { lc($a) cmp lc($b) } keys %Desc2BaseExt) {
  my $baseext  = $Desc2BaseExt{$desc};
  my $base     = $BaseExt2Base{$baseext};
  my $thisdesc = $desc;
  my $fn       = $baseext;

  if( $BaseFreq{$base} == 1 ) { # the common case: we get to be terse
    $fn = $base;

    if( $thisdesc =~ m{^([^ :]+):\s+\(([^ :\(\)]+)\)\.?}s
             # Like: "crunkapalooza: (crunkapalooza). Crunkulate things!"
	and lc($2) eq lc($base) and lc($2) eq lc($1)
    ) {
      # a common subcase: the first line is pointlessly verbose, so trim:
      $thisdesc   =~ s{^([^ :]+):\s+\(([^ :\(\)]+)\)\.?}{$1: }s;
    } else {
      $thisdesc = $base if $thisdesc eq $baseext;
    }
  }
  
  print "<li class='infocatline'><a href=\"info2html?($fn)Top\">",
    $thisdesc, "</a>\n" ;
}

print "</ul>\n", <<"EOF";
\n<div class='generator'>
<hr>
<em>automatically generated by </em> 
<a href="$DOC_URL">info2html v$VERSION</a>
</div></body></html>
EOF