diff options
Diffstat (limited to 'lib/Pod/Html.pm')
-rw-r--r-- | lib/Pod/Html.pm | 118 |
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) = ("<", $1, ">$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; - |