summaryrefslogtreecommitdiff
path: root/lib/Pod/Html.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Pod/Html.pm')
-rw-r--r--lib/Pod/Html.pm118
1 files changed, 67 insertions, 51 deletions
diff --git a/lib/Pod/Html.pm b/lib/Pod/Html.pm
index 8ff3e8964b..dafa27d781 100644
--- a/lib/Pod/Html.pm
+++ b/lib/Pod/Html.pm
@@ -3,6 +3,8 @@ package Pod::Html;
use Pod::Functions;
use Getopt::Long; # package for handling command-line parameters
require Exporter;
+use vars qw($VERSION);
+$VERSION = 1.01;
@ISA = Exporter;
@EXPORT = qw(pod2html htmlify);
use Cwd;
@@ -11,13 +13,15 @@ use Carp;
use strict;
+use Config;
+
=head1 NAME
-Pod::HTML - module to convert pod files to HTML
+Pod::Html - module to convert pod files to HTML
=head1 SYNOPSIS
- use Pod::HTML;
+ use Pod::Html;
pod2html([options]);
=head1 DESCRIPTION
@@ -302,7 +306,7 @@ sub pod2html {
for (my $i = 0; $i < @poddata; $i++) {
if ($poddata[$i] =~ /^=head1\s*NAME\b/m) {
for my $para ( @poddata[$i, $i+1] ) {
- last TITLE_SEARCH if ($title) = $para =~ /(\S+\s+-+\s*.*)/s;
+ last TITLE_SEARCH if ($title) = $para =~ /(\S+\s+-+.*\S)/s;
}
}
@@ -316,19 +320,22 @@ sub pod2html {
warn "adopted '$title' as title for $podfile\n"
if $verbose and $title;
}
- unless ($title) {
+ if ($title) {
+ $title =~ s/\s*\(.*\)//;
+ } else {
warn "$0: no title for $podfile";
$podfile =~ /^(.*)(\.[^.\/]+)?$/;
$title = ($podfile eq "-" ? 'No Title' : $1);
warn "using $title" if $verbose;
}
print HTML <<END_OF_HEAD;
- <HTML>
- <HEAD>
- <TITLE>$title</TITLE>
- </HEAD>
+<HTML>
+<HEAD>
+<TITLE>$title</TITLE>
+<LINK REV="made" HREF="mailto:$Config{perladmin}">
+</HEAD>
- <BODY>
+<BODY>
END_OF_HEAD
@@ -368,9 +375,9 @@ END_OF_HEAD
} else {
next if @begin_stack && $begin_stack[-1] ne 'html';
- if (/^=(head[1-6])\s+(.*)/s) { # =head[1-6] heading
+ if (/^=(head[1-6])\s+(.*\S)/s) { # =head[1-6] heading
process_head($1, $2);
- } elsif (/^=item\s*(.*)/sm) { # =item text
+ } elsif (/^=item\s*(.*\S)/sm) { # =item text
process_item($1);
} elsif (/^=over\s*(.*)/) { # =over N
process_over();
@@ -391,16 +398,16 @@ END_OF_HEAD
next if @begin_stack && $begin_stack[-1] ne 'html';
my $text = $_;
process_text(\$text, 1);
- print HTML "$text\n<P>\n\n";
+ print HTML "<P>\n$text";
}
}
# finish off any pending directives
finish_list();
print HTML <<END_OF_TAIL;
- </BODY>
+</BODY>
- </HTML>
+</HTML>
END_OF_TAIL
# close the html file
@@ -782,7 +789,7 @@ sub scan_headings {
$index .= "\n" . ("\t" x $listdepth) . "<LI>" .
"<A HREF=\"#" . htmlify(0,$title) . "\">" .
- process_text(\$title, 0) . "</A>";
+ html_escape(process_text(\$title, 0)) . "</A>";
}
}
@@ -823,8 +830,8 @@ sub scan_items {
if ($1 eq "*") { # bullet list
/\A=item\s+\*\s*(.*?)\s*\Z/s;
$item = $1;
- } elsif ($1 =~ /^[0-9]+/) { # numbered list
- /\A=item\s+[0-9]+\.?(.*?)\s*\Z/s;
+ } elsif ($1 =~ /^\d+/) { # numbered list
+ /\A=item\s+\d+\.?(.*?)\s*\Z/s;
$item = $1;
} else {
# /\A=item\s+(.*?)\s*\Z/s;
@@ -856,6 +863,7 @@ sub process_head {
print HTML "<H$level>"; # unless $listlevel;
#print HTML "<H$level>" unless $listlevel;
my $convert = $heading; process_text(\$convert, 0);
+ $convert = html_escape($convert);
print HTML '<A NAME="' . htmlify(0,$heading) . "\">$convert</A>";
print HTML "</H$level>"; # unless $listlevel;
print HTML "\n";
@@ -898,30 +906,36 @@ sub process_item {
print HTML "<UL>\n";
}
- print HTML "<LI><STRONG>";
- $text =~ /\A\*\s*(.*)\Z/s;
- print HTML "<A NAME=\"item_" . htmlify(1,$1) . "\">" if $1 && !$items_named{$1}++;
- $quote = 1;
- #print HTML process_puretext($1, \$quote);
- print HTML $1;
- print HTML "</A>" if $1;
- print HTML "</STRONG>";
+ print HTML '<LI>';
+ if ($text =~ /\A\*\s*(.+)\Z/s) {
+ print HTML '<STRONG>';
+ if ($items_named{$1}++) {
+ print HTML html_escape($1);
+ } else {
+ my $name = 'item_' . htmlify(1,$1);
+ print HTML qq(<A NAME="$name">), html_escape($1), '</A>';
+ }
+ print HTML '</STRONG>';
+ }
- } elsif ($text =~ /\A[0-9#]+/) { # numbered list
+ } elsif ($text =~ /\A[\d#]+/) { # numbered list
if ($need_preamble) {
push(@listend, "</OL>");
print HTML "<OL>\n";
}
- print HTML "<LI><STRONG>";
- $text =~ /\A[0-9]+\.?(.*)\Z/s;
- print HTML "<A NAME=\"item_" . htmlify(0,$1) . "\">" if $1;
- $quote = 1;
- #print HTML process_puretext($1, \$quote);
- print HTML $1 if $1;
- print HTML "</A>" if $1;
- print HTML "</STRONG>";
+ print HTML '<LI>';
+ if ($text =~ /\A\d+\.?\s*(.+)\Z/s) {
+ print HTML '<STRONG>';
+ if ($items_named{$1}++) {
+ print HTML html_escape($1);
+ } else {
+ my $name = 'item_' . htmlify(0,$1);
+ print HTML qq(<A NAME="$name">), html_escape($1), '</A>';
+ }
+ print HTML '</STRONG>';
+ }
} else { # all others
@@ -930,18 +944,17 @@ sub process_item {
print HTML "<DL>\n";
}
- print HTML "<DT><STRONG>";
- print HTML "<A NAME=\"item_" . htmlify(1,$text) . "\">"
- if $text && !$items_named{($text =~ /(\S+)/)[0]}++;
- # preceding craziness so that the duplicate leading bits in
- # perlfunc work to find just the first one. otherwise
- # open etc would have many names
- $quote = 1;
- #print HTML process_puretext($text, \$quote);
- print HTML $text;
- print HTML "</A>" if $text;
- print HTML "</STRONG>";
-
+ print HTML '<DT>';
+ if ($text =~ /(\S+)/) {
+ print HTML '<STRONG>';
+ if ($items_named{$1}++) {
+ print HTML html_escape($text);
+ } else {
+ my $name = 'item_' . htmlify(1,$text);
+ print HTML qq(<A NAME="$name">), html_escape($text), '</A>';
+ }
+ print HTML '</STRONG>';
+ }
print HTML '<DD>';
}
@@ -1276,12 +1289,15 @@ sub process_puretext {
$word = qq(<A HREF="$word">$word</A>);
} elsif ($word =~ /[\w.-]+\@\w+\.\w/) {
# looks like an e-mail address
- $word = qq(<A HREF="MAILTO:$word">$word</A>);
+ my ($w1, $w2, $w3) = ("", $word, "");
+ ($w1, $w2, $w3) = ("(", $1, ")$2") if $word =~ /^\((.*?)\)(,?)/;
+ ($w1, $w2, $w3) = ("&lt;", $1, "&gt;$2") if $word =~ /^<(.*?)>(,?)/;
+ $word = qq($w1<A HREF="mailto:$w2">$w2</A>$w3);
} elsif ($word !~ /[a-z]/ && $word =~ /[A-Z]/) { # all uppercase?
- $word = html_escape($word) if $word =~ /[&<>]/;
+ $word = html_escape($word) if $word =~ /["&<>]/;
$word = "\n<FONT SIZE=-1>$word</FONT>" if $netscape;
} else {
- $word = html_escape($word) if $word =~ /[&<>]/;
+ $word = html_escape($word) if $word =~ /["&<>]/;
}
}
@@ -1443,6 +1459,7 @@ sub process_C {
$s1 =~ s/\([^()]*\)//g; # delete parentheses
$s2 = $s1;
$s1 =~ s/\W//g; # delete bogus characters
+ $str = html_escape($str);
# if there was a pod file that we found earlier with an appropriate
# =item directive, then create a link to that page.
@@ -1512,7 +1529,7 @@ sub process_X {
# after the entire pod file has been read and converted.
#
sub finish_list {
- while ($listlevel >= 0) {
+ while ($listlevel > 0) {
print HTML "</DL>\n";
$listlevel--;
}
@@ -1546,4 +1563,3 @@ BEGIN {
}
1;
-