3 # $Id: SWInfo.pm,v 1.4 1999/08/24 12:15:33 mdw Exp $
5 # Read and output GNU Info files
10 #----- Licensing notice -----------------------------------------------------
12 # This file is part of sw-tools.
14 # sw-tools is free software; you can redistribute it and/or modify
15 # it under the terms of the GNU General Public License as published by
16 # the Free Software Foundation; either version 2 of the License, or
17 # (at your option) any later version.
19 # sw-tools is distributed in the hope that it will be useful,
20 # but WITHOUT ANY WARRANTY; without even the implied warranty of
21 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 # GNU General Public License for more details.
24 # You should have received a copy of the GNU General Public License
25 # along with sw-tools; if not, write to the Free Software Foundation,
26 # Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
28 #----- Revision history -----------------------------------------------------
31 # Revision 1.4 1999/08/24 12:15:33 mdw
32 # Properly sanitize CGI arguments (like `gtk+').
34 # Revision 1.3 1999/08/19 12:11:10 mdw
35 # More improvements to URL recognizer.
37 # Revision 1.2 1999/08/18 17:10:07 mdw
38 # Slight improvements to URL and email address parsing.
40 # Revision 1.1 1999/07/30 18:46:37 mdw
41 # New CGI script for browsing installed software and documentation.
44 #----- Package preamble -----------------------------------------------------
51 use SWCGI
qw(:DEFAULT
:layout
);
55 #----- Useful functions -----------------------------------------------------
57 # --- @subst(IREF, FILE, INFO)@ ---
59 # Given an Info reference and the name of the current Info file, returns an
60 # HTML anchor which represents the link.
63 my ($iref, $file, $i) = @_;
68 # --- Dig out the node and file being referred to ---
76 if ($iref =~ /^.+: *(.+)$/) { $iref = $1; }
77 if ($iref =~ /(?:\(([^\)]*)\))?(.*)$/) {
84 # --- Transform it into something that won't get mangled ---
86 $node = SWCGI::sanitize($node);
88 ($dir = $i->{dir}) =~ s:$C{prefix}/info/?::;
89 $dir = "&dir=" . SWCGI::sanitize($dir) if $dir;
91 return "<a href=\"$ref?act=info&file=$file&node=$node$dir\">$oref</a>$tail";
94 #----- Actions --------------------------------------------------------------
97 my $file = $Q{file} || "dir";
98 my $node = $Q{node} || "Top";
99 my $dir = $Q{dir} || "";
102 # --- Read the node in ---
104 Info::setpath("$C{prefix}/info");
106 "$dir/$file" =~ m:\./: and
107 barf("bad filename `$dir/$file'");
108 my $i = (($dir && Info->new("$dir/$file")) ||
110 or barf("couldn't find info file
`$file'");
111 my $n = $i->node($node) or
112 barf("info file `$file' doesn't contain node
`$node'");
114 # --- Now translate the node into HTML, first line first ---
119 $n =~ s/\A( [^\n]* Next:\ *) ([^,\n]*) / $1 . subst($2, $file, $i) /eix;
120 $n =~ s/\A( [^\n]* Prev:\ *) ([^,\n]*) / $1 . subst($2, $file, $i) /eix;
121 $n =~ s/\A( [^\n]* Up:\ *) ([^,\n]*) / $1 . subst($2, $file, $i) /eix;
123 # --- Grind through picking up any notes ---
128 if ($n =~ /(\*Note\s*)([^:]*: *(?:\([^\)]*\))?[^.,;:]*)([.,;:])/i) {
129 $out .= $` . $1 . subst
($2, $file, $i) . $3;
136 # --- If there's a menu then process that
---
138 if ($n =~ /\n\* *Menu:/s) {
142 if ($n =~ /(\n\* *)([^:]*: *(?:\([^\)]*\))?[^.,;:]*)([.,;:])/) {
143 $out .= $` . $1 . subst
($2, $file, $i) . $3;
152 # --- Spot URLs (except `mailto') ---
154 $out =~ s
! \b (http s?
| ftp
| file
| news
) :
155 [^]<>)\s
]* [^]<>).,\s
\']
156 !urlsubst
($&, $&)!egx
;
158 # --- Spot email addresses (including `mailto' URLs) ---
160 $out =~ s
! (?
:\bmailto
:)?
161 ([^\s
()<>&;:{}.,\
`\'\"] [^\s()<>&;:{}\`\'\"]*
163 [^\s
()<>&;:{}\'\"]* [^\s
()<>&;:{}.,\'\"])
164 !<a href
="mailto:$1">$&</a
>!gx
;
166 # --- Spot manpage references ---
168 $out =~ s
! ([-_
.\w
]+) \
( (\d
+\w
*) \
)
169 !SWMan
::subst
("$1($2)", $1, $2)!egx
;
171 # --- Fix up the HTML ---
173 $out =~ s/\<\</</g;
174 $out =~ s/\>\>/>/g;
176 header
("Info: ($file)$node");
177 print("<pre>\n$out</pre>\n");
181 #----- Actions provided -----------------------------------------------------
183 $main::ACT
{"info"} = \
&info
;
185 #----- That's all, folks ----------------------------------------------------