summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Pod/Simple/XHTML.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Pod/Simple/XHTML.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Simple/XHTML.pm109
1 files changed, 81 insertions, 28 deletions
diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/XHTML.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/XHTML.pm
index 6a8fb7e97e4..ef05ddb6ea5 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Simple/XHTML.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Simple/XHTML.pm
@@ -23,13 +23,29 @@ This is a subclass of L<Pod::Simple::Methody> and inherits all its
methods. The implementation is entirely different than
L<Pod::Simple::HTML>, but it largely preserves the same interface.
+=head2 Minimal code
+
+ use Pod::Simple::XHTML;
+ my $psx = Pod::Simple::XHTML->new;
+ $psx->output_string(\my $html);
+ $psx->parse_file('path/to/Module/Name.pm');
+ open my $out, '>', 'out.html' or die "Cannot open 'out.html': $!\n";
+ print $out $html;
+
+You can also control the character encoding and entities. For example, if
+you're sure that the POD is properly encoded (using the C<=encoding> command),
+you can prevent high-bit characters from being encoded as HTML entities and
+declare the output character set as UTF-8 before parsing, like so:
+
+ $psx->html_charset('UTF-8');
+ $psx->html_encode_chars('&<>">');
+
=cut
package Pod::Simple::XHTML;
use strict;
use vars qw( $VERSION @ISA $HAS_HTML_ENTITIES );
-$VERSION = '3.14';
-use Carp ();
+$VERSION = '3.16';
use Pod::Simple::Methody ();
@ISA = ('Pod::Simple::Methody');
@@ -46,10 +62,17 @@ my %entities = (
);
sub encode_entities {
- return HTML::Entities::encode_entities( $_[0] ) if $HAS_HTML_ENTITIES;
+ my $self = shift;
+ my $ents = $self->html_encode_chars;
+ return HTML::Entities::encode_entities( $_[0], $ents ) if $HAS_HTML_ENTITIES;
+ if (defined $ents) {
+ $ents =~ s,(?<!\\)([]/]),\\$1,g;
+ $ents =~ s,(?<!\\)\\\z,\\\\,;
+ } else {
+ $ents = join '', keys %entities;
+ }
my $str = $_[0];
- my $ents = join '', keys %entities;
- $str =~ s/([$ents])/'&' . $entities{$1} . ';'/ge;
+ $str =~ s/([$ents])/'&' . ($entities{$1} || sprintf '#x%X', ord $1) . ';'/ge;
return $str;
}
@@ -107,6 +130,12 @@ not set by default.
A document type tag for the file. This option is not set by default.
+=head2 html_charset
+
+The charater set to declare in the Content-Type meta tag created by default
+for C<html_header_tags>. Note that this option will be ignored if the value of
+C<html_header_tags> is changed. Defaults to "ISO-8859-1".
+
=head2 html_header_tags
Additional arbitrary HTML tags for the header of the document. The
@@ -117,6 +146,15 @@ default value is just a content type header tag:
Add additional meta tags here, or blocks of inline CSS or JavaScript
(wrapped in the appropriate tags).
+=head3 html_encode_chars
+
+A string containing all characters that should be encoded as HTML entities,
+specified using the regular expression character class syntax (what you find
+within brackets in regular expressions). This value will be passed as the
+second argument to the C<encode_entities> fuction of L<HTML::Entities>. IF
+L<HTML::Entities> is not installed, then any characters other than C<&<>"'>
+will be encoded numerically.
+
=head2 html_h_level
This is the level of HTML "Hn" element to which a Pod "head1" corresponds. For
@@ -165,10 +203,11 @@ __PACKAGE__->_accessorize(
'man_url_prefix',
'man_url_postfix',
'title_prefix', 'title_postfix',
- 'html_css',
+ 'html_css',
'html_javascript',
'html_doctype',
- 'html_header_tags',
+ 'html_charset',
+ 'html_encode_chars',
'html_h_level',
'title', # Used internally for the title extracted from the content
'default_title',
@@ -198,7 +237,7 @@ sub new {
$new->{'output_fh'} ||= *STDOUT{IO};
$new->perldoc_url_prefix('http://search.cpan.org/perldoc?');
$new->man_url_prefix('http://man.he.net/man');
- $new->html_header_tags('<meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1" />');
+ $new->html_charset('ISO-8859-1');
$new->nix_X_codes(1);
$new->codes_in_verbatim(1);
$new->{'scratch'} = '';
@@ -206,6 +245,7 @@ sub new {
$new->{'output'} = [];
$new->{'saved'} = [];
$new->{'ids'} = {};
+ $new->{'in_li'} = [];
$new->{'__region_targets'} = [];
$new->{'__literal_targets'} = {};
@@ -214,6 +254,14 @@ sub new {
return $new;
}
+sub html_header_tags {
+ my $self = shift;
+ return $self->{html_header_tags} = shift if @_;
+ return $self->{html_header_tags}
+ ||= '<meta http-equiv="Content-Type" content="text/html; charset='
+ . $self->html_charset . '" />';
+}
+
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=head2 handle_text
@@ -270,7 +318,7 @@ sub handle_text {
# escape special characters in HTML (<, >, &, etc)
$_[0]{'scratch'} .= $_[0]->__in_literal_xhtml_region
? $_[1]
- : encode_entities( $_[1] );
+ : $_[0]->encode_entities( $_[1] );
}
sub start_Para { $_[0]{'scratch'} = '<p>' }
@@ -282,15 +330,15 @@ sub start_head3 { $_[0]{'in_head'} = 3 }
sub start_head4 { $_[0]{'in_head'} = 4 }
sub start_item_number {
- $_[0]{'scratch'} = "</li>\n" if $_[0]{'in_li'};
+ $_[0]{'scratch'} = "</li>\n" if ($_[0]{'in_li'}->[-1] && pop @{$_[0]{'in_li'}});
$_[0]{'scratch'} .= '<li><p>';
- $_[0]{'in_li'} = 1
+ push @{$_[0]{'in_li'}}, 1;
}
sub start_item_bullet {
- $_[0]{'scratch'} = "</li>\n" if $_[0]{'in_li'};
+ $_[0]{'scratch'} = "</li>\n" if ($_[0]{'in_li'}->[-1] && pop @{$_[0]{'in_li'}});
$_[0]{'scratch'} .= '<li><p>';
- $_[0]{'in_li'} = 1
+ push @{$_[0]{'in_li'}}, 1;
}
sub start_item_text {
@@ -301,9 +349,9 @@ sub start_item_text {
$_[0]{'scratch'} .= '<dt>';
}
-sub start_over_bullet { $_[0]{'scratch'} = '<ul>'; $_[0]->emit }
+sub start_over_bullet { $_[0]{'scratch'} = '<ul>'; push @{$_[0]{'in_li'}}, 0; $_[0]->emit }
sub start_over_block { $_[0]{'scratch'} = '<ul>'; $_[0]->emit }
-sub start_over_number { $_[0]{'scratch'} = '<ol>'; $_[0]->emit }
+sub start_over_number { $_[0]{'scratch'} = '<ol>'; push @{$_[0]{'in_li'}}, 0; $_[0]->emit }
sub start_over_text {
$_[0]{'scratch'} = '<dl>';
$_[0]{'dl_level'}++;
@@ -314,14 +362,16 @@ sub start_over_text {
sub end_over_block { $_[0]{'scratch'} .= '</ul>'; $_[0]->emit }
sub end_over_number {
- $_[0]{'scratch'} = "</li>\n" if delete $_[0]{'in_li'};
+ $_[0]{'scratch'} = "</li>\n" if ( pop @{$_[0]{'in_li'}} );
$_[0]{'scratch'} .= '</ol>';
+ pop @{$_[0]{'in_li'}};
$_[0]->emit;
}
sub end_over_bullet {
- $_[0]{'scratch'} = "</li>\n" if delete $_[0]{'in_li'};
+ $_[0]{'scratch'} = "</li>\n" if ( pop @{$_[0]{'in_li'}} );
$_[0]{'scratch'} .= '</ul>';
+ pop @{$_[0]{'in_li'}};
$_[0]->emit;
}
@@ -372,7 +422,7 @@ sub end_item_text {
}
# This handles =begin and =for blocks of all kinds.
-sub start_for {
+sub start_for {
my ($self, $flags) = @_;
push @{ $self->{__region_targets} }, $flags->{target_matching};
@@ -386,7 +436,7 @@ sub start_for {
$self->emit;
}
-sub end_for {
+sub end_for {
my ($self) = @_;
$self->{'scratch'} .= '</div>' unless $self->__in_literal_xhtml_region;
@@ -395,7 +445,7 @@ sub end_for {
$self->emit;
}
-sub start_Document {
+sub start_Document {
my ($self) = @_;
if (defined $self->html_header) {
$self->{'scratch'} .= $self->html_header;
@@ -407,7 +457,7 @@ sub start_Document {
$metatags = $self->html_header_tags || '';
if ($self->html_css) {
$metatags .= "\n<link rel='stylesheet' href='" .
- $self->html_css . "' type='text/css'>";
+ $self->html_css . "' type='text/css' />";
}
if ($self->html_javascript) {
$metatags .= "\n<script type='text/javascript' src='" .
@@ -500,10 +550,12 @@ sub end_I { $_[0]{'scratch'} .= '</i>' }
sub start_L {
my ($self, $flags) = @_;
my ($type, $to, $section) = @{$flags}{'type', 'to', 'section'};
- my $url = $type eq 'url' ? $to
+ my $url = $self->encode_entities(
+ $type eq 'url' ? $to
: $type eq 'pod' ? $self->resolve_pod_page_link($to, $section)
: $type eq 'man' ? $self->resolve_man_page_link($to, $section)
- : undef;
+ : undef
+ );
# If it's an unknown type, use an attribute-less <a> like HTML.pm.
$self->{'scratch'} .= '<a' . ($url ? ' href="'. $url . '">' : '>');
@@ -511,8 +563,8 @@ sub start_L {
sub end_L { $_[0]{'scratch'} .= '</a>' }
-sub start_S { $_[0]{'scratch'} .= '<nobr>' }
-sub end_S { $_[0]{'scratch'} .= '</nobr>' }
+sub start_S { $_[0]{'scratch'} .= '<span style="white-space: nowrap;">' }
+sub end_S { $_[0]{'scratch'} .= '</span>' }
sub emit {
my($self) = @_;
@@ -554,7 +606,7 @@ sub resolve_pod_page_link {
}
return ($self->perldoc_url_prefix || '')
- . encode_entities($to) . $section
+ . $self->encode_entities($to) . $section
. ($self->perldoc_url_postfix || '');
}
@@ -583,7 +635,7 @@ sub resolve_man_page_link {
my ($page, $part) = $to =~ /^([^(]+)(?:[(](\d+)[)])?$/;
return undef unless $page;
return ($self->man_url_prefix || '')
- . ($part || 1) . "/" . encode_entities($page)
+ . ($part || 1) . "/" . $self->encode_entities($page)
. ($self->man_url_postfix || '');
}
@@ -627,6 +679,7 @@ sub idify {
for ($t) {
s/<[^>]+>//g; # Strip HTML.
s/&[^;]+;//g; # Strip entities.
+ s/^\s+//; s/\s+$//; # Strip white space.
s/^([^a-zA-Z]+)$/pod$1/; # Prepend "pod" if no valid chars.
s/^[^a-zA-Z]+//; # First char must be a letter.
s/[^-a-zA-Z0-9_:.]+/-/g; # All other chars must be valid.
@@ -689,7 +742,7 @@ merchantability or fitness for a particular purpose.
=head1 ACKNOWLEDGEMENTS
-Thanks to L<Hurricane Electrict|http://he.net/> for permission to use its
+Thanks to L<Hurricane Electric|http://he.net/> for permission to use its
L<Linux man pages online|http://man.he.net/> site for man page links.
Thanks to L<search.cpan.org|http://search.cpan.org/> for permission to use the
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-18 09:27:00 +0000