X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/sw-tools/blobdiff_plain/961ce1c2fa0e71e5ffc0c16a1d4fa58802a36a1c..refs/heads/master:/perl/SWDoc.pm
diff --git a/perl/SWDoc.pm b/perl/SWDoc.pm
index d87da58..8278552 100644
--- a/perl/SWDoc.pm
+++ b/perl/SWDoc.pm
@@ -1,6 +1,6 @@
# -*-perl-*-
#
-# $Id: SWDoc.pm,v 1.1 1999/07/30 18:46:37 mdw Exp $
+# $Id: SWDoc.pm,v 1.4 2004/04/08 01:52:19 mdw Exp $
#
# Display documentation files
#
@@ -25,13 +25,6 @@
# along with sw-tools; if not, write to the Free Software Foundation,
# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-#----- Revision history -----------------------------------------------------
-#
-# $Log: SWDoc.pm,v $
-# Revision 1.1 1999/07/30 18:46:37 mdw
-# New CGI script for browsing installed software and documentation.
-#
-
#----- Package preamble -----------------------------------------------------
package SWDoc;
@@ -56,12 +49,38 @@ sub doc {
while (my $line = $fh->getline()) {
last if $line =~ //;
$line =~ s/\&/&/g;
- $line =~ s/\</g;
- $line =~ s/\>/>/g;
- $line =~ s!(http|ftp)://[^]&)\s]*[^]&).,\s\']!$&!g;
- $line =~ s!info:([^]&)\s]*[^]&).,\s\'\"])!$&!g;
- $line =~ s![^\s()&;{}.,\`\"][^\s()&;{}\`\"]*\@[^\s()&;{}\'\"]*[^\s()&;{}.,\'\"]!$&!g;
- $line =~ s!([-_.\w]+)\((\d+\w*)\)!SWMan::subst("$1($2)", $1, $2)!eg;
+ $line =~ s/\</>>/g;
+
+ # --- Spot URLs (except `mailto') ---
+
+ $line =~ s! \b (http s? | ftp | file | news) :
+ [^])\s<>]* [^]<>&).,\s\']
+ !SWMan::urlsubst($&, $&)!egx;
+
+ # --- Spot email addresses (including `mailto' URLs) ---
+
+ $line =~ s! (?:\bmailto:)?
+ ([^\s()&;:<>&{}.,\`\'\"] [^\s()&;:<>&{}\`\'\"]*
+ \@
+ [^\s()&;:{}<>&\'\"]* [^\s()&;:{}<>&.,\'\"])
+ !$&!gx;
+
+ # --- Spot info references ---
+
+ $line =~ s! \b info: ([^]&)\s<>]* [^]&).,\s<>\'\"])
+ !$&!gx;
+
+ # --- Spot manpage references ---
+
+ $line =~ s! ([-_.\w]+) \( (\d+\w*) \)
+ !SWMan::subst("$1($2)", $1, $2)!egx;
+
+ # --- Finally fix up the HTML properly ---
+
+ $line =~ s/\<\;\</g;
+ $line =~ s/\>\>\;/>/g;
+
print $line;
}
print "\n";