3 # $Id: SWDoc.pm,v 1.2 1999/08/18 17:10:07 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.2 1999/08/18 17:10:07 mdw
32 # Slight improvements to URL and email address parsing.
34 # Revision 1.1 1999/07/30 18:46:37 mdw
35 # New CGI script for browsing installed software and documentation.
38 #----- Package preamble -----------------------------------------------------
45 use SWCGI
qw(:DEFAULT
:layout
);
48 #----- Actions provided -----------------------------------------------------
51 my $file = "$C{doc}/$Q{pkg}";
52 barf
("illegal filename `$file'") if $file =~ m
:\
./:;
53 my $fh = IO
::File
->new($file, O_RDONLY
) or
54 barf
("couldn't open `$file': $!");
55 header
("Local documentation for package $Q{pkg}");
56 print("<h3>Local documentation for package $Q{pkg}</h3>\n");
59 while (my $line = $fh->getline()) {
60 last if $line =~ /\f/;
61 $line =~ s/\&/&/g;
64 $line =~ s!\b(https?|ftp|file|news):[^]&)\s]*[^]&).,\s\']!<a href="$&">$&</a>!g;
65 $line =~ s!info:([^]&)\s]*[^]&).,\s\'\"])!<a href="$ref?act=info&file=$1&node=Top">$&</a>!g;
66 $line =~ s!(?:\bmailto:)?([^\s()&;:{}.,\`\"][^\s()&;:{}\`\"]*\@[^\s()&;:{}\'\"]*[^\s()&;:{}.,\'\"])!<a href="mailto:$1">$&</a>!g;
67 $line =~ s!([-_.\w]+)\((\d+\w*)\)!SWMan::subst("$1($2)", $1, $2)!eg;
74 #----- Register actions -----------------------------------------------------
76 $main::ACT
{"doc"} = \
&doc
;
78 #----- That's all, folks ----------------------------------------------------