cpan/Pod-Simple/t/corpus/encwarn01.xml Pod::Simple test file
cpan/Pod-Simple/t/corpus/encwarn02.txt Pod::Simple test file
cpan/Pod-Simple/t/corpus/encwarn02.xml Pod::Simple test file
+cpan/Pod-Simple/t/corpus/encwarn03.txt
+cpan/Pod-Simple/t/corpus/encwarn03.xml
+cpan/Pod-Simple/t/corpus/encwarn04.txt
+cpan/Pod-Simple/t/corpus/encwarn04.xml
cpan/Pod-Simple/t/corpus/fet_cont.txt Pod::Simple test file
cpan/Pod-Simple/t/corpus/fet_cont.xml Pod::Simple test file
cpan/Pod-Simple/t/corpus/fet_dup.txt Pod::Simple test file
cpan/Pod-Simple/t/corpus/thai_iso11.txt Pod::Simple test file
cpan/Pod-Simple/t/corpus/thai_iso11.xml Pod::Simple test file
cpan/Pod-Simple/t/emptylists.t Pod::Simple test file
+cpan/Pod-Simple/t/enc-chars.t
cpan/Pod-Simple/t/encod01.t Pod::Simple test file
cpan/Pod-Simple/t/encod02.t Pod::Simple test file
cpan/Pod-Simple/t/encod03.t Pod::Simple test file
+cpan/Pod-Simple/t/encod04.t
cpan/Pod-Simple/t/end_over.t Pod::Simple test file
cpan/Pod-Simple/t/eol2.t Pod::Simple test file
cpan/Pod-Simple/t/eol.t Pod::Simple test file
cpan/Pod-Simple/t/xhtml10.t Pod::Simple test file
cpan/Pod-Simple/t/xhtml15.t Pod::Simple test file
cpan/Pod-Simple/t/xhtml20.t Pod::Simple test file
+cpan/Pod-Simple/t/xhtml-bkb.t
cpan/Pod-Simple/t/x_nixer.t Pod::Simple test file
cpan/Pod-Usage/lib/Pod/Usage.pm
cpan/Pod-Usage/scripts/pod2usage.PL
'Pod::Simple' => {
'MAINTAINER' => 'arandal',
- 'DISTRIBUTION' => 'DWHEELER/Pod-Simple-3.23.tar.gz',
+ 'DISTRIBUTION' => 'DWHEELER/Pod-Simple-3.26.tar.gz',
'FILES' => q[cpan/Pod-Simple],
'UPSTREAM' => 'cpan',
},
# ChangeLog for Pod::Simple dist
#---------------------------------------------------------------------------
+2013-02-27 David E. Wheeler <david@justatheory.org>
+ * Release 3.26
+
+ Fixed another test script to skip all tests when Encode is not
+ installed.
+
+ Added 'encoding()' and 'detected_encoding()' to return the current
+ encoding and the encoding actually to decode the input file. The
+ value from "=encoding" is also now kept in the output tree. Patch
+ from Patrice Dumas (RT #74390).
+
+2013-02-16 David E. Wheeler <david@justatheory.org>
+ * Release 3.25
+
+ Improved the warning when "=item" types mismatch within one
+ "=over"/"=back" block.
+
+2013-02-14 David E. Wheeler <david@justatheory.org>
+ * Release 3.24
+
+ Fixed corner case bug for unlikely scenario in which non-UTF-8
+ text could be parsed as UTF-8. Grant McLean.
+
+ XHTML IDs can no longer end with punctuation. Thanks to Smylers
+ for the patch.
+
+ Fixed test failure on Perl 5.6.2.
+
+ Changed the default installation location from "perl" to "site" on
+ 5.12 and higher, since as of that version of Perl, dual-life
+ modules no longer need to be installed in "perl" to replace
+ in-core versions. Patch from tzccinct.
+
+ Fixed hash order dependency test failures on Perl 5.17. Thanks to
+ Yves Orton for the patch.
+
+ Inlined the code that tries to guess a Pod file's encoding. This
+ reduces the time Pod::Simple takes to build the core Perl
+ documentation by 15-20%. Thanks to Dagfinn Ilmari Mannsåker for
+ the patch!
+
+ Added a warning when "=item" types mismatch within one
+ "=over"/"=back" block. Marc Green/Google Summer of Code, with
+ assist from RJBS.
+
+ Fixed regression introduced in 3.22 in which "C< >" tags were
+ incorrectly treated as verbatim text in table of contents items
+ emitted by Pod::Simple::XHTML. Thanks to Randy Stauner for the
+ report and to Thomas Sibley for the fix!
+
+ Loosened up the matching of "L< >" tags for man pages so that they
+ allow names with dots, underscores, and any other chararacters
+ other than "/", just so long as they end in '[(][-a-zA-Z0-9]+[)]'.
+ Thanks to Dave Rolsky and Kevin Ryde for the reports (RT #82975 &
+ RT #82972).
+
+ Fixed inverted mapping of "keyboard" to "kbd" in
+ Pod::Simple::HTML. Thanks to Robert Boisvert for the bug report
+ (RT #79201).
+
+ Added two new Tagmap entries to Pod::Simple::HTML: "preformat"
+ maps to "pre", and "teletype" maps to "tt". Suggested by Robert
+ Boisvert (RT #79201).
+
+ "X< >" tags are now ignored by the pull parser when it searches
+ for titles, as is any trailing whitespace. Thanks to Patrice Dumas
+ for the report (RT #74389).
+
2012-08-14 David E. Wheeler <david@justatheory.org>
* Release 3.23
-=head1 Pod::Simple version 3.23
+=head1 Pod::Simple version 3.26
Pod::Simple is a Perl library for parsing text in the Pod ("plain old
documentation") markup language that is typically used for writing
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
-L<http://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
+L<https://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
to clone L<git://github.com/theory/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to
);
@ISA = ('Pod::Simple::BlackBox');
-$VERSION = '3.23';
+$VERSION = '3.26';
@Known_formatting_codes = qw(I B C L E F S X Z);
%Known_formatting_codes = map(($_=>1), @Known_formatting_codes);
return shift->{'errors_seen'} || 0;
}
+# Returns the encoding only if it was recognized as being handled and set
+sub detected_encoding {
+ return shift->{'detected_encoding'};
+}
+
+sub encoding {
+ my $this = shift;
+ return $this->{'encoding'} unless @_; # GET.
+
+ $this->_handle_encoding_line("=encoding $_[0]");
+ if ($this->{'_processed_encoding'}) {
+ delete $this->{'_processed_encoding'};
+ if(! $this->{'encoding_command_statuses'} ) {
+ DEBUG > 2 and print " CRAZY ERROR: encoding wasn't really handled?!\n";
+ } elsif( $this->{'encoding_command_statuses'}[-1] ) {
+ $this->scream( "=encoding $_[0]",
+ sprintf "Couldn't do %s: %s",
+ $this->{'encoding_command_reqs' }[-1],
+ $this->{'encoding_command_statuses'}[-1],
+ );
+ } else {
+ DEBUG > 2 and print " (encoding successfully handled.)\n";
+ }
+ return $this->{'encoding'};
+ } else {
+ return undef;
+ }
+}
+
#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
# Pull in some functions that, for some reason, I expect to see here too:
BEGIN {
# Catch some very simple and/or common cases
if(@{$ell} == 3 and ! ref $ell->[2]) {
my $it = $ell->[2];
- if($it =~ m/^[-a-zA-Z0-9]+\([-a-zA-Z0-9]+\)$/s) { # man sections
+ if($it =~ m{^[^/|]+[(][-a-zA-Z0-9]+[)]$}s) { # man sections
# Hopefully neither too broad nor too restrictive a RE
DEBUG > 1 and print "Catching \"$it\" as manpage link.\n";
$ell->[1]{'type'} = 'man';
# And the E resolver will have to deal with all our treeletty things:
if(@ell_content == 1 and !ref($ell_content[0])
- and $ell_content[0] =~ m/^[-a-zA-Z0-9]+\([-a-zA-Z0-9]+\)$/s
+ and $ell_content[0] =~ m{^[^/]+[(][-a-zA-Z0-9]+[)]$}s
) {
$ell->[1]{'type'} = 'man';
DEBUG > 3 and print "Considering this ($ell_content[0]) a man link.\n";
die "too many errors\n" if $parser->any_errata_seen();
+=item C<< $parser->detected_encoding() >>X<detected_encoding>
+
+Return the encoding corresponding to C<< =encoding >>, but only if the
+encoding was recognized and handled.
+
+=item C<< $parser->encoding() >>X<encoding>
+
+Return encoding of the document, even if the encoding is not correctly
+handled.
+
=item C<< $parser->parse_from_file( $source, $to ) >>X<parse_from_file>
Parses from C<$source> file to C<$to> file. Similar to L<<
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
-L<http://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
+L<https://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
to clone L<git://github.com/theory/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to
use strict;
use Carp ();
use vars qw($VERSION );
-$VERSION = '3.23';
+$VERSION = '3.26';
#use constant DEBUG => 7;
BEGIN {
require Pod::Simple;
if( ($line = $source_line) =~ s/^\xEF\xBB\xBF//s ) {
DEBUG and print "UTF-8 BOM seen. Faking a '=encoding utf8'.\n";
$self->_handle_encoding_line( "=encoding utf8" );
+ delete $self->{'_processed_encoding'};
$line =~ tr/\n\r//d;
} elsif( $line =~ s/^\xFE\xFF//s ) {
}
}
- if(!$self->parse_characters && !$self->{'encoding'}) {
- $self->_try_encoding_guess($line)
+ # Try to guess encoding. Inlined for performance reasons.
+ if(!$self->{'parse_characters'} && !$self->{'encoding'}
+ && ($self->{'in_pod'} || $line =~ /^=/s)
+ && $line =~ /[^\x00-\x7f]/
+ ) {
+ my $encoding = $line =~ /^[\x00-\x7f]*[\xC0-\xFD][\x80-\xBF]/ ? 'UTF-8' : 'ISO8859-1';
+ $self->_handle_encoding_line( "=encoding $encoding" );
+ $self->{'_transcoder'} && $self->{'_transcoder'}->($line);
+
+ my ($word) = $line =~ /(\S*[^\x00-\x7f]\S*)/;
+
+ $self->whine(
+ $self->{'line_count'},
+ "Non-ASCII character seen before =encoding in '$word'. Assuming $encoding"
+ );
}
DEBUG > 5 and print "# Parsing line: [$line]\n";
$@ && die( $enc_error =
"Really unexpected error setting up encoding $e: $@\nAborting"
);
+ $self->{'detected_encoding'} = $e;
} else {
my @supported = Pod::Simple::Transcode::->all_encodings;
$self->scream( $self->{'line_count'}, $enc_error );
}
push @{ $self->{'encoding_command_statuses'} }, $enc_error;
+ if (defined($self->{'_processed_encoding'})) {
+ # Should never happen
+ die "Nested processed encoding.";
+ }
+ $self->{'_processed_encoding'} = $orig;
- return '=encoding ALREADYDONE';
+ return $line;
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
DEBUG > 2 and print "Ogling encoding directive: =encoding $content\n";
- if($content eq 'ALREADYDONE') {
+ if (defined($self->{'_processed_encoding'})) {
+ #if($content ne $self->{'_processed_encoding'}) {
+ # Could it happen?
+ #}
+ delete $self->{'_processed_encoding'};
# It's already been handled. Check for errors.
if(! $self->{'encoding_command_statuses'} ) {
DEBUG > 2 and print " CRAZY ERROR: It wasn't really handled?!\n";
return;
}
-sub _try_encoding_guess {
- my ($self,$line) = @_;
-
- if(!$self->{'in_pod'} and $line !~ /^=/m) {
- return; # don't whine about non-ASCII bytes in code/comments
- }
-
- return unless $line =~ /[^\x00-\x7f]/; # Look for non-ASCII byte
-
- my $encoding = $line =~ /[\xC0-\xFD][\x80-\xBF]/ ? 'UTF-8' : 'ISO8859-1';
- $self->_handle_encoding_line( "=encoding $encoding" );
- $self->{'_transcoder'} && $self->{'_transcoder'}->($line);
-
- my ($word) = $line =~ /(\S*[^\x00-\x7f]\S*)/;
-
- $self->whine(
- $self->{'line_count'},
- "Non-ASCII character seen before =encoding in '$word'. Assuming $encoding"
- );
-
-}
-
#~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`
{
if($item_type eq 'text') {
# Nothing special needs doing for 'text'
} elsif($item_type eq 'number' or $item_type eq 'bullet') {
- die "Unknown item type $item_type"
- unless $item_type eq 'number' or $item_type eq 'bullet';
+ $self->whine(
+ $para->[1]{'start_line'},
+ "Expected text after =item, not a $item_type"
+ );
# Undo our clobbering:
push @$para, $para->[1]{'~orig_content'};
delete $para->[1]{'number'};
} elsif($para_type eq '=encoding') {
# Not actually acted on here, but we catch errors here.
$self->_handle_encoding_second_level($para);
-
- next; # and skip
+ $para_type = 'Plain';
} elsif($para_type eq '~Verbatim') {
$para->[0] = 'Verbatim';
$para_type = '?Verbatim';
if($item_type eq 'text') {
# Nothing special needs doing for 'text'
} elsif($item_type eq 'number' or $item_type eq 'bullet') {
- die "Unknown item type $item_type"
- unless $item_type eq 'number' or $item_type eq 'bullet';
+ $self->whine(
+ $para->[1]{'start_line'},
+ "Expected text after =item, not a $item_type"
+ );
# Undo our clobbering:
push @$para, $para->[1]{'~orig_content'};
delete $para->[1]{'number'};
use Pod::Simple::Methody ();
use Pod::Simple ();
use vars qw( @ISA $VERSION );
-$VERSION = '3.23';
+$VERSION = '3.26';
@ISA = ('Pod::Simple::Methody');
BEGIN { *DEBUG = defined(&Pod::Simple::DEBUG)
? \&Pod::Simple::DEBUG
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
-L<http://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
+L<https://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
to clone L<git://github.com/theory/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to
package Pod::Simple::Debug;
use strict;
use vars qw($VERSION );
-$VERSION = '3.23';
+$VERSION = '3.26';
sub import {
my($value,$variable);
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
-L<http://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
+L<https://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
to clone L<git://github.com/theory/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to
require 5;
package Pod::Simple::DumpAsText;
-$VERSION = '3.23';
+$VERSION = '3.26';
use Pod::Simple ();
BEGIN {@ISA = ('Pod::Simple')}
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
-L<http://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
+L<https://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
to clone L<git://github.com/theory/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to
require 5;
package Pod::Simple::DumpAsXML;
-$VERSION = '3.23';
+$VERSION = '3.26';
use Pod::Simple ();
BEGIN {@ISA = ('Pod::Simple')}
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
-L<http://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
+L<https://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
to clone L<git://github.com/theory/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to
$Doctype_decl $Content_decl
);
@ISA = ('Pod::Simple::PullParser');
-$VERSION = '3.23';
+$VERSION = '3.26';
BEGIN {
if(defined &DEBUG) { } # no-op
qw[
sample=samp
definition=dfn
- kbd=keyboard
+ keyboard=kbd
variable=var
citation=cite
abbreviation=abbr
small=small
underline=u
strikethrough=s
+ preformat=pre
+ teletype=tt
] # no point in providing a way to get <q>...</q>, I think
),
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
-L<http://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
+L<https://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
to clone L<git://github.com/theory/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to
use vars qw( $VERSION $HTML_RENDER_CLASS $HTML_EXTENSION
$CSS $JAVASCRIPT $SLEEPY $SEARCH_CLASS @ISA
);
-$VERSION = '3.23';
+$VERSION = '3.26';
@ISA = (); # Yup, we're NOT a subclass of Pod::Simple::HTML!
# TODO: nocontents stylesheets. Strike some of the color variations?
% mkdir ../seekrut
% chmod og-rx ../seekrut
- % perl -MPod::Simple::HTMLBatch -e Pod::Simple::HTMLBatch::go . ../htmlversion
+ % perl -MPod::Simple::HTMLBatch -e Pod::Simple::HTMLBatch::go . ../seekrut
(to convert the pod under the current dir into HTML
files under the directory ./seekrut)
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
-L<http://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
+L<https://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
to clone L<git://github.com/theory/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to
package Pod::Simple::LinkSection;
# Based somewhat dimly on Array::Autojoin
use vars qw($VERSION );
-$VERSION = '3.23';
+$VERSION = '3.26';
use strict;
use Pod::Simple::BlackBox;
use vars qw($VERSION );
-$VERSION = '3.23';
+$VERSION = '3.26';
use overload( # So it'll stringify nice
'""' => \&Pod::Simple::BlackBox::stringify_lol,
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
-L<http://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
+L<https://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
to clone L<git://github.com/theory/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to
use strict;
use Pod::Simple ();
use vars qw(@ISA $VERSION);
-$VERSION = '3.23';
+$VERSION = '3.26';
@ISA = ('Pod::Simple');
# Yes, we could use named variables, but I want this to be impose
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
-L<http://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
+L<https://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
to clone L<git://github.com/theory/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to
require 5;
package Pod::Simple::Progress;
-$VERSION = '3.23';
+$VERSION = '3.26';
use strict;
# Objects of this class are used for noting progress of an
require 5;
package Pod::Simple::PullParser;
-$VERSION = '3.23';
+$VERSION = '3.26';
use Pod::Simple ();
BEGIN {@ISA = ('Pod::Simple')}
my $head1_text_content;
my $para_text_content;
+ my $skipX;
while(
++$token_count <= ($max_token || 1_000_000)
elsif($state == 1) { # accumulating text until end of head1
if( $token->is_text ) {
- DEBUG and print " Adding \"", $token->text, "\" to head1-content.\n";
- $head1_text_content .= $token->text;
+ unless ($skipX) {
+ DEBUG and print " Adding \"", $token->text, "\" to head1-content.\n";
+ $head1_text_content .= $token->text;
+ }
+ } elsif( $token->is_tagname('X') ) {
+ # We're going to want to ignore X<> stuff.
+ $skipX = $token->is_start;
+ DEBUG and print +($skipX ? 'Start' : 'End'), 'ing ignoring of X<> tag';
} elsif( $token->is_end and $token->tagname eq 'head1' ) {
DEBUG and print " Found end of head1. Considering content...\n";
$head1_text_content = uc $head1_text_content if $nocase;
? (length($head1_text_content) <= $max_content_length) # sanity
: 1)
) {
- DEBUG and print " It looks titular: \"$head1_text_content\".\n",
- "\n Using that.\n";
- $title = $head1_text_content;
+ # Looks good; trim it
+ ($title = $head1_text_content) =~ s/\s+$//;
+ DEBUG and print " It looks titular: \"$title\".\n\n Using that.\n";
last;
} else {
--$state;
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
-L<http://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
+L<https://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
to clone L<git://github.com/theory/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to
use strict;
use vars qw(@ISA $VERSION);
@ISA = ('Pod::Simple::PullParserToken');
-$VERSION = '3.23';
+$VERSION = '3.26';
sub new { # Class->new(tagname);
my $class = shift;
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
-L<http://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
+L<https://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
to clone L<git://github.com/theory/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to
use strict;
use vars qw(@ISA $VERSION);
@ISA = ('Pod::Simple::PullParserToken');
-$VERSION = '3.23';
+$VERSION = '3.26';
sub new { # Class->new(tagname, optional_attrhash);
my $class = shift;
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
-L<http://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
+L<https://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
to clone L<git://github.com/theory/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to
use strict;
use vars qw(@ISA $VERSION);
@ISA = ('Pod::Simple::PullParserToken');
-$VERSION = '3.23';
+$VERSION = '3.26';
sub new { # Class->new(text);
my $class = shift;
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
-L<http://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
+L<https://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
to clone L<git://github.com/theory/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to
package Pod::Simple::PullParserToken;
# Base class for tokens gotten from Pod::Simple::PullParser's $parser->get_token
@ISA = ();
-$VERSION = '3.23';
+$VERSION = '3.26';
use strict;
sub new { # Class->new('type', stuff...); ## Overridden in derived classes anyway
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
-L<http://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
+L<https://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
to clone L<git://github.com/theory/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to
use strict;
use vars qw($VERSION @ISA %Escape $WRAP %Tagmap);
-$VERSION = '3.23';
+$VERSION = '3.26';
use Pod::Simple::PullParser ();
BEGIN {@ISA = ('Pod::Simple::PullParser')}
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
-L<http://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
+L<https://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
to clone L<git://github.com/theory/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to
use strict;
use vars qw($VERSION $MAX_VERSION_WITHIN $SLEEPY);
-$VERSION = '3.23'; ## Current version of this package
+$VERSION = '3.26'; ## Current version of this package
BEGIN { *DEBUG = sub () {0} unless defined &DEBUG; } # set DEBUG level
use Carp ();
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
-L<http://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
+L<https://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
to clone L<git://github.com/theory/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to
use Carp ();
use Pod::Simple ();
use vars qw( $ATTR_PAD @ISA $VERSION $SORT_ATTRS);
-$VERSION = '3.23';
+$VERSION = '3.26';
BEGIN {
@ISA = ('Pod::Simple');
*DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG;
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
-L<http://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
+L<https://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
to clone L<git://github.com/theory/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
-L<http://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
+L<https://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
to clone L<git://github.com/theory/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to
use Pod::Simple::Methody ();
use Pod::Simple ();
use vars qw( @ISA $VERSION $FREAKYMODE);
-$VERSION = '3.23';
+$VERSION = '3.26';
@ISA = ('Pod::Simple::Methody');
BEGIN { *DEBUG = defined(&Pod::Simple::DEBUG)
? \&Pod::Simple::DEBUG
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
-L<http://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
+L<https://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
to clone L<git://github.com/theory/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to
use Carp ();
use Pod::Simple ();
use vars qw( @ISA $VERSION );
-$VERSION = '3.23';
+$VERSION = '3.26';
@ISA = ('Pod::Simple');
sub new {
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
-L<http://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
+L<https://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
to clone L<git://github.com/theory/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to
use Symbol ('gensym');
use Carp ();
use vars qw($VERSION );
-$VERSION = '3.23';
+$VERSION = '3.26';
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
require 5;
package Pod::Simple::Transcode;
use vars qw($VERSION );
-$VERSION = '3.23';
+$VERSION = '3.26';
BEGIN {
if(defined &DEBUG) {;} # Okay
package Pod::Simple::TranscodeDumb;
use strict;
use vars qw($VERSION %Supported);
-$VERSION = '3.23';
+$VERSION = '3.26';
# This module basically pretends it knows how to transcode, except
# only for null-transcodings! We use this when Encode isn't
# available.
use Pod::Simple;
require Encode;
use vars qw($VERSION );
-$VERSION = '3.23';
+$VERSION = '3.26';
sub is_dumb {0}
sub is_smart {1}
}
sub make_transcoder {
- my($e) = $_[1];
+ my $e = Encode::find_encoding($_[1]);
die "WHAT ENCODING!?!?" unless $e;
my $x;
return sub {
foreach $x (@_) {
- $x = Encode::decode($e, $x) unless Encode::is_utf8($x);
+ $x = $e->decode($x) unless Encode::is_utf8($x);
}
return;
};
package Pod::Simple::XHTML;
use strict;
use vars qw( $VERSION @ISA $HAS_HTML_ENTITIES );
-$VERSION = '3.23';
+$VERSION = '3.26';
use Pod::Simple::Methody ();
@ISA = ('Pod::Simple::Methody');
}
sub handle_text {
- if ($_[0]{'in_code'} && @{$_[0]{'in_code'}}) {
- return $_[0]->handle_code( $_[1], $_[0]{'in_code'}[-1] );
- }
# escape special characters in HTML (<, >, &, etc)
my $text = $_[0]->__in_literal_xhtml_region
? $_[1]
: $_[0]->encode_entities( $_[1] );
- $_[0]{'scratch'} .= $text;
+ if ($_[0]{'in_code'} && @{$_[0]{'in_code'}}) {
+ # Intentionally use the raw text in $_[1], even if we're not in a
+ # literal xhtml region, since handle_code calls encode_entities.
+ $_[0]->handle_code( $_[1], $_[0]{'in_code'}[-1] );
+ } else {
+ $_[0]{'scratch'} .= $text;
+ }
+
$_[0]{htext} .= $text if $_[0]{'in_head'};
}
=item *
+The final character can't be a hyphen, colon, or period. URLs ending with these
+characters, while allowed by XHTML, can be awkward to extract from plain text.
+
+=item *
+
Each id must be unique within the document.
=back
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.
+ s/[-:.]+$//; # Strip trailing punctuation.
}
return $t if $not_unique;
my $i = '';
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
-L<http://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
+L<https://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
to clone L<git://github.com/theory/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to
use Carp ();
use Pod::Simple ();
use vars qw( $ATTR_PAD @ISA $VERSION $SORT_ATTRS);
-$VERSION = '3.23';
+$VERSION = '3.26';
BEGIN {
@ISA = ('Pod::Simple');
*DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG;
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
-L<http://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
+L<https://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
to clone L<git://github.com/theory/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to
$_[0]->accept_targets("*");
}
+local $Pod::Simple::XMLOutStream::SORT_ATTRS = 1;
&ok(e(
"=begin :foo\n\n=begin :bar\n\nZaz\n\n",
"=begin :foo\n\n=begin :bar\n\nZaz\n\n=end :bar\n\n=end :foo\n\n",
<head1 start_line="7">
DESCRIPTION
</head1>
+ <encoding start_line="9">
+ iso-2022-jp
+ </encoding>
<Para start_line="11">
This is a test Pod document in ISO-2202-JP. Its content is some Japanese
haiku by famous poets.
<head1 start_line="7">
DESCRIPTION
</head1>
+ <encoding start_line="9">
+ iso-2022-jp
+ </encoding>
<Para start_line="11">
This is a test Pod document in ISO-2202-JP. Its content is some Japanese
haiku by famous poets.
<head1 start_line="6">
DESCRIPTION
</head1>
+ <encoding start_line="8">
+ iso-2022-jp
+ </encoding>
<Para start_line="10">
This is a test Pod document in ISO-2202-JP. Its content is some Japanese
haiku by famous poets.
<head1 start_line="6">
DESCRIPTION
</head1>
+ <encoding start_line="8">
+ iso-2022-jp
+ </encoding>
<Para start_line="10">
This is a test Pod document in ISO-2202-JP.
</Para>
<Document start_line="2">
+ <encoding start_line="2">
+ iso-8859-7
+ </encoding>
<head1 start_line="4">
NAME
</head1>
This Pod document is a paragraph in Arabic from "The Five Pillars of
Islam" as CP-1256.
</Para>
+ <encoding start_line="11">
+ cp1256
+ </encoding>
<Para start_line="13">
وعن عمارة بن
حزم قال قال
--- /dev/null
+package MyPackage;
+
+use strict;
+
+# Comment here contains āccénted characters but should not generate any
+# parse warning since they do not occur in a POD section
+
+sub main {
+ print "This file contains no POD\n";
+}
+
+1;
--- /dev/null
+<Document contentless="1" start_line="12">
+</Document>
--- /dev/null
+package MyPackage;
+
+use strict;
+
+# Checking encoding warning is generated even on first line of POD
+
+sub main {
+ print "This file contains no POD\n";
+}
+
+1;
+
+=head1 TŨTORIAL
+
+The encoding warning should only fire when the parser is 'in_pod' but that
+should also be true on the first line of POD (above).
+
--- /dev/null
+<Document start_line="13">
+ <head1 start_line="13">
+ TŨTORIAL
+ </head1>
+ <Para start_line="15">
+ The encoding warning should only fire when the parser is 'in_pod'
+ but that should also be true on the first line of POD (above).
+ </Para>
+ <head1 errata="1" start_line="-321">
+ POD ERRORS
+ </head1>
+ <Para errata="1" start_line="-321">
+ Hey!
+ <B>
+ The above document had some coding errors, which are explained below:
+ </B>
+ </Para>
+ <over-text errata="1" indent="4" start_line="-321">
+ <item-text start_line="-321">
+ Around line 13:
+ </item-text>
+ <Para start_line="-321">
+ Non-ASCII character seen before =encoding in 'TŨTORIAL'.
+ Assuming UTF-8
+ </Para>
+ </over-text>
+</Document>
<Document start_line="5">
+ <encoding start_line="5">
+ koi8-r
+ </encoding>
<head1 start_line="7">
NAME
</head1>
<head1 start_line="11">
TEXT
</head1>
+ <encoding start_line="13">
+ Shift-JIS
+ </encoding>
<Para start_line="15">
(This is a test Pod pocument in KOI8-R.)
</Para>
<Document start_line="5">
+ <encoding start_line="5">
+ koi8-r
+ </encoding>
<head1 start_line="7">
NAME
</head1>
Вставала
вдругзаря.
</VerbatimFormatted>
+ <encoding start_line="44">
+ koi8-r
+ </encoding>
<VerbatimFormatted start_line="46" xml:space="preserve">
И в эту
красоту
This document is a paragraph in Arabic from "The Five Pillars of
Islam" as ISO-8859-6.
</Para>
+ <encoding start_line="11">
+ iso-8859-6
+ </encoding>
<Para start_line="13">
وعن عمارة بن
حزم قال قال
<Document start_line="2">
+ <encoding start_line="2">
+ koi8-r
+ </encoding>
<head1 start_line="4">
NAME
</head1>
<Document start_line="1">
+ <encoding start_line="1">
+ big5
+ </encoding>
<head1 start_line="3">
老子道德經 三十八章
-- Big5 (Chinese) encoding test
<Document start_line="1">
+ <encoding start_line="1">
+ big5-eten
+ </encoding>
<head1 start_line="3">
老子道德經 三十八章
-- Big5 (Chinese) encoding test
<Document start_line="2">
+ <encoding start_line="2">
+ big5
+ </encoding>
<head1 start_line="4">
NAME
</head1>
<Document start_line="2">
+ <encoding start_line="2">
+ iso-8859-1
+ </encoding>
<head1 start_line="4">
NAME
</head1>
<Document start_line="2">
+ <encoding start_line="2">
+ cp1251
+ </encoding>
<head1 start_line="4">
NAME
</head1>
<Document start_line="2">
+ <encoding start_line="2">
+ ascii
+ </encoding>
<head1 start_line="4">
NAME
</head1>
<Document start_line="4">
+ <encoding start_line="4">
+ iso-8859-1
+ </encoding>
<head1 start_line="6">
NAME
</head1>
<Document start_line="4">
+ <encoding start_line="4">
+ utf8
+ </encoding>
<head1 start_line="6">
NAME
</head1>
<Document start_line="2">
+ <encoding start_line="2">
+ utf8
+ </encoding>
<head1 start_line="4">
NAME
</head1>
<Document start_line="2">
+ <encoding start_line="2">
+ shiftjis
+ </encoding>
<head1 start_line="4">
NAME
</head1>
<head1 start_line="6">
DESCRIPTION
</head1>
+ <encoding start_line="8">
+ iso-8859-11
+ </encoding>
<Para start_line="10">
This is a test Pod document in ISO-8859-11. Its content is a poem to (by?)
Khun Thong Dang
--- /dev/null
+# tell parser the source POD has already been decoded from bytes to chars
+# =encoding line should be ignored
+# utf8 characters should come through unscathed
+
+BEGIN {
+ if($ENV{PERL_CORE}) {
+ chdir 't';
+ @INC = '../lib';
+ }
+
+ use Config;
+ if ($Config::Config{'extensions'} !~ /\bEncode\b/) {
+ print "1..0 # Skip: Encode was not built\n";
+ exit 0;
+ }
+}
+
+use strict;
+use Test;
+BEGIN { plan tests => 3 };
+
+use Pod::Simple::DumpAsXML;
+use Pod::Simple::XMLOutStream;
+
+
+my $parser = Pod::Simple::XMLOutStream->new;
+$parser->parse_characters(1);
+my $output = '';
+$parser->output_string( \$output );
+$parser->parse_string_document(qq{
+
+=encoding bogocode
+
+=head1 DESCRIPTION
+
+Confirm that if we tell the parser to expect character data, it avoids all
+the code paths that might attempt to decode the source from bytes to chars.
+
+The r\x{101}in in \x{15E}pain \x{FB02}oods the plain
+
+});
+
+ok(1); # parsed without exception
+
+if($output =~ /POD ERRORS/) {
+ ok(0);
+}
+else {
+ ok(1); # no errors
+}
+
+$output =~ s{&#(\d+);}{chr($1)}eg;
+
+if($output =~ /The r\x{101}in in \x{15E}pain \x{FB02}oods the plain/) {
+ ok(1); # data was not messed up
+}
+else {
+ ok(0);
+}
+
+exit;
--- /dev/null
+# The encoding detection heuristic will choose UTF8 or Latin-1. The current
+# implementation will usually treat CP1252 (aka "Win-Latin-1") as Latin-1 but
+# can be fooled into seeing it as UTF8.
+#
+# Note 1: Neither guess is 'correct' since even if we choose Latin-1, all the
+# smart quote symbols will be rendered as control characters
+#
+# Note 2: the guess is only applied if the source POD omits =encoding, so
+# CP1252 source will render correctly if properly declared
+#
+
+BEGIN {
+ if($ENV{PERL_CORE}) {
+ chdir 't';
+ @INC = '../lib';
+ }
+}
+
+use strict;
+use Test;
+BEGIN { plan tests => 5 };
+
+ok 1;
+
+use Pod::Simple::DumpAsXML;
+use Pod::Simple::XMLOutStream;
+
+
+# Initial, isolated, non-ASCII byte triggers Latin-1 guess and later
+# multi-byte sequence is not considered by heuristic.
+
+my @output_lines = split m/[\cm\cj]+/, Pod::Simple::XMLOutStream->_out( qq{
+
+=head1 NAME
+
+Em::Dash \x97 \x91CAF\xC9\x92
+
+=cut
+
+} );
+
+my($guess) = "@output_lines" =~ m{Non-ASCII.*?Assuming ([\w-]+)};
+if( $guess ) {
+ if( $guess eq 'ISO8859-1' ) {
+ if( grep m{Dash (\x97|—|—)}, @output_lines ) {
+ ok 1;
+ } else {
+ ok 0;
+ print "# failed to find expected control character in output\n"
+ }
+ } else {
+ ok 0;
+ print "# parser guessed wrong encoding expected 'ISO8859-1' got '$guess'\n";
+ }
+} else {
+ ok 0;
+ print "# parser failed to detect non-ASCII bytes in input\n";
+}
+
+
+# Initial smart-quote character triggers Latin-1 guess as expected
+
+@output_lines = split m/[\cm\cj]+/, Pod::Simple::XMLOutStream->_out( qq{
+
+=head1 NAME
+
+Smart::Quote - \x91FUT\xC9\x92
+
+=cut
+
+} );
+
+($guess) = "@output_lines" =~ m{Non-ASCII.*?Assuming ([\w-]+)};
+if( $guess ) {
+ if( $guess eq 'ISO8859-1' ) {
+ ok 1;
+ } else {
+ ok 0;
+ print "# parser guessed wrong encoding expected 'ISO8859-1' got '$guess'\n";
+ }
+} else {
+ ok 0;
+ print "# parser failed to detect non-ASCII bytes in input\n";
+}
+
+
+# Initial accented character followed by 'smart' apostrophe causes heuristic
+# to choose UTF8 (a rather contrived example)
+
+@output_lines = split m/[\cm\cj]+/, Pod::Simple::XMLOutStream->_out( qq{
+
+=head1 NAME
+
+Smart::Apostrophe::Fail - L\xC9\x92STRANGE
+
+=cut
+
+} );
+
+($guess) = "@output_lines" =~ m{Non-ASCII.*?Assuming ([\w-]+)};
+if( $guess ) {
+ if( $guess eq 'UTF-8' ) {
+ ok 1;
+ } else {
+ ok 0;
+ print "# parser guessed wrong encoding expected 'UTF-8' got '$guess'\n";
+ }
+} else {
+ ok 0;
+ print "# parser failed to detect non-ASCII bytes in input\n";
+}
+
+
+# The previous example used a CP1252 byte sequence that also happened to be a
+# valid UTF8 byte sequence. In this example the heuristic also guesses 'wrong'
+# despite the byte sequence not being valid UTF8 (it's too short). This could
+# arguably be 'fixed' by using a less naive regex.
+
+@output_lines = split m/[\cm\cj]+/, Pod::Simple::XMLOutStream->_out( qq{
+
+=head1 NAME
+
+Smart::Apostrophe::Fail - L\xE9\x92Strange
+
+=cut
+
+} );
+
+($guess) = "@output_lines" =~ m{Non-ASCII.*?Assuming ([\w-]+)};
+if( $guess ) {
+ if( $guess eq 'UTF-8' ) {
+ ok 1;
+ } else {
+ ok 0;
+ print "# parser guessed wrong encoding expected 'UTF-8' got '$guess'\n";
+ }
+} else {
+ ok 0;
+ print "# parser failed to detect non-ASCII bytes in input\n";
+}
+
+
+exit;
use strict;
use Test;
-BEGIN { plan tests => 99 };
+BEGIN { plan tests => 101 };
#use Pod::Simple::Debug (10);
'<Document><Para><L content-implicit="yes" raw="crontab(5)" to="crontab(5)" type="man">crontab(5)</L></Para></Document>'
);
+ok($x->_out(qq{=pod\n\nL<login.conf(5)>\n}),
+ '<Document><Para><L content-implicit="yes" raw="login.conf(5)" to="login.conf(5)" type="man">login.conf(5)</L></Para></Document>'
+);
+
+ok($x->_out(qq{=pod\n\nL<foo_bar(5)>\n}),
+ '<Document><Para><L content-implicit="yes" raw="foo_bar(5)" to="foo_bar(5)" type="man">foo_bar(5)</L></Para></Document>'
+);
+
ok( $x->_out(qq{=pod\n\nL<Net::Ping/Ping-pong>\n}),
'<Document><Para><L content-implicit="yes" raw="Net::Ping/Ping-pong" section="Ping-pong" to="Net::Ping" type="pod">"Ping-pong" in Net::Ping</L></Para></Document>'
);
print "#\n# Test for mixed =item blocks...\n";
-ok( $x->_out("\n=over\n\n=item Foo\n\nStuff\n\n=item 2.\n\nBar I<baz>!\n\nQuux\n\n=item *\n\nThwoong\n\n=back\n\n"),
+ok( $x->_out(
+ sub { $_[0]->no_errata_section(1) }, # We know this will complain
+ "\n=over\n\n=item Foo\n\nStuff\n\n=item 2.\n\nBar I<baz>!\n\nQuux\n\n=item *\n\nThwoong\n\n=back\n\n"),
qq{<Document><over-text indent="4"><item-text>Foo</item-text><Para>Stuff</Para>}
. qq{<item-text>2.</item-text><Para>Bar <I>baz</I>!</Para><Para>Quux</Para>}
. qq{<item-text>*</item-text><Para>Thwoong</Para></over-text></Document>}
-# Testing the =item directive\r
-BEGIN {\r
- if($ENV{PERL_CORE}) {\r
- chdir 't';\r
- @INC = '../lib';\r
- }\r
-}\r
-\r
-use strict;\r
-use Test;\r
-BEGIN { plan tests => 4 };\r
-\r
-my $d;\r
-#use Pod::Simple::Debug (\$d,0);\r
-\r
-ok 1;\r
-\r
-use Pod::Simple::DumpAsXML;\r
-use Pod::Simple::XMLOutStream;\r
-print "# Pod::Simple version $Pod::Simple::VERSION\n";\r
-sub e ($$) { Pod::Simple::DumpAsXML->_duo(@_) }\r
-\r
-my $x = 'Pod::Simple::XMLOutStream';\r
-\r
-print "##### Tests for =item directives via class $x\n";\r
-\r
-$Pod::Simple::XMLOutStream::ATTR_PAD = ' ';\r
-$Pod::Simple::XMLOutStream::SORT_ATTRS = 1; # for predictably testable output\r
-\r
-\r
-print "#\n# Tests for =item [number] that are icky...\n";\r
-ok( $x->_out("\n=over\n\n=item 5\n\nStuff\n\n=cut\n\nCrunk\nZorp\n\n=item 4\n\nQuux\n\n=back\n\n"),\r
- '<Document><over-text indent="4"><item-text>5</item-text><Para>Stuff</Para><item-text>4</item-text><Para>Quux</Para></over-text></Document>'\r
-);\r
-\r
-ok( $x->_out("\n=over\n\n=item 5.\n\nStuff\n\n=cut\n\nCrunk\nZorp\n\n=item 4.\n\nQuux\n\n=back\n\n"),\r
- '<Document><over-text indent="4"><item-text>5.</item-text><Para>Stuff</Para><item-text>4.</item-text><Para>Quux</Para></over-text></Document>'\r
-);\r
-\r
-\r
-print "# Wrapping up... one for the road...\n";\r
-ok 1;\r
-print "# --- Done with ", __FILE__, " --- \n";\r
-\r
+# Testing the =item directive
+BEGIN {
+ if($ENV{PERL_CORE}) {
+ chdir 't';
+ @INC = '../lib';
+ }
+}
+
+use strict;
+use Test;
+BEGIN { plan tests => 4 };
+
+my $d;
+#use Pod::Simple::Debug (\$d,0);
+
+ok 1;
+
+use Pod::Simple::DumpAsXML;
+use Pod::Simple::XMLOutStream;
+print "# Pod::Simple version $Pod::Simple::VERSION\n";
+sub e ($$) { Pod::Simple::DumpAsXML->_duo(@_) }
+
+my $x = 'Pod::Simple::XMLOutStream';
+
+print "##### Tests for =item directives via class $x\n";
+
+$Pod::Simple::XMLOutStream::ATTR_PAD = ' ';
+$Pod::Simple::XMLOutStream::SORT_ATTRS = 1; # for predictably testable output
+
+
+print "#\n# Tests for =item [number] that are icky...\n";
+ok( $x->_out(sub { $_[0]->no_errata_section(1) },
+ "\n=over\n\n=item 5\n\nStuff\n\n=cut\n\nCrunk\nZorp\n\n=item 4\n\nQuux\n\n=back\n\n"),
+ '<Document><over-text indent="4"><item-text>5</item-text><Para>Stuff</Para><item-text>4</item-text><Para>Quux</Para></over-text></Document>'
+);
+
+ok( $x->_out(sub { $_[0]->no_errata_section(1) },
+ "\n=over\n\n=item 5.\n\nStuff\n\n=cut\n\nCrunk\nZorp\n\n=item 4.\n\nQuux\n\n=back\n\n"),
+ '<Document><over-text indent="4"><item-text>5.</item-text><Para>Stuff</Para><item-text>4.</item-text><Para>Quux</Para></over-text></Document>'
+);
+
+
+print "# Wrapping up... one for the road...\n";
+ok 1;
+print "# --- Done with ", __FILE__, " --- \n";
+
use strict;
use Test;
-BEGIN { plan tests => 116 };
+BEGIN { plan tests => 117 };
#use Pod::Simple::Debug (5);
}
###########################################################################
+{
+print "# Testing a title with an X<>, at line ", __LINE__, "\n";
+my $p = Pod::Simple::PullParser->new;
+$p->set_source( \qq{\n=head1 NAME Foo Bar\nX<Some entry>\n} );
+
+ok $p->get_title(), 'NAME Foo Bar';
+}
+
###########################################################################
--- /dev/null
+#!/usr/bin/perl -w
+
+# t/xhtml-bkb.t - https://rt.cpan.org/Public/Bug/Display.html?id=77686
+
+use strict;
+use warnings;
+use Test::More tests => 1;
+use Pod::Simple::XHTML;
+my $c = <<EOF;
+=head1 Documentation
+
+=head2 Changes to Existing Documentation
+
+=head3 L<perldata>
+EOF
+my $d = Pod::Simple::XHTML->new ();
+$d->index (1);
+my $e;
+$d->output_string (\$e);
+$d->parse_string_document ($c);
+unlike ($e, qr!<a[^>]+><a[^>]+>!);
initialize($parser, $results);
$parser->parse_string_document( "=head1 Poit!" );
-is($results, qq{<h1 id="Poit-">Poit!</h1>\n\n}, "head1 level output");
+is($results, qq{<h1 id="Poit">Poit!</h1>\n\n}, "head1 level output");
initialize($parser, $results);
$parser->parse_string_document( "=head2 Yada Yada Operator
is($results, qq{<h2 id="Yada-Yada-Operator">Yada Yada Operator </h2>\n\n}, "head ID with X<>");
initialize($parser, $results);
+$parser->parse_string_document( "=head2 Platforms with no supporting programmers:");
+is($results, qq{<h2 id="Platforms-with-no-supporting-programmers">Platforms with no supporting programmers:</h2>\n\n}, "head ID ending in colon");
+
+initialize($parser, $results);
$parser->html_h_level(2);
$parser->parse_string_document( "=head1 Poit!" );
-is($results, qq{<h2 id="Poit-">Poit!</h2>\n\n}, "head1 level output h_level 2");
+is($results, qq{<h2 id="Poit">Poit!</h2>\n\n}, "head1 level output h_level 2");
initialize($parser, $results);
$parser->parse_string_document( "=head2 I think so Brain." );
-is($results, qq{<h2 id="I-think-so-Brain.">I think so Brain.</h2>\n\n}, "head2 level output");
+is($results, qq{<h2 id="I-think-so-Brain">I think so Brain.</h2>\n\n}, "head2 level output");
initialize($parser, $results);
$parser->parse_string_document( "=head3 I say, Brain..." );
-is($results, qq{<h3 id="I-say-Brain...">I say, Brain...</h3>\n\n}, "head3 level output");
+is($results, qq{<h3 id="I-say-Brain">I say, Brain...</h3>\n\n}, "head3 level output");
initialize($parser, $results);
$parser->parse_string_document( "=head4 Zort & Zog!" );
-is($results, qq{<h4 id="Zort-Zog-">Zort & Zog!</h4>\n\n}, "head4 level output");
+is($results, qq{<h4 id="Zort-Zog">Zort & Zog!</h4>\n\n}, "head4 level output");
sub x ($;&) {
my $code = $_[1];
use strict;
use lib '../lib';
-use Test::More tests => 58;
+use Test::More tests => 60;
#use Test::More 'no_plan';
use_ok('Pod::Simple::XHTML') or exit;
[ 'fo$bar' => 'fo-bar', 'fo-bar' ],
[ 'f12' => 'f12', 'f12' ],
[ '13' => 'pod13', 'pod13' ],
- [ '**.:' => 'pod-.:', 'pod-.:' ],
+ [ '**.:' => 'pod', 'pod' ],
) {
is $parser->idify( $spec->[0] ), $spec->[1],
qq{ID for "$spec->[0]" should be "$spec->[1]"};
<h1 id="Bar">Bar</h1>
EOF
+
+initialize($parser, $results);
+ok $parser->parse_string_document( "=head1 Foo C<Bar>\n\n=head1 C<Baz>" ),
+ 'Parse two headers with C<> formatting';
+is $results, <<'EOF', 'Should have the index';
+<ul id="index">
+ <li><a href="#Foo-Bar">Foo Bar</a></li>
+ <li><a href="#Baz">Baz</a></li>
+</ul>
+
+<h1 id="Foo-Bar">Foo <code>Bar</code></h1>
+
+<h1 id="Baz"><code>Baz</code></h1>
+
+EOF
+
initialize($parser, $results);
ok $parser->parse_string_document( "=head1 Foo\n\n=head1 Bar\n\n=head1 Baz" ),
'Parse three headers';
sub handle_code {
my($self, $code, $kind) = @_;
- $code = "${kind}[$code]";
+ $code = $kind . "[$code]";
$self->SUPER::handle_code($code);
}