3 # $Id: SWDoc.pm,v 1.3 1999/08/19 12:11:09 mdw Exp $
5 # Display documentation 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.3 1999/08/19 12:11:09 mdw
32 # More improvements to URL recognizer.
34 # Revision 1.2 1999/08/18 17:10:07 mdw
35 # Slight improvements to URL and email address parsing.
37 # Revision 1.1 1999/07/30 18:46:37 mdw
38 # New CGI script for browsing installed software and documentation.
41 #----- Package preamble -----------------------------------------------------
48 use SWCGI
qw(:DEFAULT
:layout
);
51 #----- Actions provided -----------------------------------------------------
54 my $file = "$C{doc}/$Q{pkg}";
55 barf
("illegal filename `$file'") if $file =~ m
:\
./:;
56 my $fh = IO
::File
->new($file, O_RDONLY
) or
57 barf
("couldn't open `$file': $!");
58 header
("Local documentation for package $Q{pkg}");
59 print("<h3>Local documentation for package $Q{pkg}</h3>\n");
62 while (my $line = $fh->getline()) {
63 last if $line =~ /\f/;
64 $line =~ s/\&/&/g;
65 $line =~ s/\</<</g;
66 $line =~ s/\>/>>/g;
68 # --- Spot URLs (except `mailto') ---
70 $line =~ s
! \b (http s?
| ftp
| file
| news
) :
71 [^])\s
<>]* [^]<>&).,\s
\']
72 !SWMan
::urlsubst
($&, $&)!egx
;
74 # --- Spot email addresses (including `mailto' URLs) ---
76 $line =~ s
! (?
:\bmailto
:)?
77 ([^\s
()&;:<>&{}.,\
`\'\"] [^\s()&;:<>&{}\`\'\"]*
79 [^\s
()&;:{}<>&\'\"]* [^\s
()&;:{}<>&.,\'\"])
80 !<a href
="mailto:$1">$&</a
>!gx
;
82 # --- Spot info references ---
84 $line =~ s
! \b info
: ([^]&)\s
<>]* [^]&).,\s
<>\'\"])
85 !<a href
="$ref?act=info&file=$1&node=Top">$&</a
>!gx
;
87 # --- Spot manpage references ---
89 $line =~ s
! ([-_
.\w
]+) \
( (\d
+\w
*) \
)
90 !SWMan
::subst
("$1($2)", $1, $2)!egx
;
92 # --- Finally fix up the HTML properly ---
94 $line =~ s/\<\;\</</g;
95 $line =~ s/\>\>\;/>/g;
103 #----- Register actions -----------------------------------------------------
105 $main::ACT
{"doc"} = \
&doc
;
107 #----- That's all, folks ----------------------------------------------------