3 # $Id: SWDoc.pm,v 1.4 2004/04/08 01:52:19 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 #----- Package preamble -----------------------------------------------------
35 use SWCGI
qw(:DEFAULT
:layout
);
38 #----- Actions provided -----------------------------------------------------
41 my $file = "$C{doc}/$Q{pkg}";
42 barf
("illegal filename `$file'") if $file =~ m
:\
./:;
43 my $fh = IO
::File
->new($file, O_RDONLY
) or
44 barf
("couldn't open `$file': $!");
45 header
("Local documentation for package $Q{pkg}");
46 print("<h3>Local documentation for package $Q{pkg}</h3>\n");
49 while (my $line = $fh->getline()) {
50 last if $line =~ /\f/;
51 $line =~ s/\&/&/g;
52 $line =~ s/\</<</g;
53 $line =~ s/\>/>>/g;
55 # --- Spot URLs (except `mailto') ---
57 $line =~ s
! \b (http s?
| ftp
| file
| news
) :
58 [^])\s
<>]* [^]<>&).,\s
\']
59 !SWMan
::urlsubst
($&, $&)!egx
;
61 # --- Spot email addresses (including `mailto' URLs) ---
63 $line =~ s
! (?
:\bmailto
:)?
64 ([^\s
()&;:<>&{}.,\
`\'\"] [^\s()&;:<>&{}\`\'\"]*
66 [^\s
()&;:{}<>&\'\"]* [^\s
()&;:{}<>&.,\'\"])
67 !<a href
="mailto:$1">$&</a
>!gx
;
69 # --- Spot info references ---
71 $line =~ s
! \b info
: ([^]&)\s
<>]* [^]&).,\s
<>\'\"])
72 !<a href
="$ref?act=info&file=$1&node=Top">$&</a
>!gx
;
74 # --- Spot manpage references ---
76 $line =~ s
! ([-_
.\w
]+) \
( (\d
+\w
*) \
)
77 !SWMan
::subst
("$1($2)", $1, $2)!egx
;
79 # --- Finally fix up the HTML properly ---
81 $line =~ s/\<\;\</</g;
82 $line =~ s/\>\>\;/>/g;
90 #----- Register actions -----------------------------------------------------
92 $main::ACT
{"doc"} = \
&doc
;
94 #----- That's all, folks ----------------------------------------------------