Pod-Simple-3.45/0000755000175000017500000000000014430216375011567 5ustar khwkhwPod-Simple-3.45/t/0000755000175000017500000000000014430216375012032 5ustar khwkhwPod-Simple-3.45/t/fcodes_l.t0000644000175000017500000006415514243763554014020 0ustar khwkhw# fcodes L use strict; use warnings; use Test::More tests => 99; BEGIN { require FindBin; unshift @INC, $FindBin::Bin . '/lib'; } use helpers; #use Pod::Simple::Debug (10); use Pod::Simple::DumpAsXML; use Pod::Simple::XMLOutStream; print "# Pod::Simple version $Pod::Simple::VERSION\n"; my $x = 'Pod::Simple::XMLOutStream'; print "##### Testing L codes via x class $x...\n"; $Pod::Simple::XMLOutStream::ATTR_PAD = ' '; $Pod::Simple::XMLOutStream::SORT_ATTRS = 1; # for predictably testable output print "# Simple/moderate L tests...\n"; is($x->_out(qq{=pod\n\nL\n}), 'Net::Ping' ); is($x->_out(qq{=pod\n\nL\n}), 'crontab(5)' ); is($x->_out(qq{=pod\n\nL\n}), 'login.conf(5)' ); is($x->_out(qq{=pod\n\nL\n}), 'foo_bar(5)' ); is( $x->_out(qq{=pod\n\nL\n}), '"Ping-pong" in Net::Ping' ); is( $x->_out(qq{=pod\n\nL\n}), '"Ping-pong" in Net::Ping' ); is( $x->_out(qq{=pod\n\nL\n}), '"Object Methods"' ); is( $x->_out(qq{=pod\n\nL\n}), '"Object Methods"' ); is( $x->_out(qq{=pod\n\nL<"Object Methods">\n}), '"Object Methods"' ); print "# Complex L tests...\n"; print "# Ents in the middle...\n"; is($x->_out(qq{=pod\n\nL\n}), 'Net::Ping' ); is( $x->_out(qq{=pod\n\nLong>\n}), '"Ping-pong" in Net::Ping' ); is( $x->_out(qq{=pod\n\nLong">\n}), '"Ping-pong" in Net::Ping' ); is( $x->_out(qq{=pod\n\nLethods">\n}), '"Object Methods"' ); is( $x->_out(qq{=pod\n\nLethods>\n}), '"Object Methods"' ); is( $x->_out(qq{=pod\n\nL<"Object E<77>ethods">\n}), '"Object Methods"' ); print "# Ents in the middle and at the start...\n"; is($x->_out(qq{=pod\n\nLet::Ping>\n}), 'Net::Ping' ); is( $x->_out(qq{=pod\n\nLet::Ping/Ping-E<112>ong>\n}), '"Ping-pong" in Net::Ping' ); is( $x->_out(qq{=pod\n\nLet::Ping/"Ping-E<112>ong">\n}), '"Ping-pong" in Net::Ping' ); is( $x->_out(qq{=pod\n\nLbject E<77>ethods">\n}), '"Object Methods"' ); is( $x->_out(qq{=pod\n\nLbject E<77>ethods>\n}), '"Object Methods"' ); is( $x->_out(qq{=pod\n\nL<"E<79>bject E<77>ethods">\n}), '"Object Methods"' ); print "# Ents in the middle and at the start and at the end...\n"; is($x->_out(qq{=pod\n\nLet::PinE<103>>\n}), 'Net::Ping' ); is( $x->_out(qq{=pod\n\nLet::PinE<103>/Ping-E<112>onE<103>>\n}), '"Ping-pong" in Net::Ping' ); is( $x->_out(qq{=pod\n\nLet::PinE<103>/"Ping-E<112>onE<103>">\n}), '"Ping-pong" in Net::Ping' ); is( $x->_out(qq{=pod\n\nLbject E<77>ethodE<115>">\n}), '"Object Methods"' ); is( $x->_out(qq{=pod\n\nLbject E<77>ethodE<115>>\n}), '"Object Methods"' ); is( $x->_out(qq{=pod\n\nL<"E<79>bject E<77>ethodE<115>">\n}), '"Object Methods"' ); print "# Even more complex L tests...\n"; print "# Ents in the middle...\n"; is($x->_out(qq{=pod\n\nL\n}), 'Net::Ping' ); is( $x->_out(qq{=pod\n\nLong>\n}), '"Ping-pong" in Net::Ping' ); is( $x->_out(qq{=pod\n\nLong">\n}), '"Ping-pong" in Net::Ping' ); is( $x->_out(qq{=pod\n\nLethods">\n}), '"Object Methods"' ); is( $x->_out(qq{=pod\n\nLethods>\n}), '"Object Methods"' ); is( $x->_out(qq{=pod\n\nL<"Object E<77>ethods">\n}), '"Object Methods"' ); ########################################################################### print "# VERY complex L sequences...\n"; print "# Ents in the middle and at the start...\n"; is($x->_out(qq{=pod\n\nL\n}), 'Net::Ping' ); is( $x->_out(qq{=pod\n\nLong>>\n}), '"Ping-pong" in Net::Ping' ); is( $x->_out(qq{=pod\n\nLong>">\n}), '"Ping-pong" in Net::Ping' ); is( $x->_out(qq{=pod\n\nL E<77>ethods">\n}), '"Object Methods"' ); is( $x->_out(qq{=pod\n\nL E<77>ethods>\n}), '"Object Methods"' ); is( $x->_out(qq{=pod\n\nL<"B E<77>ethods">\n}), '"Object Methods"' ); print "# Ents in the middle and at the start...\n"; is($x->_out(qq{=pod\n\nLet::Ping>\n}), 'Net::Ping' ); is( $x->_out(qq{=pod\n\nLet::Ping/Ping-Bong>>\n}), '"Ping-pong" in Net::Ping' ); is( $x->_out(qq{=pod\n\nLet::Ping/"Ping-Bong>">\n}), '"Ping-pong" in Net::Ping' ); is( $x->_out(qq{=pod\n\nLbject> E<77>ethods">\n}), '"Object Methods"' ); is( $x->_out(qq{=pod\n\nLbject> E<77>ethods>\n}), '"Object Methods"' ); is( $x->_out(qq{=pod\n\nL<"Bbject> E<77>ethods">\n}), '"Object Methods"' ); print "# Ents in the middle and at the start and at the end...\n"; is($x->_out(qq{=pod\n\nLet::PinE<103>>\n}), 'Net::Ping' ); is( $x->_out(qq{=pod\n\nLet::PinE<103>/Ping-BonE<103>>>\n}), '"Ping-pong" in Net::Ping' ); is( $x->_out(qq{=pod\n\nLet::PinE<103>/"Ping-BonE<103>>">\n}), '"Ping-pong" in Net::Ping' ); is( $x->_out(qq{=pod\n\nLbject> E<77>ethodE<115>">\n}), '"Object Methods"' ); is( $x->_out(qq{=pod\n\nLbject> E<77>ethodE<115>>\n}), '"Object Methods"' ); is( $x->_out(qq{=pod\n\nL<"Bbject> E<77>ethodE<115>">\n}), '"Object Methods"' ); ########################################################################### print "#\n# L tests...\n"; is( $x->_out(qq{=pod\n\nL\n}), 'news:comp.lang.perl.misc' ); is( $x->_out(qq{=pod\n\nL\n}), 'http://www.perl.com' ); is( $x->_out(qq{=pod\n\nL\n}), 'http://www.perl.com/CPAN/authors/id/S/SB/SBURKE/' ); print "# L tests with entities...\n"; is( $x->_out(qq{=pod\n\nLlang.perl.misc>\n}), 'news:comp.lang.perl.misc' ); is( $x->_out(qq{=pod\n\nLperl.com>\n}), 'http://www.perl.com' ); is( $x->_out(qq{=pod\n\nLperl.com/CPAN/authors/id/S/SB/SBURKE/>\n}), 'http://www.perl.com/CPAN/authors/id/S/SB/SBURKE/' ); is( $x->_out(qq{=pod\n\nLperl.com/CPAN/authors/id/S/SB/SBURKEE<47>>\n}), 'http://www.perl.com/CPAN/authors/id/S/SB/SBURKE/' ); ########################################################################### print "# L tests...\n"; is($x->_out(qq{=pod\n\nL\n}), 'things' ); is($x->_out(qq{=pod\n\nL\n}), 'things' ); is($x->_out(qq{=pod\n\nL\n}), 'things' ); is( $x->_out(qq{=pod\n\nL\n}), 'Perl Error Messages' ); is( $x->_out(qq{=pod\n\nL\n}), 'Perl Error Messages' ); is( $x->_out(qq{=pod\n\nL\n}), 'Perl Error Messages' ); is( $x->_out(qq{=pod\n\nL\n}), 'SWITCH statements' ); is( $x->_out(qq{=pod\n\nL\n}), 'SWITCH statements' ); is( $x->_out(qq{=pod\n\nL\n}), 'the various attributes' ); is( $x->_out(qq{=pod\n\nL\n}), 'the various attributes' ); is( $x->_out(qq{=pod\n\nL\n}), 'the various attributes' ); print "#\n# Now some very complex L tests...\n"; is( $x->_out(qq{=pod\n\nLessages>|perldiag>\n}), 'Perl Error Messages' ); is( $x->_out(qq{=pod\n\nLessages>|perldiag>\n}), 'Perl Error Messages' ); is( $x->_out(qq{=pod\n\nLessages>|perldiag>\n}), 'Perl Error Messages' ); is( $x->_out(qq{=pod\n\nLtatements>|perlsyn/"Basic I and Switch StatementE<115>">\n}), 'SWITCH statements' ); is( $x->_out(qq{=pod\n\nLtatements>|perlsyn/Basic I and Switch StatementE<115>>\n}), 'SWITCH statements' ); is( $x->_out(qq{=pod\n\nL attributes|/"Member Data">\n}), 'the various attributes' ); is( $x->_out(qq{=pod\n\nL attributes|/Member Data>\n}), 'the various attributes' ); is( $x->_out(qq{=pod\n\nL attributes|"Member Data">\n}), 'the various attributes' ); print "#\n# Now some very complex L tests with variant syntax...\n"; is( $x->_out(qq{=pod\n\nL<< Perl B<<< Error E<77>essages >>>|perldiag >>\n}), 'Perl Error Messages' ); is( $x->_out(qq{=pod\n\nL<< Perl\nB<<< Error\nE<77>essages >>>|perldiag >>\n}), 'Perl Error Messages' ); is( $x->_out(qq{=pod\n\nL<< Perl\nB<<< Error\t E<77>essages >>>|perldiag >>\n}), 'Perl Error Messages' ); is( $x->_out(qq{=pod\n\nL<< SWITCH B<<< E<115>tatements >>>|perlsyn/"Basic I<<<< BLOCKs >>>> and Switch StatementE<115>" >>\n}), 'SWITCH statements' ); is( $x->_out(qq{=pod\n\nL<< SWITCH B<<< E<115>tatements >>>|perlsyn/Basic I<<<< BLOCKs >>>> and Switch StatementE<115> >>\n}), 'SWITCH statements' ); is( $x->_out(qq{=pod\n\nL<<< the F<< various >> attributes|/"Member Data" >>>\n}), 'the various attributes' ); is( $x->_out(qq{=pod\n\nL<<< the F<< various >> attributes|/Member Data >>>\n}), 'the various attributes' ); is( $x->_out(qq{=pod\n\nL<<< the F<< various >> attributes|"Member Data" >>>\n}), 'the various attributes' ); ########################################################################### print "#\n# Now some very complex L tests with variant syntax and text around it...\n"; is( $x->_out(qq{=pod\n\nI like L<< Perl B<<< Error E<77>essages >>>|perldiag >>.\n}), 'I like Perl Error Messages.' ); is( $x->_out(qq{=pod\n\nI like L<< Perl\nB<<< Error\nE<77>essages >>>|perldiag >>.\n}), 'I like Perl Error Messages.' ); is( $x->_out(qq{=pod\n\nI like L<< Perl\nB<<< Error\t E<77>essages >>>|perldiag >>.\n}), 'I like Perl Error Messages.' ); is( $x->_out(qq{=pod\n\nI like L<< SWITCH B<<< E<115>tatements >>>|perlsyn/"Basic I<<<< BLOCKs >>>> and Switch StatementE<115>" >>.\n}), 'I like SWITCH statements.' ); is( $x->_out(qq{=pod\n\nI like L<< SWITCH B<<< E<115>tatements >>>|perlsyn/Basic I<<<< BLOCKs >>>> and Switch StatementE<115> >>.\n}), 'I like SWITCH statements.' ); is( $x->_out(qq{=pod\n\nI like L<<< the F<< various >> attributes|/"Member Data" >>>.\n}), 'I like the various attributes.' ); is( $x->_out(qq{=pod\n\nI like L<<< the F<< various >> attributes|/Member Data >>>.\n}), 'I like the various attributes.' ); is( $x->_out(qq{=pod\n\nI like L<<< the F<< various >> attributes|"Member Data" >>>.\n}), 'I like the various attributes.' ); is( $x->_out(qq{=pod\n\nI like L<<< Bs|http://text.com >>>.\n}), 'I like texts.' ); is( $x->_out(qq{=pod\n\nI like L<<< text|https://text.com/1/2 >>>.\n}), 'I like text.' ); is( $x->_out(qq{=pod\n\nI like L<<< I|http://text.com >>>.\n}), 'I like text.' ); is( $x->_out(qq{=pod\n\nI like L<<< C|http://text.com >>>.\n}), 'I like text.' ); is( $x->_out(qq{=pod\n\nI like L<<< I>>>|mailto:earlE<64>text.com >>>.\n}), 'I like text.' ); is( $x->_out(qq{=pod\n\nI like L<<< textZ<>|http://text.com >>>.\n}), 'I like text.' ); # # TODO: S testing. # Pod-Simple-3.45/t/JustPod_corpus.t0000644000175000017500000001034314362364651015210 0ustar khwkhw# Testing Pod::Simple::JustPod against *.pod in /t use strict; use warnings; BEGIN { use Config; if ($Config::Config{'extensions'} !~ /\bEncode\b/) { print "1..0 # Skip: Encode was not built\n"; exit 0; } } use File::Find; use File::Spec; use Test::More; use Pod::Simple::JustPod; my @test_files; BEGIN { my $test_dir = File::Basename::dirname(Cwd::abs_path(__FILE__)); print "# TESTDIR: $test_dir\n"; sub wanted { push @test_files, $File::Find::name if $File::Find::name =~ /\.pod$/ && $File::Find::name !~ /temp/; # ignore any files named temp, # a different test file may have # created it } find(\&wanted , $test_dir ); plan tests => scalar @test_files; } @test_files = sort @test_files; my @skip_on_windows = qw{ corpus/8859_7.pod corpus/laozi38p.pod junk2.pod perlcyg.pod perlfaq.pod perlvar.pod search60/A/x.pod search60/B/X.pod testlib1/hinkhonk/Glunk.pod testlib1/pod/perlflif.pod testlib1/pod/perlthng.pod testlib1/squaa/Glunk.pod testlib1/zikzik.pod testlib2/hinkhonk/Glunk.pod testlib2/pod/perlthng.pod testlib2/pod/perlzuk.pod testlib2/pods/perlzoned.pod testlib2/squaa/Wowo.pod }; my $is_windows = $^O eq 'MSWin32'; foreach my $file (@test_files) { SKIP: { if ( $is_windows ) { my $check_path = join '/', File::Spec->splitdir($file); if (grep { $check_path =~ m{/\Q$_\E\z} } @skip_on_windows ) { skip "$file needs investigation on windows", 1; } } my $parser = Pod::Simple::JustPod->new(); $parser->complain_stderr(0); my $input; open( IN , '<:raw' , $file ) or die "$file: $!"; $input .= $_ while (); close( IN ); my $output; $parser->output_string( \$output ); $parser->parse_string_document( $input ); if ($parser->any_errata_seen()) { pass("Skip '$file' because of pod errors"); next if "$]" lt '5.010.001'; # note() not found in earlier versions my $errata = $parser->errata_seen(); foreach my $line_number (sort { $a <=> $b } keys %$errata) { foreach my $err_msg (sort @{$errata->{$line_number}}) { note("$file: $line_number: $err_msg"); } } next; } my $encoding = $parser->encoding(); if (defined $encoding) { eval { require Encode; }; $input = Encode::decode($parser->encoding(), $input); } my @input = split "\n", $input; my $stripped_input = ""; while (defined ($_ = shift @input)) { if (/ ^ = [a-z]+ /x) { my $line = "$_\n"; if ($stripped_input eq "" || $_ !~ /^=pod/) { $stripped_input .= $line; } while (defined ($_ = shift @input)) { $stripped_input .= "$_\n"; last if / ^ =cut /x; } } } $stripped_input =~ s/ ^ =cut \n (.) /$1/mgx; $input = $stripped_input if $stripped_input ne ""; if ($input !~ / ^ =pod /x) { $input =~ s/ ^ \s+ //x; $input = "=pod\n\n$input"; } if ($input !~ / =cut $ /x) { $input =~ s/ \s+ $ //x; $input .= "\n\n=cut\n"; } my $msg = "got expected output for $file"; if ($output eq $input) { pass($msg); } elsif ($ENV{PERL_TEST_DIFF}) { fail($msg); require File::Temp; my $orig_file = File::Temp->new(); local $/ = "\n"; chomp $input; print $orig_file $input, "\n"; close $orig_file || die "Can't close orig_file: $!"; chomp $output; my $parsed_file = File::Temp->new(); print $parsed_file $output, "\n"; close $parsed_file || die "Can't close parsed_file"; my $diff = File::Temp->new(); system("$ENV{PERL_TEST_DIFF} $orig_file $parsed_file > $diff"); open my $fh, "<", $diff || die "Can't open $diff"; my @diffs = <$fh>; diag(@diffs); } else { eval { require Text::Diff; }; if ($@) { is($output, $input, $msg); diag("Set environment variable PERL_TEST_DIFF=diff_tool or install" . " Text::Diff to see just the differences."); } else { fail($msg); diag Text::Diff::diff(\$input, \$output, { STYLE => 'Unified' }); } } } } Pod-Simple-3.45/t/linkclas.t0000644000175000017500000000244714243763554014036 0ustar khwkhw# Testing the LinkSection class ### Test the basic sanity of the link-section treelet class use strict; use warnings; use Test::More tests => 6; #use Pod::Simple::Debug (6); use Pod::Simple::LinkSection; use Pod::Simple::BlackBox; # for its pretty() my $bare_treelet = ['B', {'pie' => 'no'}, 'a', ['C', {'bzrok' => 'plip'}, 'b' ], 'c' ] ; my $treelet = Pod::Simple::LinkSection->new($bare_treelet); # Make sure they're not the same is ref($bare_treelet), 'ARRAY'; is ref($treelet), 'Pod::Simple::LinkSection'; print "# Testing stringification...\n"; is $treelet->stringify, 'abc'; # explicit is join('', $treelet), 'abc'; # implicit print "# Testing non-coreferentiality...\n"; { my @stack = ($bare_treelet); my $this; while(@stack) { $this = shift @stack; if(ref($this || '') eq 'ARRAY') { push @stack, splice @$this; push @$this, ("BAD!") x 3; } elsif(ref($this || '') eq 'Pod::Simple::LinkSection') { push @stack, splice @$this; push @$this, ("BAD!") x 3; } elsif(ref($this || '') eq 'HASH') { %$this = (); } } # These will fail if $treelet and $bare_treelet are coreferential, # since we just conspicuously nuked $bare_treelet is $treelet->stringify, 'abc'; # explicit is join('', $treelet), 'abc'; # implicit } Pod-Simple-3.45/t/search12.t0000644000175000017500000000352214243763554013641 0ustar khwkhwuse strict; use warnings; use Test::More tests => 9; use Pod::Simple::Search; print "# ", __FILE__, ": Testing the surveying of the current directory...\n"; my $x = Pod::Simple::Search->new; die "Couldn't make an object!?" unless ok defined $x; $x->inc(0); use File::Spec; use Cwd (); use File::Basename (); my $t_dir = File::Basename::dirname(Cwd::abs_path(__FILE__)); my $here = File::Spec->catdir($t_dir, 'testlib1'); print "# OK, found the test corpus as $here\n"; print $x->_state_as_string; #$x->verbose(12); use Pod::Simple; *pretty = \&Pod::Simple::BlackBox::pretty; my($name2where, $where2name) = $x->survey($here); my $p = pretty( $where2name, $name2where )."\n"; $p =~ s/, +/,\n/g; $p =~ s/^/# /mg; print $p; require File::Spec->catfile($t_dir, 'ascii_order.pl'); { my $names = join "|", sort ascii_order values %$where2name; is $names, "Blorm|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Vliff|perlflif|perlthng|squaa|squaa::Glunk|squaa::Vliff|zikzik"; } { my $names = join "|", sort ascii_order keys %$name2where; is $names, "Blorm|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Vliff|perlflif|perlthng|squaa|squaa::Glunk|squaa::Vliff|zikzik"; } like( ($name2where->{'squaa'} || 'huh???'), qr/squaa\.pm$/); is grep( m/squaa\.pm/, keys %$where2name ), 1; ###### Now with recurse(0) print "# Testing the surveying of a subdirectory with recursing off...\n"; $x->recurse(0); ($name2where, $where2name) = $x->survey( File::Spec->catdir($t_dir, 'testlib2')); $p = pretty( $where2name, $name2where )."\n"; $p =~ s/, +/,\n/g; $p =~ s/^/# /mg; print $p; { my $names = lc join "|", sort ascii_order values %$where2name; is $names, "suzzle"; } { my $names = lc join "|", sort ascii_order keys %$name2where; is $names, "suzzle"; } is( ($name2where->{'Vliff'} || 'huh???'), 'huh???'); is grep( m/Vliff\.pm/, keys %$where2name ), 0; Pod-Simple-3.45/t/reinit.t0000644000175000017500000000317114243763543013521 0ustar khwkhwuse strict; use warnings; use Test::More tests => 5; use File::Spec; use Cwd (); use File::Basename (); use Pod::Simple::Text; $Pod::Simple::Text::FREAKYMODE = 1; my $parser = Pod::Simple::Text->new(); foreach my $file ( "junk1.pod", "junk2.pod", "perlcyg.pod", "perlfaq.pod", "perlvar.pod", ) { my $full_file = File::Spec->catfile(File::Basename::dirname(Cwd::abs_path(__FILE__)), $file); unless(-e $full_file) { ok 0; print "# But $full_file doesn't exist!!\n"; next; } my $precooked = $full_file; my $outstring; my $compstring; $precooked =~ s<\.pod>s; $parser->reinit; $parser->output_string(\$outstring); $parser->parse_file($full_file); open(IN, $precooked) or die "Can't read-open $precooked: $!"; { local $/; $compstring = ; } close(IN); for ($outstring,$compstring) { s/\s+/ /g; s/^\s+//s; s/\s+$//s; } if($outstring eq $compstring) { ok 1; next; } elsif( do{ for ($outstring, $compstring) { tr/ //d; }; $outstring eq $compstring; }){ print "# Differ only in whitespace.\n"; ok 1; next; } else { my $x = $outstring ^ $compstring; $x =~ m/^(\x00*)/s or die; my $at = length($1); print "# Difference at byte $at...\n"; if($at > 10) { $at -= 5; } { print "# ", substr($outstring,$at,20), "\n"; print "# ", substr($compstring,$at,20), "\n"; print "# ^..."; } ok 0; printf "# Unequal lengths %s and %s\n", length($outstring), length($compstring); next; } } Pod-Simple-3.45/t/search05.t0000644000175000017500000000153314243763554013643 0ustar khwkhwuse strict; use warnings; use Pod::Simple::Search; use Test::More tests => 15; print "# Some basic sanity tests...\n"; my $x = Pod::Simple::Search->new; die "Couldn't make an object!?" unless ok defined $x; print "# New object: $x\n"; print "# Version: ", $x->VERSION, "\n"; ok defined $x->can('callback'); ok defined $x->can('dir_prefix'); ok defined $x->can('inc'); ok defined $x->can('laborious'); ok defined $x->can('limit_glob'); ok defined $x->can('limit_re'); ok defined $x->can('recurse'); ok defined $x->can('shadows'); ok defined $x->can('verbose'); ok defined $x->can('survey'); ok defined $x->can('_state_as_string'); ok defined $x->can('contains_pod'); ok defined $x->can('find'); ok defined $x->can('simplify_name'); print "# Testing state dumping...\n"; print $x->_state_as_string; $x->inc("I\nLike Pie!\t!!"); print $x->_state_as_string; Pod-Simple-3.45/t/search10.t0000644000175000017500000000353414243763561013640 0ustar khwkhwuse strict; use warnings; use Test::More tests => 9; #sub Pod::Simple::Search::DEBUG () {5}; use Pod::Simple::Search; print "# ", __FILE__, ": Testing the surveying of a single specified docroot...\n"; my $x = Pod::Simple::Search->new; die "Couldn't make an object!?" unless ok defined $x; $x->inc(0); use File::Spec; use Cwd (); use File::Basename (); my $t_dir = File::Basename::dirname(Cwd::abs_path(__FILE__)); my $here = File::Spec->catdir($t_dir, 'testlib1'); print "# OK, found the test corpus as $here\n"; print $x->_state_as_string; #$x->verbose(12); use Pod::Simple; *pretty = \&Pod::Simple::BlackBox::pretty; my($name2where, $where2name) = $x->survey($here); my $p = pretty( $where2name, $name2where )."\n"; $p =~ s/, +/,\n/g; $p =~ s/^/# /mg; print $p; require File::Spec->catfile($t_dir, 'ascii_order.pl'); { my $names = join "|", sort ascii_order values %$where2name; is $names, "Blorm|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Vliff|perlflif|perlthng|squaa|squaa::Glunk|squaa::Vliff|zikzik"; } { my $names = join "|", sort ascii_order keys %$name2where; is $names, "Blorm|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Vliff|perlflif|perlthng|squaa|squaa::Glunk|squaa::Vliff|zikzik"; } like( ($name2where->{'squaa'} || 'huh???'), qr/squaa\.pm$/); is grep( m/squaa\.pm/, keys %$where2name ), 1; ###### Now with recurse(0) print "# Testing the surveying of a single docroot without recursing...\n"; $x->recurse(0); ($name2where, $where2name) = $x->survey($here); $p = pretty( $where2name, $name2where )."\n"; $p =~ s/, +/,\n/g; $p =~ s/^/# /mg; print $p; { my $names = join "|", sort ascii_order values %$where2name; is $names, "Blorm|squaa|zikzik"; } { my $names = join "|", sort ascii_order keys %$name2where; is $names, "Blorm|squaa|zikzik"; } like( ($name2where->{'squaa'} || 'huh???'), qr/squaa\.pm$/); is grep( m/squaa\.pm/, keys %$where2name ), 1; Pod-Simple-3.45/t/testlib1/0000755000175000017500000000000014430216375013561 5ustar khwkhwPod-Simple-3.45/t/testlib1/zikzik.pod0000644000175000017500000000012714243754136015604 0ustar khwkhw=head1 NAME zikzik -- blorpoesu =head1 DESCRIPTION This is just a test file. =cut Pod-Simple-3.45/t/testlib1/squaa.pm0000644000175000017500000000014614243754136015236 0ustar khwkhwpackage squaa; =head1 NAME squaa -- blorpoesu =head1 DESCRIPTION This is just a test file. =cut Pod-Simple-3.45/t/testlib1/hinkhonk/0000755000175000017500000000000014430216375015372 5ustar khwkhwPod-Simple-3.45/t/testlib1/hinkhonk/Vliff.pm0000644000175000017500000000016514243754137017005 0ustar khwkhw =head1 NAME squaa::Vliff -- blorpoesu =head1 DESCRIPTION This is just a test file. =cut print "HOOBOY!\n"; 1; Pod-Simple-3.45/t/testlib1/hinkhonk/readme.txt0000644000175000017500000000005014243754137017370 0ustar khwkhwThis directory should never be scanned. Pod-Simple-3.45/t/testlib1/hinkhonk/Glunk.pod0000644000175000017500000000013614243754137017163 0ustar khwkhw =head1 NAME squaa::Glunk -- blorpoesu =head1 DESCRIPTION This is just a test file. =cut Pod-Simple-3.45/t/testlib1/squaa/0000755000175000017500000000000014430216375014673 5ustar khwkhwPod-Simple-3.45/t/testlib1/squaa/Vliff.pm0000644000175000017500000000016514243754137016306 0ustar khwkhw =head1 NAME squaa::Vliff -- blorpoesu =head1 DESCRIPTION This is just a test file. =cut print "HOOBOY!\n"; 1; Pod-Simple-3.45/t/testlib1/squaa/Glunk.pod0000644000175000017500000000013614243754137016464 0ustar khwkhw =head1 NAME squaa::Glunk -- blorpoesu =head1 DESCRIPTION This is just a test file. =cut Pod-Simple-3.45/t/testlib1/pod/0000755000175000017500000000000014430216375014343 5ustar khwkhwPod-Simple-3.45/t/testlib1/pod/perlthng.pod0000644000175000017500000000007514243754136016700 0ustar khwkhw =head1 NAME perlthang - This is just some test file =cut Pod-Simple-3.45/t/testlib1/pod/perlflif.pod0000644000175000017500000000007514243754136016660 0ustar khwkhw =head1 NAME perlthang - This is just some test file =cut Pod-Simple-3.45/t/testlib1/Blorm.pm0000644000175000017500000000012614243754137015176 0ustar khwkhw=head1 NAME Blorm -- blorpoesu =head1 DESCRIPTION This is just a test file. =cut Pod-Simple-3.45/t/testlib1/Zonk/0000755000175000017500000000000014430216375014502 5ustar khwkhwPod-Simple-3.45/t/testlib1/Zonk/Fiddle.txt0000644000175000017500000000012314243754136016432 0ustar khwkhw This is just a dummy file. It's podless and shouldn't even be scanned for pod. Pod-Simple-3.45/t/testlib1/Zonk/Veng.pm0000644000175000017500000000005114243754136015737 0ustar khwkhw # This is just a podless test file. 1; Pod-Simple-3.45/t/testlib1/Zonk/Pronk.pm0000644000175000017500000000243614243754136016142 0ustar khwkhw =head1 NAME Zonk::Pronk -- blorpoesu =head1 DESCRIPTION This is just a test file. This is a test Pod document in Latin-1. Its content is the last two paragraphs of Baudelaire's I. A travers ces barreaux symboliques séparant deux mondes, la grande route et le château, l'enfant pauvre montrait à l'enfant riche son propre joujou, que celui-ci examinait avidement comme un objet rare et inconnu. Or, ce joujou, que le petit souillon agaçait, agitait et secouait dans une boîte grillée, c'était un rat vivantE<160>! Les parents, par économie sans doute, avaient tiré le joujou de la vie elle-même. Et les deux enfants se riaient l'un à l'autre fraternellement, avec des dents d'une I<égale> blancheur. =head2 As Verbatim A travers ces barreaux symboliques séparant deux mondes, la grande route et le château, l'enfant pauvre montrait à l'enfant riche son propre joujou, que celui-ci examinait avidement comme un objet rare et inconnu. Or, ce joujou, que le petit souillon agaçait, agitait et secouait dans une boîte grillée, c'était un rat vivant ! Les parents, par économie sans doute, avaient tiré le joujou de la vie elle-même. Et les deux enfants se riaient l'un à l'autre fraternellement, avec des dents d'une égale blancheur. [end] =cut print "HOOBOY!\n"; 1; Pod-Simple-3.45/t/accept05.t0000644000175000017500000001107014243763554013632 0ustar khwkhw# Testing extend and accept_codes use strict; use warnings; use Test::More tests => 22; #use Pod::Simple::Debug (2); use Pod::Simple::DumpAsXML; use Pod::Simple::XMLOutStream; print "# Pod::Simple version $Pod::Simple::VERSION\n"; BEGIN { require FindBin; unshift @INC, $FindBin::Bin . '/lib'; } use helpers; my $x = 'Pod::Simple::XMLOutStream'; sub accept_Q { $_[0]->accept_codes('Q') } sub accept_prok { $_[0]->accept_codes('prok') } sub accept_zing_prok { $_[0]->accept_codes('zing:prok') } sub accept_zing_superprok { $_[0]->accept_codes('z.i_ng:Prok-12') } sub accept_zing_superduperprok { $_[0]->accept_codes('A'); $_[0]->accept_codes('z.i_ng:Prok-12'); } #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ print "# Some sanity tests...\n"; is( $x->_out( "=pod\n\nI like pie.\n"), 'I like pie.' ); is( $x->_out( "=extend N C Y,W\n\nI like pie.\n"), 'I like pie.' ); is( $x->_out( "=extend N C,F Y,W\n\nI like pie.\n"), 'I like pie.' ); is( $x->_out( "=extend N C,F,I Y,W\n\nI like pie.\n"), 'I like pie.' ); #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ print "## OK, actually trying to use an extended code...\n"; print "# extending but not accepted (so hitting fallback)\n"; is( $x->_out( "=extend N B Y,W\n\nI N pie.\n"), 'I like pie.' ); is( $x->_out( "=extend N B,I Y,W\n\nI N pie.\n"), 'I like pie.' ); is( $x->_out( "=extend N C,B,I Y,W\n\nI N pie.\n"), 'I like pie.' ); print "# extending to one-letter accepted (not hitting fallback)\n"; is( $x->_out( \&accept_Q, "=extend N B Y,Q,A,bzroch\n\nI N pie.\n"), 'I like pie.' ); is( $x->_out( \&accept_Q, "=extend N B,I Y,Q,A,bzroch\n\nI N pie.\n"), 'I like pie.' ); is( $x->_out( \&accept_Q, "=extend N C,B,I Y,Q,A,bzroch\n\nI N pie.\n"), 'I like pie.' ); print "# extending to many-letter accepted (not hitting fallback)\n"; is( $x->_out( \&accept_prok, "=extend N B Y,prok,A,bzroch\n\nI N pie.\n"), 'I like pie.' ); is( $x->_out( \&accept_prok, "=extend N B,I Y,prok,A,bzroch\n\nI N pie.\n"), 'I like pie.' ); is( $x->_out( \&accept_prok, "=extend N C,B,I Y,prok,A,bzroch\n\nI N pie.\n"), 'I like pie.' ); print "# extending to :-containing, many-letter accepted (not hitting fallback)\n"; is( $x->_out( \&accept_zing_prok, "=extend N B Y,zing:prok,A,bzroch\n\nI N pie.\n"), 'I like pie.' ); is( $x->_out( \&accept_zing_prok, "=extend N B,I Y,zing:prok,A,bzroch\n\nI N pie.\n"), 'I like pie.' ); is( $x->_out( \&accept_zing_prok, "=extend N C,B,I Y,zing:prok,A,bzroch\n\nI N pie.\n"), 'I like pie.' ); print "# extending to _:-0-9-containing, many-letter accepted (not hitting fallback)\n"; is( $x->_out( \&accept_zing_superprok, "=extend N B Y,z.i_ng:Prok-12,A,bzroch\n\nI N pie.\n"), 'I like pie.' ); is( $x->_out( \&accept_zing_superprok, "=extend N B,I Y,z.i_ng:Prok-12,A,bzroch\n\nI N pie.\n"), 'I like pie.' ); is( $x->_out( \&accept_zing_superprok, "=extend N C,B,I Y,z.i_ng:Prok-12,A,bzroch\n\nI N pie.\n"), 'I like pie.' ); print "#\n# Testing acceptance order\n"; is( $x->_out( \&accept_zing_superduperprok, "=extend N B Y,z.i_ng:Prok-12,A,bzroch\n\nI N pie.\n"), 'I like pie.' ); is( $x->_out( \&accept_zing_superduperprok, "=extend N B,I Y,z.i_ng:Prok-12,A,bzroch\n\nI N pie.\n"), 'I like pie.' ); is( $x->_out( \&accept_zing_superduperprok, "=extend N C,B,I Y,z.i_ng:Prok-12,A,bzroch\n\nI N pie.\n"), 'I like pie.' ); Pod-Simple-3.45/t/whine.t0000644000175000017500000000333014243754136013334 0ustar khwkhwuse strict; use warnings; use Test::More tests => 6; { package Pod::Simple::ErrorFinder; use base 'Pod::Simple::DumpAsXML'; # arbitrary choice -- rjbs, 2013-04-16 sub errors_for_input { my ($class, $input, $mutor) = @_; my $parser = $class->new; my $output = ''; $parser->output_string( \$output ); $parser->no_errata_section(1); $parser->parse_string_document( $input ); return $parser->errata_seen(); } } sub errors { Pod::Simple::ErrorFinder->errors_for_input(@_) } { my $errors = errors("=over 4\n\n=item 1\n\nHey\n\n"); is_deeply( $errors, { 1 => [ "=over without closing =back" ] }, "no closing =back", ); } { for my $l_code ('L< foo>', 'L< bar>') { my $input = "=pod\n\nAmbiguous space: $l_code\n"; my $errors = errors("$input"); is_deeply( $errors, { 3 => [ "L<> starts or ends with whitespace" ] }, "warning for space in $l_code", ); } } { my $input = "=pod\n\nAmbiguous slash: L\n"; my $errors = errors("$input"); is_deeply( $errors, { 3 => [ "alternative text 'I/O Operators' contains non-escaped | or /" ] }, "warning for / in text part of L<>", ); } { my $input = "=pod\n\nnested LEEE: L|http://baz>\n"; my $errors = errors("$input"); is_deeply( $errors, { 3 => [ "Nested L<> are illegal. Pretending inner one is X<...> so can continue looking for other errors." ] }, "warning for nested L<>", ); } { my $input = "=pod\n\nLEEE containing only slash: L< / >\n"; my $errors = errors("$input"); is_deeply( $errors, { 3 => [ "L<> contains only '/'" ] }, "warning for L< / > containing only a slash", ); } Pod-Simple-3.45/t/verbatim.t0000644000175000017500000001712014243763554014041 0ustar khwkhw# Testing verbatim sections use strict; use warnings; use Test::More tests => 29; #use Pod::Simple::Debug (6); use Pod::Simple::DumpAsXML; use Pod::Simple::XMLOutStream; print "# Pod::Simple version $Pod::Simple::VERSION\n"; BEGIN { require FindBin; unshift @INC, $FindBin::Bin . '/lib'; } use helpers; &is( e "", "" ); &is( e "\n", "", ); &is( e "\n=pod\n\n foo bar baz", "\n=pod\n\n foo bar baz" ); &is( e "\n=pod\n\n foo bar baz", "\n=pod\n\n foo bar baz\n" ); is( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\n"), qq{ foo bar baz} ); is( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\n quux\n"), qq{ foo bar baz\n quux} ); is( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\nquux\n"), qq{ foo bar baz\nquux} ); print "# Contiguous verbatims...\n"; is( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\n\n quux\n"), qq{ foo bar baz\n\n quux} ); is( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\n\n\n quux\n"), qq{ foo bar baz\n\n\n quux} ); print "# Testing =cut...\n"; is( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\n=cut\n quux\n"), qq{ foo bar baz} ); # . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . { my $it = qq{ foo bar bazFoo quux\nquum} ; print "# Various \\n-(in)significance sanity checks...\n"; print "# verbatim/cut/head/verbatim sanity zero...\n"; is( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\n\n=head1 Foo\n\n quux\nquum\n"), $it); is( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\n=cut\nsome code here...\n=head1 Foo\n\n quux\nquum\n"), $it); is( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\n=cut\nsome code here...\n\n=head1 Foo\n\n quux\nquum\n"), $it); print "# verbatim/cut/head/verbatim sanity one...\n"; is( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\n=cut\n\nsome code here...\n=head1 Foo\n\n quux\nquum\n"), $it); is( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\n\n=cut\nsome code here...\n=head1 Foo\n\n quux\nquum\n"), $it); is( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\n\n=cut\n\nsome code here...\n=head1 Foo\n\n quux\nquum\n"), $it); print "# verbatim/cut/head/verbatim sanity two...\n"; is( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\n=cut\n\nsome code here...\n\n=head1 Foo\n\n quux\nquum\n"), $it); is( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\n\n=cut\nsome code here...\n\n=head1 Foo\n\n quux\nquum\n"), $it); is( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\n\n=cut\n\n\nsome code here...\n\n=head1 Foo\n\n quux\nquum\n"), $it); print "# verbatim/cut/head/verbatim sanity three...\n"; is( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\n=cut\n\nsome code here...\n\n\n=head1 Foo\n\n quux\nquum\n"), $it); is( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\n\n=cut\nsome code here...\n\n\n=head1 Foo\n\n quux\nquum\n"), $it); is( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\n\n=cut\n\nsome code here...\n\n\n=head1 Foo\n\n quux\nquum\n"), $it); print "# verbatim/cut/head/verbatim sanity four...\n"; is( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\n\n\n\n\n=cut\n\nsome code here...\n\n\n=head1 Foo\n\n quux\nquum\n"), $it); is( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\n\n\n\n\n\n=cut\nsome code here...\n\n\n=head1 Foo\n\n quux\nquum\n"), $it); is( Pod::Simple::XMLOutStream->_out("\n=pod\n\n foo bar baz\n\n\n\n\n\n=cut\n\nsome code here...\n\n\n=head1 Foo\n\n quux\nquum\n"), $it); } #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ print "# Testing tab expansion...\n"; &ok( e q{=pod here we go now a b c d e f g h i j k l m n o p q r s t u v w x y z }, q{=pod here we go now a b c d e f g h i j k l m n o p q r s t u v w x y z }, ); #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ &ok( e q{=pod here we go now a .b . c . d . e . f . g . h . i . j . k . l . m . n . o . p . q . r . s . t . u . v . w . x . y . z }, q{=pod here we go now a .b . c . d . e . f . g . h . i . j . k . l . m . n . o . p . q . r . s . t . u . v . w . x . y . z }, ); #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ &ok( e q{=pod here we go now a .b ..c .. d .. e .. f .. g .. h .. i .. j .. k .. l .. m .. n .. o .. p .. q .. r .. s .. t .. u .. v .. w .. x .. y .. z }, q{=pod here we go now a .b ..c .. d .. e .. f .. g .. h .. i .. j .. k .. l .. m .. n .. o .. p .. q .. r .. s .. t .. u .. v .. w .. x .. y .. z }, ); #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ &ok( e q{=pod here we go now a .b ..c .. d .. e .. f .. g .. h .. i .. .j .. . k .. . l .. . m .. . n .. . o .. . p .. . q .. . r .. . s .. . t .. . u .. . v .. . w .. . x .. . y .. . z }, q{=pod here we go now a .b ..c .. d .. e .. f .. g .. h .. i .. .j .. . k .. . l .. . m .. . n .. . o .. . p .. . q .. . r .. . s .. . t .. . u .. . v .. . w .. . x .. . y .. . z }, ); #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # TODO: long-line splitting? Pod-Simple-3.45/t/github_issue_79.t0000644000175000017500000000246214243763554015244 0ustar khwkhwuse strict; use warnings; use Test::More; { package DumpAsXML::Enh; use Pod::Simple::DumpAsXML (); our @ISA = qw(Pod::Simple::DumpAsXML); sub new { my ( $class ) = @_; my $self = $class->SUPER::new(); $self->code_handler( sub { pop( @_ )->_handle_line( 'code', @_ ); } ); $self->cut_handler( sub { pop( @_ )->_handle_line( 'cut', @_ ); } ); $self->pod_handler( sub { pop( @_ )->_handle_line( 'pod', @_ ); } ); $self->whiteline_handler( sub { pop( @_ )->_handle_line( 'white', @_ ); } ); return $self; }; sub _handle_line { my ( $self, $elem, $text, $line ) = @_; my $fh = $self->{ output_fh }; print { $fh } ' ' x $self->{ indent }, "<$elem start_line=\"$line\"/>\n"; }; } my $output = ''; my $parser = DumpAsXML::Enh->new(); $parser->output_string( \$output ); my $input = [ '=head1 DESCRIPTION', '', ' Verbatim paragraph.', '', '=cut', ]; my $expected_output = join "\n", '', ' ', ' DESCRIPTION', ' ', ' ', ' Verbatim paragraph.', ' ', ' ', '', '', ; $parser->parse_lines( @$input, undef ); is($output, $expected_output); done_testing; Pod-Simple-3.45/t/content_seen.t0000644000175000017500000000104714243763543014713 0ustar khwkhwuse strict; use warnings; use Test::More tests => 2; use Pod::Simple::Text; my $p = Pod::Simple::Text->new(); $p->parse_string_document('dm+aSxLl7V3VUJFIe6CFDU13zhZ3yvjIuVkp6l//ZHcDcX014vnnh3FoElI92kFB JGFU23Vga5Tfz0Epybwio9dq1gzrZ/PIcil2MnEcUWSrIStriv4hAbf0MXcNRHOM oOV7xKU= =y6KV -----END PGP PUBLIC KEY BLOCK-----}; print $key; exit; '); # The =y6KV should not make this appear to be pod ok ! $p->content_seen; my $q = Pod::Simple::Text->new(); $q->parse_string_document('=head1 yes this is pod And this fills it in '); ok $q->content_seen; Pod-Simple-3.45/t/search60.t0000644000175000017500000000131214243763554013637 0ustar khwkhwuse strict; use warnings; use Pod::Simple::Search; use Test::More tests => 3; print "# ", __FILE__, ": Testing forced case sensitivity ...\n"; my $x = Pod::Simple::Search->new; die "Couldn't make an object!?" unless ok defined $x; $x->inc(0); $x->is_case_insensitive(0); use File::Spec; use Cwd (); use File::Basename (); my $t_dir = File::Basename::dirname(Cwd::abs_path(__FILE__)); my $A = File::Spec->catdir($t_dir, 'search60', 'A'); my $B = File::Spec->catdir($t_dir, 'search60', 'B'); print "# OK, found the test corpora\n# as $A\n# and $B\n#\n"; my($name2where, $where2name) = $x->survey($A, $B); like ($name2where->{x}, qr{^\Q$A\E[\\/]x\.pod$}); like ($name2where->{X}, qr{^\Q$B\E[\\/]X\.pod$}); Pod-Simple-3.45/t/htmlbat.t0000644000175000017500000000432414243763554013665 0ustar khwkhw# Testing HTMLBatch use strict; use warnings; use Test::More tests => 15; #sub Pod::Simple::HTMLBatch::DEBUG () {5}; my $DEBUG = 0; require Pod::Simple::HTMLBatch;; use File::Spec; use Cwd; my $cwd = cwd(); print "# CWD: $cwd\n" if $DEBUG; use File::Spec; use Cwd (); use File::Basename (); my $t_dir = File::Basename::dirname(Cwd::abs_path(__FILE__)); my $corpus_dir = File::Spec->catdir($t_dir, 'testlib1'); print "# OK, found the test corpus as $corpus_dir\n" if $DEBUG; my $outdir; while(1) { my $rand = sprintf "%05x", rand( 0x100000 ); $outdir = File::Spec->catdir( $t_dir, "delme-$rand-out" ); last unless -e $outdir; } END { use File::Path; rmtree $outdir, 0, 0; } ok 1; print "# Output dir: $outdir\n" if $DEBUG; mkdir $outdir, 0777 or die "Can't mkdir $outdir: $!"; print "# Converting $corpus_dir => $outdir\n" if $DEBUG; my $conv = Pod::Simple::HTMLBatch->new; $conv->verbose(0); $conv->index(1); $conv->batch_convert( [$corpus_dir], $outdir ); ok 1; print "# OK, back from converting.\n" if $DEBUG; my @files; use File::Find; find( sub { push @files, $File::Find::name; if (/[.]html$/ && $_ !~ /perl|index/) { # Make sure an index was generated. open HTML, $_ or die "Cannot open $_: $!\n"; my $html = do { local $/; }; close HTML; like $html, qr/
/; } return; }, $outdir ); { my $long = ( grep m/zikzik\./i, @files )[0]; ok($long) or print "# How odd, no zikzik file in $outdir!?\n"; if($long) { $long =~ s{zikzik\.html?$}{}s; for(@files) { substr($_, 0, length($long)) = '' } @files = grep length($_), @files; } } if ($DEBUG) { print "#Produced in $outdir ...\n"; foreach my $f (sort @files) { print "# $f\n"; } print "# (", scalar(@files), " items total)\n"; } # Some minimal sanity checks: ok scalar(grep m/\.css/i, @files) > 5; ok scalar(grep m/\.html?/i, @files) > 5; ok scalar grep m{squaa\W+Glunk.html?}i, @files; if (my @long = grep { /^[^.]{9,}/ } map { s{^[^/]/}{} } @files) { ok 0; print "# File names too long:\n", map { "# $_\n" } @long; } else { ok 1; } # use Pod::Simple; # *pretty = \&Pod::Simple::BlackBox::pretty; Pod-Simple-3.45/t/puller.t0000644000175000017500000001730214362364651013532 0ustar khwkhwuse strict; use warnings; use Test::More tests => 135; #use Pod::Simple::Debug (5); #sub Pod::Simple::MANY_LINES () {1} #sub Pod::Simple::PullParser::DEBUG () {1} use Pod::Simple::PullParser; sub pump_it_up { my $p = Pod::Simple::PullParser->new; $p->set_source( \( $_[0] ) ); my(@t, $t); while($t = $p->get_token) { push @t, $t } print "# Count of tokens: ", scalar(@t), "\n"; print "# I.e., {", join("\n# + ", map ref($_) . ": " . $_->dump, @t), "} \n"; return @t; } my @t; #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @t = pump_it_up(qq{\n\nProk\n\n=head1 Things\n\n=cut\n\nBzorch\n\n}); if(not( is scalar( grep { ref $_ and $_->can('type') } @t), 5 )) { fail "Wrong token count. Failing subsequent tests.\n"; for ( 2 .. 12 ) {fail} } else { is $t[0]->type, 'start'; is $t[1]->type, 'start'; is $t[2]->type, 'text'; is $t[3]->type, 'end'; is $t[4]->type, 'end'; is $t[0]->tagname, 'Document'; is $t[1]->tagname, 'head1'; is $t[2]->text, 'Things'; is $t[3]->tagname, 'head1'; is $t[4]->tagname, 'Document'; is $t[0]->attr('start_line'), '5'; is $t[1]->attr('start_line'), '5'; } #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @t = pump_it_up( qq{Woowoo\n\n=over\n\n=item *\n\nStuff L\n\n} . qq{=item *\n\nThings I\n\n=back\n\n=cut\n\n} ); if( not( is scalar( grep { ref $_ and $_->can('type') } @t) => 16 ) ) { fail "Wrong token count. Failing subsequent tests.\n"; for ( 1 .. 32 ) {ok 0} } else { is $t[ 0]->type, 'start'; is $t[ 1]->type, 'start'; is $t[ 2]->type, 'start'; is $t[ 3]->type, 'text'; is $t[ 4]->type, 'start'; is $t[ 5]->type, 'text'; is $t[ 6]->type, 'end'; is $t[ 7]->type, 'end'; is $t[ 8]->type, 'start'; is $t[ 9]->type, 'text'; is $t[10]->type, 'start'; is $t[11]->type, 'text'; is $t[12]->type, 'end'; is $t[13]->type, 'end'; is $t[14]->type, 'end'; is $t[15]->type, 'end'; is $t[ 0]->tagname, 'Document'; is $t[ 1]->tagname, 'over-bullet'; is $t[ 2]->tagname, 'item-bullet'; is $t[ 3]->text, 'Stuff '; is $t[ 4]->tagname, 'L'; is $t[ 5]->text, 'HTML::TokeParser'; is $t[ 6]->tagname, 'L'; is $t[ 7]->tagname, 'item-bullet'; is $t[ 8]->tagname, 'item-bullet'; is $t[ 9]->text, 'Things '; is $t[10]->tagname, 'I'; is $t[11]->text, 'like that'; is $t[12]->tagname, 'I'; is $t[13]->tagname, 'item-bullet'; is $t[14]->tagname, 'over-bullet'; is $t[15]->tagname, 'Document'; is $t[4]->attr("type"), "pod"; } #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ { print "# Testing unget_token\n"; my $p = Pod::Simple::PullParser->new; $p->set_source( \qq{\nBzorch\n\n=pod\n\nLala\n\n\=cut\n} ); ok 1; my $t; $t = $p->get_token; is $t && $t->type, 'start'; is $t && $t->tagname, 'Document'; print "# ungetting ($t).\n"; $p->unget_token($t); ok 1; $t = $p->get_token; is $t && $t->type, 'start'; is $t && $t->tagname, 'Document'; my @to_save = ($t); $t = $p->get_token; is $t && $t->type, 'start'; is $t && $t->tagname, 'Para'; push @to_save, $t; print "# ungetting (@to_save).\n"; $p->unget_token(@to_save); splice @to_save; $t = $p->get_token; is $t && $t->type, 'start'; is $t && $t->tagname, 'Document'; $t = $p->get_token; is $t && $t->type, 'start'; is $t && $t->tagname, 'Para'; ok 1; } #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ { print "# Testing pullparsing from an arrayref\n"; my $p = Pod::Simple::PullParser->new; ok 1; $p->set_source( ['','Bzorch', '','=pod', '', 'Lala', 'zaza', '', '=cut'] ); ok 1; my( @t, $t ); while($t = $p->get_token) { print "# Got a token: ", $t->dump, "\n#\n"; push @t, $t; } is scalar(@t), 5; # count of tokens is $t[0]->type, 'start'; is $t[1]->type, 'start'; is $t[2]->type, 'text'; is $t[3]->type, 'end'; is $t[4]->type, 'end'; is $t[0]->tagname, 'Document'; is $t[1]->tagname, 'Para'; is $t[2]->text, 'Lala zaza'; is $t[3]->tagname, 'Para'; is $t[4]->tagname, 'Document'; } #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ { print "# Testing pullparsing from an arrayref with terminal newlines\n"; my $p = Pod::Simple::PullParser->new; ok 1; $p->set_source( [ map "$_\n", '','Bzorch', '','=pod', '', 'Lala', 'zaza', '', '=cut'] ); ok 1; my( @t, $t ); while($t = $p->get_token) { print "# Got a token: ", $t->dump, "\n#\n"; push @t, $t; } is scalar(@t), 5; # count of tokens is $t[0]->type, 'start'; is $t[1]->type, 'start'; is $t[2]->type, 'text'; is $t[3]->type, 'end'; is $t[4]->type, 'end'; is $t[0]->tagname, 'Document'; is $t[1]->tagname, 'Para'; is $t[2]->text, 'Lala zaza'; is $t[3]->tagname, 'Para'; is $t[4]->tagname, 'Document'; } #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ our $temp_pod = "temp_$$.pod"; END { unlink "$temp_pod" } { print "# Testing pullparsing from a file\n"; my $p = Pod::Simple::PullParser->new; ok 1; open(OUT, ">$temp_pod") || die "Can't write-open $temp_pod: $!"; print OUT map "$_\n", '','Bzorch', '','=pod', '', 'Lala', 'zaza', '', '=cut' ; close(OUT); ok 1; sleep 1; $p->set_source("$temp_pod"); my( @t, $t ); while($t = $p->get_token) { print "# Got a token: ", $t->dump, "\n#\n"; push @t, $t; print "# That's token number ", scalar(@t), "\n"; } is scalar(@t), 5; # count of tokens is $t[0]->type, 'start'; is $t[1]->type, 'start'; is $t[2]->type, 'text'; is $t[3]->type, 'end'; is $t[4]->type, 'end'; is $t[0]->tagname, 'Document'; is $t[1]->tagname, 'Para'; is $t[2]->text, 'Lala zaza'; is $t[3]->tagname, 'Para'; is $t[4]->tagname, 'Document'; } # ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ { print "# Testing pullparsing from a glob\n"; my $p = Pod::Simple::PullParser->new; ok 1; open(IN, "<$temp_pod") || die "Can't read-open $temp_pod: $!"; $p->set_source(*IN); my( @t, $t ); while($t = $p->get_token) { print "# Got a token: ", $t->dump, "\n#\n"; push @t, $t; print "# That's token number ", scalar(@t), "\n"; } is scalar(@t), 5; # count of tokens is $t[0]->type, 'start'; is $t[1]->type, 'start'; is $t[2]->type, 'text'; is $t[3]->type, 'end'; is $t[4]->type, 'end'; is $t[0]->tagname, 'Document'; is $t[1]->tagname, 'Para'; is $t[2]->text, 'Lala zaza'; is $t[3]->tagname, 'Para'; is $t[4]->tagname, 'Document'; close(IN); } # ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ { print "# Testing pullparsing from a globref\n"; my $p = Pod::Simple::PullParser->new; ok 1; open(IN, "<$temp_pod") || die "Can't read-open $temp_pod: $!"; $p->set_source(\*IN); my( @t, $t ); while($t = $p->get_token) { print "# Got a token: ", $t->dump, "\n#\n"; push @t, $t; print "# That's token number ", scalar(@t), "\n"; } is scalar(@t), 5; # count of tokens is $t[0]->type, 'start'; is $t[1]->type, 'start'; is $t[2]->type, 'text'; is $t[3]->type, 'end'; is $t[4]->type, 'end'; is $t[0]->tagname, 'Document'; is $t[1]->tagname, 'Para'; is $t[2]->text, 'Lala zaza'; is $t[3]->tagname, 'Para'; is $t[4]->tagname, 'Document'; close(IN); } # ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ { print "# Testing pullparsing from a filehandle\n"; my $p = Pod::Simple::PullParser->new; ok 1; open(IN, "<$temp_pod") || die "Can't read-open $temp_pod: $!"; $p->set_source(*IN{IO}); my( @t, $t ); while($t = $p->get_token) { print "# Got a token: ", $t->dump, "\n#\n"; push @t, $t; print "# That's token number ", scalar(@t), "\n"; } is scalar(@t), 5; # count of tokens is $t[0]->type, 'start'; is $t[1]->type, 'start'; is $t[2]->type, 'text'; is $t[3]->type, 'end'; is $t[4]->type, 'end'; is $t[0]->tagname, 'Document'; is $t[1]->tagname, 'Para'; is $t[2]->text, 'Lala zaza'; is $t[3]->tagname, 'Para'; is $t[4]->tagname, 'Document'; close(IN); } Pod-Simple-3.45/t/xhtml-bkb.t0000644000175000017500000000062114243763540014111 0ustar khwkhw# 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 my $d = Pod::Simple::XHTML->new (); $d->index (1); my $e; $d->output_string (\$e); $d->parse_string_document ($c); unlike ($e, qr!]+>]+>!); Pod-Simple-3.45/t/basic.t0000644000175000017500000000461514243763554013316 0ustar khwkhwuse strict; use warnings; use Test::More tests => 29; #use Pod::Simple::Debug (6); require Pod::Simple::BlackBox; ok 1; require Pod::Simple; ok 1; Pod::Simple->VERSION(.90); ok 1; #print "# Pod::Simple version $Pod::Simple::VERSION\n"; require Pod::Simple::DumpAsXML; ok 1; require Pod::Simple::XMLOutStream; ok 1; BEGIN { require FindBin; unshift @INC, $FindBin::Bin . '/lib'; } use helpers; print "# Simple identity tests...\n"; &is( e "", "" ); &is( e "\n", "", ); &is( e "\n", "\n", ); &is( e "puppies\n\n\n\n", "", ); print "# Contentful identity tests...\n"; &is( e "=pod\n\nFoo\n", "=pod\n\nFoo\n" ); &is( e "=pod\n\n\n\nFoo\n\n\n", "=pod\n\n\n\nFoo\n\n\n" ); &is( e "=pod\n\n\n\nFoo\n\n\n", "=pod\n\nFoo\n" ); # Now with some more newlines &is( e "\n\n=pod\n\nFoo\n", "\n\n=pod\n\nFoo\n" ); &is( e "=pod\n\n\n\nFoo\n\n\n", "=pod\n\n\n\nFoo\n\n\n" ); &is( e "=pod\n\n\n\nFoo\n\n\n", "\n\n=pod\n\nFoo\n" ); &is( e "=head1 Foo\n", "=head1 Foo\n" ); &is( e "=head1 Foo\n\n=cut\n", "=head1 Foo\n\n=cut\n" ); &is( e "=head1 Foo\n\n=cut\n", "=head1 Foo\n" ); # Now just add some newlines... &is( e "\n\n\n\n=head1 Foo\n", "\n\n\n\n=head1 Foo\n" ); &is( e "=head1 Foo\n\n=cut\n", "=head1 Foo\n\n=cut\n" ); &is( e "=head1 Foo\n\n=cut\n", "\n\n\n\n=head1 Foo\n" ); print "# Simple XMLification tests...\n"; is( Pod::Simple::XMLOutStream->_out("\n\n\nprint \$^T;\n\n\n"), qq{} # make sure the contentless flag is set ); is( Pod::Simple::XMLOutStream->_out("\n\n"), qq{} # make sure the contentless flag is set ); is( Pod::Simple::XMLOutStream->_out("\n"), qq{} # make sure the contentless flag is set ); is( Pod::Simple::XMLOutStream->_out(""), qq{} # make sure the contentless flag is set ); ok( Pod::Simple::XMLOutStream->_out('', '' ) ); is( Pod::Simple::XMLOutStream->_out("=pod\n\nFoo\n"), 'Foo' ); is( Pod::Simple::XMLOutStream->_out("=head1 Chacha\n\nFoo\n"), 'ChachaFoo' ); # Make sure an obviously invalid Pod tag is invalid. is( Pod::Simple::XMLOutStream->_out("=F\0blah\n\nwhatever\n"), qq{} ); Pod-Simple-3.45/t/xhtml05.t0000644000175000017500000000220114243763540013516 0ustar khwkhw# t/xhtml05.t - check block output from Pod::Simple::XHTML use strict; use warnings; use Test::More tests => 6; use_ok('Pod::Simple::XHTML') or exit; my $parser = Pod::Simple::XHTML->new (); isa_ok ($parser, 'Pod::Simple::XHTML'); my $results; initialize($parser, $results); $parser->accept_targets_as_text( 'comment' ); $parser->parse_string_document(<<'EOPOD'); =for comment This is an ordinary for block. EOPOD is($results, <<'EOHTML', "a for block");

This is an ordinary for block.

EOHTML foreach my $target (qw(note tip warning)) { initialize($parser, $results); $parser->accept_targets_as_text( $target ); $parser->parse_string_document(<<"EOPOD"); =begin $target This is a $target. =end $target EOPOD is($results, <<"EOHTML", "allow $target blocks");

This is a $target.

EOHTML } ###################################### sub initialize { $_[0] = Pod::Simple::XHTML->new (); $_[0]->html_header(""); $_[0]->html_footer(""); $_[0]->output_string( \$results ); # Send the resulting output to a string $_[1] = ''; return; } Pod-Simple-3.45/t/testlib2/0000755000175000017500000000000014430216375013562 5ustar khwkhwPod-Simple-3.45/t/testlib2/Suzzle.pm0000644000175000017500000000012214243754135015412 0ustar khwkhw 1; __END__ =head1 NAME Sizzlesuzzle -- hooboy, this is a test file too. =cut Pod-Simple-3.45/t/testlib2/hinkhonk/0000755000175000017500000000000014430216375015373 5ustar khwkhwPod-Simple-3.45/t/testlib2/hinkhonk/Vliff.pm0000644000175000017500000000016514243754135017004 0ustar khwkhw =head1 NAME squaa::Vliff -- blorpoesu =head1 DESCRIPTION This is just a test file. =cut print "HOOBOY!\n"; 1; Pod-Simple-3.45/t/testlib2/hinkhonk/readme.txt0000644000175000017500000000005014243754135017367 0ustar khwkhwThis directory should never be scanned. Pod-Simple-3.45/t/testlib2/hinkhonk/Glunk.pod0000644000175000017500000000013614243754135017162 0ustar khwkhw =head1 NAME squaa::Glunk -- blorpoesu =head1 DESCRIPTION This is just a test file. =cut Pod-Simple-3.45/t/testlib2/squaa/0000755000175000017500000000000014430216375014674 5ustar khwkhwPod-Simple-3.45/t/testlib2/squaa/Vliff.pm0000644000175000017500000000016514243754135016305 0ustar khwkhw =head1 NAME squaa::Vliff -- blorpoesu =head1 DESCRIPTION This is just a test file. =cut print "HOOBOY!\n"; 1; Pod-Simple-3.45/t/testlib2/squaa/Wowo.pod0000644000175000017500000000013614243754135016336 0ustar khwkhw =head1 NAME squaa::Glunk -- blorpoesu =head1 DESCRIPTION This is just a test file. =cut Pod-Simple-3.45/t/testlib2/pod/0000755000175000017500000000000014430216375014344 5ustar khwkhwPod-Simple-3.45/t/testlib2/pod/perlthng.pod0000644000175000017500000000007514243754135016700 0ustar khwkhw =head1 NAME perlthang - This is just some test file =cut Pod-Simple-3.45/t/testlib2/pod/perlzuk.pod0000644000175000017500000000007514243754135016551 0ustar khwkhw =head1 NAME perlthang - This is just some test file =cut Pod-Simple-3.45/t/testlib2/pods/0000755000175000017500000000000014430216375014527 5ustar khwkhwPod-Simple-3.45/t/testlib2/pods/perlzoned.pod0000644000175000017500000000007314243754135017240 0ustar khwkhw=head1 NAME perlzoned - This is just some test file =cut Pod-Simple-3.45/t/JustPod02.t0000644000175000017500000002120014243763543013752 0ustar khwkhwuse strict; use warnings; use Test::More tests => 1; use Pod::Simple::JustPod; my @orig = ; my $parsed; my $parser = Pod::Simple::JustPod->new(); $parser->output_string(\$parsed); $parser->parse_lines(@orig, undef); my $orig = join "", @orig; my $msg = "Verify parsed pod sufficiently matches original"; if ($parsed eq $orig) { pass($msg); } elsif ($ENV{PERL_TEST_DIFF}) { fail($msg); require File::Temp; my $orig_file = File::Temp->new(); local $/ = "\n"; chomp $orig; print $orig_file $orig, "\n"; close $orig_file || die "Can't close orig_file: $!"; chomp $parsed; my $parsed_file = File::Temp->new(); print $parsed_file $parsed, "\n"; close $parsed_file || die "Can't close parsed_file"; my $diff = File::Temp->new(); system("$ENV{PERL_TEST_DIFF} $orig_file $parsed_file > $diff"); open my $fh, "<", $diff || die "Can't open $diff"; my @diffs = <$fh>; diag(@diffs); } else { eval { require Text::Diff; }; if ($@) { is($parsed, $orig, $msg); diag("Set environment variable PERL_TEST_DIFF=diff_tool or install" . " Text::Diff to see just the differences."); } else { fail($msg); diag Text::Diff::diff(\$orig, \$parsed, { STYLE => 'Unified' }); } } # The data is adapted from a test file from pod2lators. Extra spaces are # added in places to make sure they get retained, and some extra tests __DATA__ =pod =encoding ASCII =head1 NAME basic.pod - Test of various basic POD features in translators. =head1 HEADINGS Try a few different levels of headings, with embedded formatting codes and other interesting bits. =head1 This C a "level 1" heading =head2 ``Level'' "2 I =head3 Level 3 B>>> =head4 Level "4 C =head5 Level "5 B =head6 Level "6 I Now try again with B F. =head1 This C a "level 1" heading Text. =head2 ``Level'' 2 I Text. =head3 Level 3 B>>> Text. =head4 Level "4 C Text. =head5 Level "5 B Text. =head6 Level "6 I Text. =head1 LINKS These are all taken from the Pod::Parser tests. Try out I of different ways of specifying references: Reference the L Reference the L<"manpage"/section> Reference the L Now try it using the new "|" stuff ... Reference the L| Reference the L| Reference the L| Reference the L| Reference the L| Reference the L| And then throw in a few new ones of my own. L L L L L L L L L<"boo var baz"> L L, L, and L Lbar> L|foo/bar> L text> LbarZ<>/Section C I markup>> =head1 OVER AND ITEMS Taken from Pod::Parser tests, this is a test to ensure that multiline =item paragraphs get indented appropriately. =over 4 =item This is a test. =back There should be whitespace now before this line. Taken from Pod::Parser tests, this is a test to ensure the nested =item paragraphs get indented appropriately. =over 2 =item 1 First section. =over 2 =item a this is item a =item b this is item b =back =item 2 Second section. =over 2 =item a this is item a =item b this is item b =item c =item d This is item c & d. =back =back Now some additional weirdness of our own. Make sure that multiple tags for one paragraph are properly compacted. =over 4 =item "foo" =item B =item C There shouldn't be any spaces between any of these item tags; this idiom is used in perlfunc. =item Some longer item text Just to make sure that we test paragraphs where the item text doesn't fit in the margin of the paragraph (and make sure that this paragraph fills a few lines). Let's also make it multiple paragraphs to be sure that works. =back Test use of =over without =item as a block "quote" or block paragraph. =over 4 This should be indented four spaces but otherwise formatted the same as any other regular text paragraph. Make sure it's long enough to see the results of the formatting..... =back Now try the same thing nested, and make sure that the indentation is reset back properly. =over 4 =over 4 This paragraph should be doubly indented. =back This paragraph should only be singly indented. =over 4 =item This is an item in the middle of a block-quote, which should be allowed. =item We're also testing tagless item commands. =back Should be back to the single level of indentation. =back Should be back to regular indentation. Now also check the transformation of * into real bullets for man pages. =over =item * An item. We're also testing using =over without a number, and making sure that item text wraps properly. =item * Another item. =back and now test the numbering of item blocks. =over 4 =item 1. First item. =item 2. Second item. =back =head1 FORMATTING CODES Another test taken from Pod::Parser. This is a test to see if I can do not only C<$self> and C, but also C<< $self->method() >> and C<< $self->{FIELDNAME} >> and C<< $Foo <=> $Bar >> without resorting to escape sequences. If I want to refer to the right-shift operator I can do something like C<<< $x >> 3 >>> or even C<<<< $y >> 5 >>>>. Now for the grand finale of C<< $self->method()->{FIELDNAME} = {FOO=>BAR} >>. And I also want to make sure that newlines work like this C<<< $self->{FOOBAR} >> 3 and [$b => $a]->[$a <=> $b] >>> Of course I should still be able to do all this I escape sequences too: C<$self-Emethod()> and C<$self-E{FIELDNAME}> and C<{FOO=EBAR}>. Dont forget C<$self-Emethod()-E{FIELDNAME} = {FOO=EBAR}>. And make sure that C<0> works too! Now, if I use << or >> as my delimiters, then I have to use whitespace. So things like C<<$self->method()>> and C<<$self->{FIELDNAME}>> wont end up doing what you might expect since the first > will still terminate the first < seen. Lets make sure these work for empty ones too, like C<<< >>>, C<<<< >>>>, and C<< >> >> (just to be obnoxious) The statement: C hour!> is a parody of a quotation from Winston Churchill. The following tests are added to those: Make sure that a few othZ<>er odd Ithings> still work. This should be a vertical bar: E. Here's a test of a few more special escapes that have to be supported: =over 3 =item E An ampersand. =item E An apostrophe. =item E A less-than sign. =item E A greater-than sign. =item E A double quotation mark. =item E A forward slash. =back Try to get this bit of text over towards the edge so S<|that all of this text inside SEE won't|> be wrapped. Also test the |sameEthingEwithEnon-breakingS< spaces>.| There is a soft hyEphen in hyphen at hy-phen. This is a test of an Xindex entry. =head1 VERBATIM Throw in a few verbatim paragraphs. use Term::ANSIColor; print color 'bold blue'; print "This text is bold blue.\n"; print color 'reset'; print "This text is normal.\n"; print colored ("Yellow on magenta.\n", 'yellow on_magenta'); print "This text is normal.\n"; print colored ['yellow on_magenta'], "Yellow on magenta.\n"; use Term::ANSIColor qw(uncolor); print uncolor '01;31', "\n"; But this isn't verbatim (make sure it wraps properly), and the next paragraph is again: use Term::ANSIColor qw(:constants); print BOLD, BLUE, "This text is in bold blue.\n", RESET; use Term::ANSIColor qw(:constants); $Term::ANSIColor::AUTORESET = 1; print BOLD BLUE "This text is in bold blue.\n"; print "This text is normal.\n"; (Ugh, that's obnoxiously long.) Try different spacing: Starting with a tab. Not starting with a tab. But this should still be verbatim. As should this. This isn't. This is. And this: is an internal tab. It should be: |--| <= lined up with that. (Tricky, but tabs should be expanded before the translator starts in on the text since otherwise text with mixed tabs and spaces will get messed up.) And now we test verbatim paragraphs right before a heading. Older versions of Pod::Man generated two spaces between paragraphs like this and the heading. (In order to properly test this, one may have to visually inspect the nroff output when run on the generated *roff text, unfortunately.) =head1 CONCLUSION That's all, folks! =cut Pod-Simple-3.45/t/search60/0000755000175000017500000000000014430216375013445 5ustar khwkhwPod-Simple-3.45/t/search60/A/0000755000175000017500000000000014430216375013625 5ustar khwkhwPod-Simple-3.45/t/search60/A/x.pod0000644000175000017500000000001214243754135014574 0ustar khwkhw=head1 x Pod-Simple-3.45/t/search60/B/0000755000175000017500000000000014430216375013626 5ustar khwkhwPod-Simple-3.45/t/search60/B/X.pod0000644000175000017500000000001214243754135014535 0ustar khwkhw=head1 X Pod-Simple-3.45/t/00about.t0000644000175000017500000000577114243763554013513 0ustar khwkhw# Summary of, well, things. use strict; use warnings; use Test::More; my @modules; BEGIN { @modules = qw( Pod::Escapes Pod::Simple Pod::Simple::BlackBox Pod::Simple::Checker Pod::Simple::DumpAsText Pod::Simple::DumpAsXML Pod::Simple::HTML Pod::Simple::HTMLBatch Pod::Simple::HTMLLegacy Pod::Simple::LinkSection Pod::Simple::Methody Pod::Simple::JustPod Pod::Simple::Progress Pod::Simple::PullParser Pod::Simple::PullParserEndToken Pod::Simple::PullParserStartToken Pod::Simple::PullParserTextToken Pod::Simple::PullParserToken Pod::Simple::RTF Pod::Simple::Search Pod::Simple::SimpleTree Pod::Simple::Text Pod::Simple::TextContent Pod::Simple::TiedOutFH Pod::Simple::Transcode Pod::Simple::XMLOutStream ); plan tests => scalar @modules; }; #chdir "t" if -e "t"; foreach my $m (@modules) { print "# Loading $m ...\n"; eval "require $m;"; unless($@) { ok 1; next } my $e = $@; $e =~ s/\s+$//s; $e =~ s/[\n\r]+/\n# > /; print "# Error while trying to load $m --\n# > $e\n"; ok 0; } { my @out; push @out, "\n\nPerl v", defined($^V) ? sprintf('%vd', $^V) : $], " under $^O ", (defined(&Win32::BuildNumber) and defined &Win32::BuildNumber()) ? ("(Win32::BuildNumber ", &Win32::BuildNumber(), ")") : (), (defined $MacPerl::Version) ? ("(MacPerl version $MacPerl::Version)") : (), "\n" ; # Ugly code to walk the symbol tables: my %v; my @stack = (''); # start out in %:: my $this; my $count = 0; my $pref; while(@stack) { $this = shift @stack; die "Too many packages?" if ++$count > 1000; next if exists $v{$this}; next if $this eq 'main'; # %main:: is %:: #print "Peeking at $this => ${$this . '::VERSION'}\n"; no strict 'refs'; if( defined ${$this . '::VERSION'} ) { $v{$this} = ${$this . '::VERSION'} } elsif( defined *{$this . '::ISA'} or defined &{$this . '::import'} or ($this ne '' and grep defined *{$_}{'CODE'}, values %{$this . "::"}) # If it has an ISA, an import, or any subs... ) { # It's a class/module with no version. $v{$this} = undef; } else { # It's probably an unpopulated package. ## $v{$this} = '...'; } $pref = length($this) ? "$this\::" : ''; push @stack, map m/^(.+)::$/ ? "$pref$1" : (), do { no strict 'refs'; keys %{$this . '::'} }; #print "Stack: @stack\n"; } push @out, " Modules in memory:\n"; delete @v{'', '[none]'}; foreach my $p (sort {lc($a) cmp lc($b)} keys %v) { my $indent = ' ' x (2 + ($p =~ tr/:/:/)); push @out, ' ', $indent, $p, defined($v{$p}) ? " v$v{$p};\n" : ";\n"; } push @out, sprintf "[at %s (local) / %s (GMT)]\n", scalar(gmtime), scalar(localtime); my $x = join '', @out; $x =~ s/^/#/mg; print $x; } print "# Running", (chr(65) eq 'A') ? " in an ASCII world.\n" : " in a non-ASCII world.\n", "#\n", ; print "# \@INC:\n", map("# [$_]\n", @INC), "#\n#\n"; print "# \%INC:\n"; foreach my $x (sort {lc($a) cmp lc($b)} keys %INC) { print "# [$x] = [", $INC{$x} || '', "]\n"; } Pod-Simple-3.45/t/xhtml25.t0000644000175000017500000000427714362364651013541 0ustar khwkhwuse strict; use warnings; use Test::More; BEGIN { package MyXHTML; use base 'Pod::Simple::XHTML'; sub new { my $class = shift; my $self = $class->SUPER::new(@_); $self->html_header(''); $self->html_footer(''); $self->index(1); $self->anchor_items(1); return $self; } sub parse_to_string { my $self = shift; my $pod = shift; my $output = ''; $self->output_string( \$output ); $self->parse_string_document($pod); return $output; } sub idify { my ($self, $t, $not_unique) = @_; for ($t) { $t =~ s/\A\s+//; $t =~ s/\s+\z//; $t =~ s/[\s-]+/-/g; } return $t if $not_unique; my $i = ''; $i++ while $self->{ids}{"$t$i"}++; return "$t$i"; } } my @tests = ( # Pod id link (url encoded) [ 'Foo', 'Foo', 'Foo' ], [ '$@', '$@', '%24%40' ], [ 'With C', 'With-Formatting', 'With-Formatting' ], [ '$obj->method($foo)', '$obj->method($foo)', '%24obj-%3Emethod(%24foo)' ], ); plan tests => 5 * scalar @tests; my $parser = MyXHTML->new; for my $names (@tests) { my ($heading, $id, $link) = @$names; is $link, $parser->encode_url($id), 'assert correct encoding of url fragment'; my $html_id = $parser->encode_entities($id); { my $result = MyXHTML->new->parse_to_string(<<"EOT"); =head1 $heading L<< /$heading >> EOT like $result, qr{

}, "heading id generated correctly for '$heading'"; like $result, qr{
  • }, "index link generated correctly for '$heading'"; like $result, qr{

    }, "L<> link generated correctly for '$heading'"; } { my $result = MyXHTML->new->parse_to_string(<<"EOT"); =over 4 =item $heading =back EOT like $result, qr{

    }, "item id generated correctly for '$heading'"; } } Pod-Simple-3.45/t/end_over.t0000644000175000017500000000320514243763554014030 0ustar khwkhw# head ends over use strict; use warnings; use Test::More tests => 6; BEGIN { require FindBin; unshift @INC, $FindBin::Bin . '/lib'; } use helpers qw(f); my $d; #use Pod::Simple::Debug (\$d,0); use Pod::Simple::DumpAsXML; use Pod::Simple::XMLOutStream; print "# Pod::Simple version $Pod::Simple::VERSION\n"; sub nowhine { $_[0]->{'no_whining'} = 1; } &is(f( \&nowhine, "=head2 BLOOP\n\nHoopbehwo!\n\n=over\n\n=item Stuff. Um.\n\nBrop.\n\n=head1 SVUP\n\nMyup.", "=head2 BLOOP\n\nHoopbehwo!\n\n=over\n\n=item Stuff. Um.\n\nBrop.\n\n=back\n\n=head1 SVUP\n\nMyup.", )); &is(f( \&nowhine, "=head2 BLOOP\n\nHoopbehwo!\n\n=over\n\n=item Stuff. Um.\n\nBrop.\n\n=head2 SVUP\n\nMyup.", "=head2 BLOOP\n\nHoopbehwo!\n\n=over\n\n=item Stuff. Um.\n\nBrop.\n\n=back\n\n=head2 SVUP\n\nMyup.", )); &is(f( \&nowhine, "=head2 BLOOP\n\nHoopbehwo!\n\n=over\n\n=item Stuff. Um.\n\nBrop.\n\n=head3 SVUP\n\nMyup.", "=head2 BLOOP\n\nHoopbehwo!\n\n=over\n\n=item Stuff. Um.\n\nBrop.\n\n=back\n\n=head3 SVUP\n\nMyup.", )); &is(f( \&nowhine, "=head2 BLOOP\n\nHoopbehwo!\n\n=over\n\n=item Stuff. Um.\n\nBrop.\n\n=head4 SVUP\n\nMyup.", "=head2 BLOOP\n\nHoopbehwo!\n\n=over\n\n=item Stuff. Um.\n\nBrop.\n\n=back\n\n=head4 SVUP\n\nMyup.", )); &is(f( \&nowhine, "=head2 BLOOP\n\nHoopbehwo!\n\n=over\n\n=item Stuff. Um.\n\nBrop.\n\n=head5 SVUP\n\nMyup.", "=head2 BLOOP\n\nHoopbehwo!\n\n=over\n\n=item Stuff. Um.\n\nBrop.\n\n=back\n\n=head5 SVUP\n\nMyup.", )); &is(f( \&nowhine, "=head2 BLOOP\n\nHoopbehwo!\n\n=over\n\n=item Stuff. Um.\n\nBrop.\n\n=head6 SVUP\n\nMyup.", "=head2 BLOOP\n\nHoopbehwo!\n\n=over\n\n=item Stuff. Um.\n\nBrop.\n\n=back\n\n=head6 SVUP\n\nMyup.", )); Pod-Simple-3.45/t/fcodes_e.t0000644000175000017500000000473314243763554014005 0ustar khwkhw# fcodes E use strict; use warnings; use Test::More tests => 18; BEGIN { require FindBin; unshift @INC, $FindBin::Bin . '/lib'; } use helpers; #use Pod::Simple::Debug (6); use Pod::Simple::DumpAsXML; use Pod::Simple::XMLOutStream; print "# Pod::Simple version $Pod::Simple::VERSION\n"; print "# Pod::Escapes version $Pod::Escapes::VERSION\n", if $Pod::Escapes::VERSION; # Presumably that's the library being used &is( e "", "" ); &is( e "\n", "", ); print "# Testing some basic mnemonic E sequences...\n"; &is( Pod::Simple::XMLOutStream->_out("=pod\n\n1E2\n"), Pod::Simple::XMLOutStream->_out("=pod\n\n1<2") ); &is( Pod::Simple::XMLOutStream->_out("=pod\n\n1E2\n"), Pod::Simple::XMLOutStream->_out("=pod\n\n1>2") ); &is( Pod::Simple::XMLOutStream->_out("=pod\n\n1E2\n"), Pod::Simple::XMLOutStream->_out("=pod\n\n1|2") ); &is( Pod::Simple::XMLOutStream->_out("=pod\n\n1E2\n"), Pod::Simple::XMLOutStream->_out("=pod\n\n1/2\n") ); print "# Testing some more mnemonic E sequences...\n"; &is( Pod::Simple::XMLOutStream->_out("=pod\n\n1E2\n"), Pod::Simple::XMLOutStream->_out("=pod\n\n1'2") ); &is( Pod::Simple::XMLOutStream->_out("=pod\n\n1E2\n"), Pod::Simple::XMLOutStream->_out("=pod\n\n1\"2") ); &is( Pod::Simple::XMLOutStream->_out("=pod\n\n1&2"), Pod::Simple::XMLOutStream->_out("=pod\n\n1E2\n") ); &is( Pod::Simple::XMLOutStream->_out("=pod\n\n1E2"), Pod::Simple::XMLOutStream->_out("=pod\n\n1E<233>2\n") ); &is( Pod::Simple::XMLOutStream->_out("=pod\n\n1E2"), Pod::Simple::XMLOutStream->_out("=pod\n\n1E<8734>2\n") ); &is( Pod::Simple::XMLOutStream->_out("=pod\n\n1E2"), Pod::Simple::XMLOutStream->_out("=pod\n\n1E<171>2\n") ); &is( Pod::Simple::XMLOutStream->_out("=pod\n\n1E2"), Pod::Simple::XMLOutStream->_out("=pod\n\n1E<187>2\n") ); &is( Pod::Simple::XMLOutStream->_out("=pod\n\n1E2"), Pod::Simple::XMLOutStream->_out("=pod\n\n1E<171>2\n") ); &is( Pod::Simple::XMLOutStream->_out("=pod\n\n1E2"), Pod::Simple::XMLOutStream->_out("=pod\n\n1E<187>2\n") ); print "# Testing numeric E sequences...\n"; &is( Pod::Simple::XMLOutStream->_out("=pod\n\n1E<0101>2\n"), Pod::Simple::XMLOutStream->_out("=pod\n\n1A2") ); &is( Pod::Simple::XMLOutStream->_out("=pod\n\n1E<65>2\n"), Pod::Simple::XMLOutStream->_out("=pod\n\n1A2") ); &is( Pod::Simple::XMLOutStream->_out("=pod\n\n1E<0x41>2\n"), Pod::Simple::XMLOutStream->_out("=pod\n\n1A2") ); Pod-Simple-3.45/t/rtf_utf8.t0000644000175000017500000001532714243763540013773 0ustar khwkhw# t/rtf_utf8.t - Check that RTF works with UTF-8 input use strict; use warnings; use Test::More; if ($] < 5.008) { plan skip_all => "Doesn't work before 5.8"; } else { plan tests => 5; } use File::Spec; use Cwd (); use File::Basename (); my $t_dir = File::Basename::dirname(Cwd::abs_path(__FILE__)); my $expected = join "", ; for my $format (qw(RTF)) { my $class = "Pod::Simple::RTF"; use_ok $class or next; ok my $parser = $class->new, "Construct RTF parser"; my $output = ''; ok $parser->output_string(\$output), "Set RTF output string"; ok $parser->parse_file(File::Spec->catfile($t_dir, qw(corpus polish_utf8.txt))), "Parse to RTF via parse_file()"; $output =~ s/\\info.*?author \[see doc\]\}/VARIANT TEXT DELETED/s; $output =~ s/$/\n/; my $msg = "got expected output"; if ($output eq $expected) { pass($msg); } elsif ($ENV{PERL_TEST_DIFF}) { fail($msg); require File::Temp; my $orig_file = File::Temp->new(); local $/ = "\n"; chomp $expected; print $orig_file $expected, "\n"; close $orig_file || die "Can't close orig_file: $!"; chomp $output; my $parsed_file = File::Temp->new(); print $parsed_file $output, "\n"; close $parsed_file || die "Can't close parsed_file"; my $diff = File::Temp->new(); system("$ENV{PERL_TEST_DIFF} $orig_file $parsed_file > $diff"); open my $fh, "<", $diff || die "Can't open $diff"; my @diffs = <$fh>; diag(@diffs); } else { eval { require Text::Diff; }; if ($@) { is($output, $expected, $msg); diag("Set environment variable PERL_TEST_DIFF=diff_tool or install" . " Text::Diff to see just the differences."); } else { fail($msg); diag Text::Diff::diff(\$expected, \$output, { STYLE => 'Unified' }); } } } __DATA__ {\rtf1\ansi\deff0 {\fonttbl {\f0\froman Times New Roman;} {\f1\fmodern Courier New;} {\f2\fswiss Arial;} } {\stylesheet {\snext0 Normal;} {\*\cs10 \additive Default Paragraph Font;} {\*\cs16 \additive \i \sbasedon10 pod-I;} {\*\cs17 \additive \i\lang1024\noproof \sbasedon10 pod-F;} {\*\cs18 \additive \b \sbasedon10 pod-B;} {\*\cs19 \additive \f1\lang1024\noproof\sbasedon10 pod-C;} {\s20\ql \li0\ri0\sa180\widctlpar\f1\fs18\lang1024\noproof\sbasedon0 \snext0 pod-codeblock;} {\*\cs21 \additive \lang1024\noproof \sbasedon10 pod-computerese;} {\*\cs22 \additive \i\lang1024\noproof\sbasedon10 pod-L-pod;} {\*\cs23 \additive \i\lang1024\noproof\sbasedon10 pod-L-url;} {\*\cs24 \additive \i\lang1024\noproof\sbasedon10 pod-L-man;} {\*\cs25 \additive \f1\lang1024\noproof\sbasedon0 pod-codelbock-plain;} {\*\cs26 \additive \f1\lang1024\noproof\sbasedon25 pod-codelbock-ital;} {\*\cs27 \additive \f1\lang1024\noproof\sbasedon25 pod-codelbock-bold;} {\*\cs28 \additive \f1\lang1024\noproof\sbasedon25 pod-codelbock-bold-ital;} {\s31\ql \keepn\sb90\sa180\f2\fs32\ul\sbasedon0 \snext0 pod-head1;} {\s32\ql \keepn\sb90\sa180\f2\fs28\ul\sbasedon0 \snext0 pod-head2;} {\s33\ql \keepn\sb90\sa180\f2\fs25\ul\sbasedon0 \snext0 pod-head3;} {\s34\ql \keepn\sb90\sa180\f2\fs22\ul\sbasedon0 \snext0 pod-head4;} } {\colortbl;\red255\green0\blue0;\red0\green0\blue255;} {VARIANT TEXT DELETED{\company [see doc]}{\operator [see doc]} } \deflang1033\plain\lang1033\widowctrl {\header\pard\qr\plain\f2\fs17 W\uc1\u346?R\'d3D NOCNEJ CISZY \_\_ explicitly utf8 test document in Polish, p.\chpgn\par} \fs25 {\pard\li0\s31\keepn\sb90\sa180\f2\fs32\ul{ NAME }\par} {\pard\li0\sa180 W\uc1\u346?R\'d3D NOCNEJ CISZY \_\_ explicitly utf8 test document in Polish \par} {\pard\li0\s31\keepn\sb90\sa180\f2\fs32\ul{ DESCRIPTION }\par} {\pard\li0\sa180 This is a test Pod document in UT\'468. Its content is the lyrics to the Polish Christmas carol "W\uc1\u347?r\'f3d nocnej ciszy", except it includes a few lines to test RT\'46 specially. \par} {\pard\li0\sa180 \uc1\u-1280? is a character in the upper half of Plane 0, so should be negative in RT\'46 \uc1\u-10187\u-8904? is a character in Plane 1, so should be expressed as a surrogate pair in RT\'46 \par} {\pard\li0\sa180 All the ASCII printables !"#$%&\'5c'()*+,\_./0123456789:;<=>?@ ABCDE\'46GHIJKLMNOPQRSTUVWXYZ[{ \cs21\lang1024\noproof \'5c]^\'5f`} abcdefghijklmnopqrstuvwxyz\'7b|\'7d~ \par} {\pard\li0\sa180 W\uc1\u347?r\'f3d nocnej ciszy g\uc1\u322?os si\uc1\u281? rozchodzi: / Wsta\uc1\u324?cie, pasterze, B\'f3g si\uc1\u281? nam rodzi! / Czym pr\uc1\u281?dzej si\uc1\u281? wybierajcie, / Do Betlejem pospieszajcie / Przywita\uc1\u263? Pana. \par} {\pard\li0\sa180 Poszli, znale\uc1\u378?li Dzieci\uc1\u261?tko w \uc1\u380?\uc1\u322?obie / Z wszystkimi znaki danymi sobie. / Jako Bogu cze\uc1\u347?\uc1\u263? Mu dali, / A witaj\uc1\u261?c zawo\uc1\u322?ali / Z wielkiej rado\uc1\u347?ci: \par} {\pard\li0\sa180 Ach, witaj Zbawco z dawno \uc1\u380?\uc1\u261?dany, / Wiele tysi\uc1\u281?cy lat wygl\uc1\u261?dany / Na Ciebie kr\'f3le, prorocy / Czekali, a Ty\uc1\u347? tej nocy / Nam si\uc1\u281? objawi\uc1\u322?. \par} {\pard\li0\sa180 I my czekamy na Ciebie, Pana, / A skoro przyjdziesz na g\uc1\u322?os kap\uc1\u322?ana, / Padniemy na twarz przed Tob\uc1\u261?, / Wierz\uc1\u261?c, \uc1\u380?e\uc1\u347? jest pod os\uc1\u322?on\uc1\u261? / Chleba i wina. \par} {\pard\li0\s32\keepn\sb90\sa180\f2\fs28\ul{ As Verbatim }\par} {\pard\li0\sa180 And now as verbatim text: \par} {\pard\li0\plain\s20\sa180\f1\fs18\lang1024\noproof \uc1\u-1280? upper half, Plane 0\line \uc1\u-10187\u-8904? Plane 1\line \line All the ASCII printables\line !"#$%&\'5c'()*+,-./0123456789:;<=>?@\line ABCDE\'46GHIJKLMNOPQRSTUVWXYZ[\'5c]^\'5f`\line abcdefghijklmnopqrstuvwxyz\'7b|\'7d~\line \line W\uc1\u347?r\'f3d nocnej ciszy g\uc1\u322?os si\uc1\u281? rozchodzi:\line Wsta\uc1\u324?cie, pasterze, B\'f3g si\uc1\u281? nam rodzi!\line Czym pr\uc1\u281?dzej si\uc1\u281? wybierajcie,\line Do Betlejem pospieszajcie\line Przywita\uc1\u263? Pana.\line \line Poszli, znale\uc1\u378?li Dzieci\uc1\u261?tko w \uc1\u380?\uc1\u322?obie\line Z wszystkimi znaki danymi sobie.\line Jako Bogu cze\uc1\u347?\uc1\u263? Mu dali,\line A witaj\uc1\u261?c zawo\uc1\u322?ali\line Z wielkiej rado\uc1\u347?ci:\line \line Ach, witaj Zbawco z dawno \uc1\u380?\uc1\u261?dany,\line Wiele tysi\uc1\u281?cy lat wygl\uc1\u261?dany\line Na Ciebie kr\'f3le, prorocy\line Czekali, a Ty\uc1\u347? tej nocy\line Nam si\uc1\u281? objawi\uc1\u322?.\line \line I my czekamy na Ciebie, Pana,\line A skoro przyjdziesz na g\uc1\u322?os kap\uc1\u322?ana,\line Padniemy na twarz przed Tob\uc1\u261?,\line Wierz\uc1\u261?c, \uc1\u380?e\uc1\u347? jest pod os\uc1\u322?on\uc1\u261?\line Chleba i wina. \par} {\pard\li0\sa180 [end] \par} } Pod-Simple-3.45/t/closeys.t0000644000175000017500000000111614243763554013707 0ustar khwkhwuse strict; use warnings; use Test::More tests => 1; BEGIN { require FindBin; unshift @INC, $FindBin::Bin . '/lib'; } use helpers qw(f); my $d; #use Pod::Simple::Debug (\$d,0); #use Pod::Simple::Debug (10); use Pod::Simple::DumpAsXML; use Pod::Simple::XMLOutStream; print "# Pod::Simple version $Pod::Simple::VERSION\n"; sub nowhine { # $_[0]->{'no_whining'} = 1; $_[0]->accept_targets("*"); } local $Pod::Simple::XMLOutStream::SORT_ATTRS = 1; &is(f( \&nowhine, "=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", )); Pod-Simple-3.45/t/corpus.t0000644000175000017500000000633014243763554013544 0ustar khwkhw# Testing a corpus of Pod files use strict; use warnings; BEGIN { use Config; if ($Config::Config{'extensions'} !~ /\bEncode\b/) { print "1..0 # Skip: Encode was not built\n"; exit 0; } if (ord("A") != 65) { print "1..0 # Skip: Encode not fully working on non-ASCII platforms at this time\n"; exit 0; } } #use Pod::Simple::Debug (10); use Test::More; use File::Spec; use Cwd (); use File::Basename (); my(@testfiles, %xmlfiles, %wouldxml); #use Pod::Simple::Debug (10); BEGIN { my $corpusdir = File::Spec->catdir(File::Basename::dirname(Cwd::abs_path(__FILE__)), 'corpus'); print "#Corpusdir: $corpusdir\n"; opendir(INDIR, $corpusdir) or die "Can't opendir corpusdir : $!"; my @f = map File::Spec::->catfile($corpusdir, $_), readdir(INDIR); closedir(INDIR); my %f; @f{@f} = (); foreach my $maybetest (sort @f) { my $xml = $maybetest; $xml =~ s/\.(txt|pod)$/\.xml/is or next; $wouldxml{$maybetest} = $xml; push @testfiles, $maybetest; foreach my $x ($xml, uc($xml), lc($xml)) { next unless exists $f{$x}; $xmlfiles{$maybetest} = $x; last; } } die "Too few test files (".@testfiles.")" unless @ARGV or @testfiles > 20; @testfiles = @ARGV if @ARGV and !grep !m/\.txt/, @ARGV; plan tests => (2*@testfiles - 1); } my $HACK = 1; #@testfiles = ('nonesuch.txt'); my $skippy = ($] < 5.008) ? "skip because perl ($]) pre-dates v5.8.0" : 0; if($skippy) { print "# This is just perl v$], so I'm skipping many many tests.\n"; } { my @x = @testfiles; print "# Files to test:\n"; while(@x) { print "# ", join(' ', splice @x,0,3), "\n" } } require Pod::Simple::DumpAsXML; foreach my $f (@testfiles) { my $xml = $xmlfiles{$f}; if($xml) { print "#\n#To test $f against $xml\n"; } else { print "#\n# $f has no xml to test it against\n"; } my $outstring; eval { my $p = Pod::Simple::DumpAsXML->new; $p->output_string( \$outstring ); $p->parse_file( $f ); undef $p; }; if($@) { my $x = "#** Couldn't parse $f:\n $@"; $x =~ s/([\n\r]+)/\n#** /g; print $x, "\n"; ok 0; ok 0; next; } else { print "# OK, parsing $f generated ", length($outstring), " bytes\n"; ok 1; } die "Null outstring?" unless $outstring; next if $f =~ /nonesuch/; my $outfilename = ($HACK > 1) ? $wouldxml{$f} : "$wouldxml{$f}\_out"; if($HACK) { open OUT, ">$outfilename" or die "Can't write-open $outfilename: $!\n"; binmode(OUT); print OUT $outstring; close(OUT); } unless($xml) { print "# (no comparison done)\n"; ok 1; next; } open(IN, "<$xml") or die "Can't read-open $xml: $!"; #binmode(IN); local $/; my $xmlsource = ; close(IN); print "# There's errata!\n" if $outstring =~ m/start_line="-321"/; if( $xmlsource eq $outstring or do { $xmlsource =~ s/[\n\r]+/\n/g; $outstring =~ s/[\n\r]+/\n/g; $xmlsource eq $outstring; } ) { print "# (Perfect match to $xml)\n"; unlink $outfilename unless $outfilename =~ m/\.xml$/is; ok 1; next; } if($skippy) { skip $skippy, 0; } else { print STDERR "# $outfilename and $xml don't match!\n"; print STDERR `diff $xml $outfilename`; ok 0; } } Pod-Simple-3.45/t/search26.t0000644000175000017500000000250114243763554013642 0ustar khwkhwuse strict; use warnings; use Pod::Simple::Search; use Test::More tests => 3; # # "kleene" rhymes with "zany". It's a fact! # print "# ", __FILE__, ": Testing limit_glob ...\n"; my $x = Pod::Simple::Search->new; die "Couldn't make an object!?" unless ok defined $x; $x->inc(0); $x->shadows(1); use File::Spec; use Cwd (); use File::Basename (); my $t_dir = File::Basename::dirname(Cwd::abs_path(__FILE__)); my $here1 = File::Spec->catdir($t_dir, 'testlib1'); my $here2 = File::Spec->catdir($t_dir, 'testlib2'); my $here3 = File::Spec->catdir($t_dir, 'testlib3'); print "# OK, found the test corpora\n# as $here1\n# and $here2\n# and $here3\n#\n"; print $x->_state_as_string; #$x->verbose(12); use Pod::Simple; *pretty = \&Pod::Simple::BlackBox::pretty; my $glob = '*k'; print "# Limiting to $glob\n"; $x->limit_glob($glob); my($name2where, $where2name) = $x->survey($here1, $here2, $here3); my $p = pretty( $where2name, $name2where )."\n"; $p =~ s/, +/,\n/g; $p =~ s/^/# /mg; print $p; require File::Spec->catfile($t_dir, 'ascii_order.pl'); { my $names = join "|", sort ascii_order keys %$name2where; is $names, "Zonk::Pronk|hinkhonk::Glunk|perlzuk|squaa::Glunk|zikzik"; } { my $names = join "|", sort ascii_order values %$where2name; is $names, "Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Glunk|perlzuk|squaa::Glunk|zikzik"; } Pod-Simple-3.45/t/eol.t0000644000175000017500000000416314243763540013005 0ustar khwkhw# t/eol.t - check handling of \r, \n, and \r\n as line separators use strict; use warnings; use Test::More tests => 7; use_ok('Pod::Simple::XHTML') or exit; open(POD, ">$$.pod") or die "$$.pod: $!"; print POD <<__EOF__; =pod =head1 NAME crlf =head1 DESCRIPTION crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf =cut __EOF__ close(POD); # --- CR --- my $p1 = Pod::Simple::XHTML->new (); isa_ok ($p1, 'Pod::Simple::XHTML'); open(POD, "<$$.pod") or die "$$.pod: $!"; open(IN, ">$$.in") or die "$$.in: $!"; while () { s/[\r\n]+/\r/g; print IN $_; } close(POD); close(IN); $p1->output_string(\my $o1); $p1->parse_file("$$.in"); # --- LF --- my $p2 = Pod::Simple::XHTML->new (); isa_ok ($p2, 'Pod::Simple::XHTML'); open(POD, "<$$.pod") or die "$$.pod: $!"; open(IN, ">$$.in") or die "$$.in: $!"; while () { s/[\r\n]+/\n/g; print IN $_; } close(POD); close(IN); $p2->output_string(\my $o2); $p2->parse_file("$$.in"); # --- CRLF --- my $p3 = Pod::Simple::XHTML->new (); isa_ok ($p3, 'Pod::Simple::XHTML'); open(POD, "<$$.pod") or die "$$.pod: $!"; open(IN, ">$$.in") or die "$$.in: $!"; while () { s/[\r\n]+/\r\n/g; print IN $_; } close(POD); close(IN); $p3->output_string(\my $o3); $p3->parse_file("$$.in"); # --- now test --- my $cksum1 = unpack("%32C*", $o1); my $cksum2 = unpack("%32C*", $o2); my $cksum3 = unpack("%32C*", $o3); ok($cksum1 == $cksum2, "CR vs LF"); ok($cksum1 == $cksum3, "CR vs CRLF"); ok($cksum2 == $cksum3, "LF vs CRLF"); END { 1 while unlink("$$.pod", "$$.in"); } Pod-Simple-3.45/t/html03.t0000644000175000017500000000110114243763554013327 0ustar khwkhw# Testing HTML titles use strict; use warnings; use Test::More tests => 5; #use Pod::Simple::Debug (10); use Pod::Simple::HTML; sub x { Pod::Simple::HTML->_out( #sub{ $_[0]->bare_output(1) }, "=pod\n\n$_[0]", ) } # make sure empty file => empty output is( x(''),'', "Contentlessness" ); like( x(qq{=pod\n\nThis is a paragraph}), qr{}i ); like( x(qq{This is a paragraph}), qr{}i ); like( x(qq{=head1 Prok\n\nThis is a paragraph}), qr{Prok}i ); like( x(qq{=head1 NAME\n\nProk -- stuff\n\nThis}), qr{Prok} ); Pod-Simple-3.45/t/xhtml15.t0000644000175000017500000000166214243763540013531 0ustar khwkhw# t/xhtml15.t - test compatibility between Pod::Simple::XHTML and # Pod::Simple::HtmlBatch use strict; use warnings; use Test::More tests => 4; use_ok('Pod::Simple::XHTML') or exit; my ($parser, $results); initialize(); my $style = 'http://amazingpants.com/style.css'; $parser->html_css($style); $parser->parse_string_document( '=head1 Foo' ); like $results, qr/ href="$style" /, 'CSS is correct when link is passed in'; initialize(); my $link = qq{}; $parser->html_css($link); $parser->parse_string_document( '=head1 Foo' ); like $results, qr/ href="$style" /, 'CSS is correct when is passed in'; #note('These methods are called when XHTML is used by HtmlBatch'); can_ok $parser, qw/batch_mode_page_object_init html_header_after_title/; sub initialize { $parser = Pod::Simple::XHTML->new; $parser->index(1); $parser->output_string( \$results ); $results = ''; } Pod-Simple-3.45/t/search27.t0000644000175000017500000000377314243763554013657 0ustar khwkhwuse strict; use warnings; use Pod::Simple::Search; use Test::More tests => 8; print "# ", __FILE__, ": Testing limit_glob ...\n"; my $x = Pod::Simple::Search->new; die "Couldn't make an object!?" unless ok defined $x; $x->inc(0); $x->shadows(1); use File::Spec; use Cwd (); use File::Basename (); my $t_dir = File::Basename::dirname(Cwd::abs_path(__FILE__)); my $here1 = File::Spec->catdir($t_dir, 'testlib1'); my $here2 = File::Spec->catdir($t_dir, 'testlib2'); my $here3 = File::Spec->catdir($t_dir, 'testlib3'); print "# OK, found the test corpora\n# as $here1\n# and $here2\n# and $here3\n#\n"; print $x->_state_as_string; #$x->verbose(12); use Pod::Simple; *pretty = \&Pod::Simple::BlackBox::pretty; my $glob = 'squaa*'; print "# Limiting to $glob\n"; $x->limit_glob($glob); my($name2where, $where2name) = $x->survey($here1, $here2, $here3); my $p = pretty( $where2name, $name2where )."\n"; $p =~ s/, +/,\n/g; $p =~ s/^/# /mg; print $p; SKIP: { skip '-- case may or may not be preserved', 2 if $^O eq 'VMS'; { my $names = join "|", sort keys %$name2where; is $names, "squaa|squaa::Glunk|squaa::Vliff|squaa::Wowo"; } { my $names = join "|", sort values %$where2name; is $names, "squaa|squaa::Glunk|squaa::Vliff|squaa::Vliff|squaa::Vliff|squaa::Wowo"; } } my %count; for(values %$where2name) { ++$count{$_} }; #print pretty(\%count), "\n\n"; delete @count{ grep $count{$_} < 2, keys %count }; my $shadowed = join "|", sort keys %count; ok $shadowed, "squaa::Vliff"; sub thar { print "# Seen $_[0] :\n", map "# {$_}\n", sort grep $where2name->{$_} eq $_[0],keys %$where2name; return; } is $count{'squaa::Vliff'}, 3; thar 'squaa::Vliff'; ok $name2where->{'squaa'}; # because squaa.pm IS squaa* like( ($name2where->{'squaa::Vliff'} || 'huh???'), qr/[^\^]testlib1/ ); SKIP: { skip '-- case may or may not be preserved', 1 if $^O eq 'VMS'; like +($name2where->{'squaa::Wowo'} || 'huh???'), qr/testlib2/; } Pod-Simple-3.45/t/junk2o.txt0000644000175000017500000000037314243754136014012 0ustar khwkhwpie is nice E POD ERRORS Hey! The above document had some coding errors, which are explained below: Around line 2: Unknown directive: =head9 Around line 4: Unterminated B<...> sequence Around line 6: Unknown E content in E Pod-Simple-3.45/t/perlcygo.txt0000644000175000017500000004520714243754136014433 0ustar khwkhwNAME README.cygwin - Perl for Cygwin SYNOPSIS This document will help you configure, make, test and install Perl on Cygwin. This document also describes features of Cygwin that will affect how Perl behaves at runtime. NOTE: There are pre-built Perl packages available for Cygwin and a version of Perl is provided on the Cygwin CD. If you do not need to customize the configuration, consider using one of these packages: http://cygutils.netpedia.net/ PREREQUISITES Cygwin = GNU+Cygnus+Windows (Don't leave UNIX without it) The Cygwin tools are ports of the popular GNU development tools for Win32 platforms. They run thanks to the Cygwin library which provides the UNIX system calls and environment these programs expect. More information about this project can be found at: http://www.cygwin.com/ A recent net or commercial release of Cygwin is required. At the time this document was last updated, Cygwin 1.1.5 was current. NOTE: At this point, minimal effort has been made to provide compatibility with old (beta) Cygwin releases. The focus has been to provide a high quality release and not worry about working around old bugs. If you wish to use Perl with Cygwin B20.1 or earlier, consider using perl5.005_03, which is available in source and binary form at http://cygutils.netpedia.net/. If there is significant demand, a patch kit can be developed to port back to earlier Cygwin versions. Cygwin Configuration While building Perl some changes may be necessary to your Cygwin setup so that Perl builds cleanly. These changes are not required for normal Perl usage. NOTE: The binaries that are built will run on all Win32 versions. They do not depend on your host system (Win9x/WinME, WinNT/Win2K) or your Cygwin configuration (ntea, ntsec, binary/text mounts). The only dependencies come from hard-coded pathnames like /usr/local. However, your host system and Cygwin configuration will affect Perl's runtime behavior (see "TEST"). PATH Set the PATH environment variable so that Configure finds the Cygwin versions of programs. Any Windows directories should be removed or moved to the end of your PATH. nroff If you do not have nroff (which is part of the groff package), Configure will not prompt you to install man pages. Permissions On WinNT with either the ntea or ntsec CYGWIN settings, directory and file permissions may not be set correctly. Since the build process creates directories and files, to be safe you may want to run a `chmod -R +w *' on the entire Perl source tree. Also, it is a well known WinNT "feature" that files created by a login that is a member of the Administrators group will be owned by the Administrators group. Depending on your umask, you may find that you can not write to files that you just created (because you are no longer the owner). When using the ntsec CYGWIN setting, this is not an issue because it "corrects" the ownership to what you would expect on a UNIX system. CONFIGURE The default options gathered by Configure with the assistance of hints/cygwin.sh will build a Perl that supports dynamic loading (which requires a shared libperl.dll). This will run Configure and keep a record: ./Configure 2>&1 | tee log.configure If you are willing to accept all the defaults run Configure with -de. However, several useful customizations are available. Strip Binaries It is possible to strip the EXEs and DLLs created by the build process. The resulting binaries will be significantly smaller. If you want the binaries to be stripped, you can either add a -s option when Configure prompts you, Any additional ld flags (NOT including libraries)? [none] -s Any special flags to pass to gcc to use dynamic linking? [none] -s Any special flags to pass to ld2 to create a dynamically loaded library? [none] -s or you can edit hints/cygwin.sh and uncomment the relevant variables near the end of the file. Optional Libraries Several Perl functions and modules depend on the existence of some optional libraries. Configure will find them if they are installed in one of the directories listed as being used for library searches. Pre-built packages for most of these are available at http://cygutils.netpedia.net/. -lcrypt The crypt package distributed with Cygwin is a Linux compatible 56-bit DES crypt port by Corinna Vinschen. Alternatively, the crypt libraries in GNU libc have been ported to Cygwin. The DES based Ultra Fast Crypt port was done by Alexey Truhan: ftp://ftp.franken.de/pub/win32/develop/gnuwin32/cygwin/porters/Okhapkin_Sergey/cw32crypt-dist-0.tgz NOTE: There are various export restrictions on DES implementations, see the glibc README for more details. The MD5 port was done by Andy Piper: ftp://ftp.franken.de/pub/win32/develop/gnuwin32/cygwin/porters/Okhapkin_Sergey/libcrypt.tgz -lgdbm (use GDBM_File) GDBM is available for Cygwin. GDBM's ndbm/dbm compatibility feature also makes NDBM_File and ODBM_File possible (although they add little extra value). NOTE: The ndbm/dbm emulations only completely work on NTFS partitions. -ldb (use DB_File) BerkeleyDB is available for Cygwin. Some details can be found in ext/DB_File/DB_File.pm. NOTE: The BerkeleyDB library only completely works on NTFS partitions. -lcygipc (use IPC::SysV) A port of SysV IPC is available for Cygwin. NOTE: This has not been extensively tested. In particular, d_semctl_semun is undefined because it fails a Configure test and on Win9x the shm*() functions seem to hang. It also creates a compile time dependency because perl.h includes and (which will be required in the future when compiling CPAN modules). Configure-time Options The INSTALL document describes several Configure-time options. Some of these will work with Cygwin, others are not yet possible. Also, some of these are experimental. You can either select an option when Configure prompts you or you can define (undefine) symbols on the command line. -Uusedl Undefining this symbol forces Perl to be compiled statically. -Uusemymalloc By default Perl uses the malloc() included with the Perl source. If you want to force Perl to build with the system malloc() undefine this symbol. -Dusemultiplicity Multiplicity is required when embedding Perl in a C program and using more than one interpreter instance. This works with the Cygwin port. -Duseperlio The PerlIO abstraction works with the Cygwin port. -Duse64bitint gcc supports 64-bit integers. However, several additional long long functions are necessary to use them within Perl ({strtol,strtoul}l). These are not yet available with Cygwin. -Duselongdouble gcc supports long doubles (12 bytes). However, several additional long double math functions are necessary to use them within Perl ({atan2,cos,exp,floor,fmod,frexp,isnan,log,modf,pow,sin,sqrt}l,strtold). These are not yet available with Cygwin. -Dusethreads POSIX threads are not yet implemented in Cygwin. -Duselargefiles Although Win32 supports large files, Cygwin currently uses 32-bit integers for internal size and position calculations. Suspicious Warnings You may see some messages during Configure that seem suspicious. dlsym() ld2 is needed to build dynamic libraries, but it does not exist when dlsym() checking occurs (it is not created until `make' runs). You will see the following message: Checking whether your dlsym() needs a leading underscore ... ld2: not found I can't compile and run the test program. I'm guessing that dlsym doesn't need a leading underscore. Since the guess is correct, this is not a problem. Win9x and d_eofnblk Win9x does not correctly report EOF with a non-blocking read on a closed pipe. You will see the following messages: But it also returns -1 to signal EOF, so be careful! WARNING: you can't distinguish between EOF and no data! *** WHOA THERE!!! *** The recommended value for $d_eofnblk on this machine was "define"! Keep the recommended value? [y] At least for consistency with WinNT, you should keep the recommended value. Compiler/Preprocessor defines The following error occurs because of the Cygwin #define of _LONG_DOUBLE: Guessing which symbols your C compiler and preprocessor define... try.c:: parse error This failure does not seem to cause any problems. MAKE Simply run make and wait: make 2>&1 | tee log.make Warnings Warnings like these are normal: warning: overriding commands for target warning: ignoring old commands for target dllwrap: no export definition file provided dllwrap: creating one, but that may not be what you want ld2 During `make', ld2 will be created and installed in your $installbin directory (where you said to put public executables). It does not wait until the `make install' process to install the ld2 script, this is because the remainder of the `make' refers to ld2 without fully specifying its path and does this from multiple subdirectories. The assumption is that $installbin is in your current PATH. If this is not the case `make' will fail at some point. If this happens, just manually copy ld2 from the source directory to somewhere in your PATH. TEST There are two steps to running the test suite: make test 2>&1 | tee log.make-test cd t;./perl harness 2>&1 | tee ../log.harness The same tests are run both times, but more information is provided when running as `./perl harness'. Test results vary depending on your host system and your Cygwin configuration. If a test can pass in some Cygwin setup, it is always attempted and explainable test failures are documented. It is possible for Perl to pass all the tests, but it is more likely that some tests will fail for one of the reasons listed below. File Permissions UNIX file permissions are based on sets of mode bits for {read,write,execute} for each {user,group,other}. By default Cygwin only tracks the Win32 read-only attribute represented as the UNIX file user write bit (files are always readable, files are executable if they have a .{com,bat,exe} extension or begin with #!, directories are always readable and executable). On WinNT with the ntea CYGWIN setting, the additional mode bits are stored as extended file attributes. On WinNT with the ntsec CYGWIN setting, permissions use the standard WinNT security descriptors and access control lists. Without one of these options, these tests will fail: Failed Test List of failed ------------------------------------ io/fs.t 5, 7, 9-10 lib/anydbm.t 2 lib/db-btree.t 20 lib/db-hash.t 16 lib/db-recno.t 18 lib/gdbm.t 2 lib/ndbm.t 2 lib/odbm.t 2 lib/sdbm.t 2 op/stat.t 9, 20 (.tmp not an executable extension) Hard Links FAT partitions do not support hard links (whereas NTFS does), in which case Cygwin implements link() by copying the file. On remote (network) drives Cygwin's stat() always sets st_nlink to 1, so the link count for remote directories and files is not available. In either case, these tests will fail: Failed Test List of failed ------------------------------------ io/fs.t 4 op/stat.t 3 Filetime Granularity On FAT partitions the filetime granularity is 2 seconds. The following test will fail: Failed Test List of failed ------------------------------------ io/fs.t 18 Tainting Checks When Perl is running in taint mode, $ENV{PATH} is considered tainted and not used, so DLLs not in the default system directories will not be found. While the tests are running you will see warnings popup from the system with messages like: Win9x Error Starting Program A required .DLL file, CYGWIN1.DLL, was not found WinNT perl.exe - Unable to Locate DLL The dynamic link library cygwin1.dll could not be found in the specified path ... Just click OK and ignore them. When running `make test', 2 popups occur. During `./perl harness', 4 popups occur. Also, these tests will fail: Failed Test List of failed ------------------------------------ op/taint.t 1, 3, 31, 37 Alternatively, you can copy cygwin1.dll into the directory where the tests run: cp /bin/cygwin1.dll t or one of the Windows system directories (although, this is not recommended). /etc/group Cygwin does not require /etc/group, in which case the op/grent.t test will be skipped. The check performed by op/grent.t expects to see entries that use the members field, otherwise this test will fail: Failed Test List of failed ------------------------------------ op/grent.t 1 Script Portability Cygwin does an outstanding job of providing UNIX-like semantics on top of Win32 systems. However, in addition to the items noted above, there are some differences that you should know about. This is a very brief guide to portability, more information can be found in the Cygwin documentation. Pathnames Cygwin pathnames can be separated by forward (/) or backward (\) slashes. They may also begin with drive letters (C:) or Universal Naming Codes (//UNC). DOS device names (aux, con, prn, com*, lpt?, nul) are invalid as base filenames. However, they can be used in extensions (e.g., hello.aux). Names may contain all printable characters except these: : * ? " < > | File names are case insensitive, but case preserving. A pathname that contains a backslash or drive letter is a Win32 pathname (and not subject to the translations applied to POSIX style pathnames). Text/Binary When a file is opened it is in either text or binary mode. In text mode a file is subject to CR/LF/Ctrl-Z translations. With Cygwin, the default mode for an open() is determined by the mode of the mount that underlies the file. Perl provides a binmode() function to set binary mode on files that otherwise would be treated as text. sysopen() with the O_TEXT flag sets text mode on files that otherwise would be treated as binary: sysopen(FOO, "bar", O_WRONLY|O_CREAT|O_TEXT) lseek(), tell() and sysseek() only work with files opened in binary mode. The text/binary issue is covered at length in the Cygwin documentation. .exe The Cygwin stat(), lstat() and readlink() functions make the .exe extension transparent by looking for foo.exe when you ask for foo (unless a foo also exists). Cygwin does not require a .exe extension, but gcc adds it automatically when building a program. However, when accessing an executable as a normal file (e.g., cp in a makefile) the .exe is not transparent. The install included with Cygwin automatically appends a .exe when necessary. chown() On WinNT chown() can change a file's user and group IDs. On Win9x chown() is a no-op, although this is appropriate since there is no security model. Miscellaneous File locking using the F_GETLK command to fcntl() is a stub that returns ENOSYS. Win9x can not rename() an open file (although WinNT can). The Cygwin chroot() implementation has holes (it can not restrict file access by native Win32 programs). INSTALL This will install Perl, including man pages. make install | tee log.make-install NOTE: If STDERR is redirected `make install' will not prompt you to install perl into /usr/bin. You may need to be Administrator to run `make install'. If you are not, you must have write access to the directories in question. Information on installing the Perl documentation in HTML format can be found in the INSTALL document. MANIFEST These are the files in the Perl release that contain references to Cygwin. These very brief notes attempt to explain the reason for all conditional code. Hopefully, keeping this up to date will allow the Cygwin port to be kept as clean as possible. Documentation INSTALL README.cygwin README.win32 MANIFEST Changes Changes5.005 Changes5.004 Changes5.6 pod/perl.pod pod/perlport.pod pod/perlfaq3.pod pod/perldelta.pod pod/perl5004delta.pod pod/perl56delta.pod pod/perlhist.pod pod/perlmodlib.pod pod/buildtoc.PL pod/perltoc.pod Build, Configure, Make, Install cygwin/Makefile.SHs cygwin/ld2.in cygwin/perlld.in ext/IPC/SysV/hints/cygwin.pl ext/NDBM_File/hints/cygwin.pl ext/ODBM_File/hints/cygwin.pl hints/cygwin.sh Configure - help finding hints from uname, shared libperl required for dynamic loading Makefile.SH - linklibperl Porting/patchls - cygwin in port list installman - man pages with :: translated to . installperl - install dll/ld2/perlld, install to pods makedepend.SH - uwinfix Tests t/io/tell.t - binmode t/lib/b.t - ignore Cwd from os_extras t/lib/glob-basic.t - Win32 directory list access differs from read mode t/op/magic.t - $^X/symlink WORKAROUND, s/.exe// t/op/stat.t - no /dev, skip Win32 ftCreationTime quirk (cache manager sometimes preserves ctime of file previously created and deleted), no -u (setuid) Compiled Perl Source EXTERN.h - __declspec(dllimport) XSUB.h - __declspec(dllexport) cygwin/cygwin.c - os_extras (getcwd, spawn) perl.c - os_extras perl.h - binmode doio.c - win9x can not rename a file when it is open pp_sys.c - do not define h_errno, pp_system with spawn util.c - use setenv Compiled Module Source ext/POSIX/POSIX.xs - tzname defined externally ext/SDBM_File/sdbm/pair.c - EXTCONST needs to be redefined from EXTERN.h ext/SDBM_File/sdbm/sdbm.c - binary open Perl Modules/Scripts lib/Cwd.pm - hook to internal Cwd::cwd lib/ExtUtils/MakeMaker.pm - require MM_Cygwin.pm lib/ExtUtils/MM_Cygwin.pm - canonpath, cflags, manifypods, perl_archive lib/File/Find.pm - on remote drives stat() always sets st_nlink to 1 lib/File/Spec/Unix.pm - preserve //unc lib/File/Temp.pm - no directory sticky bit lib/perl5db.pl - use stdin not /dev/tty utils/perldoc.PL - version comment BUGS When make starts, it warns about overriding commands for perlmain.o. `make clean' does not remove library .def or .exe.stackdump files. The ld2 script contains references to the source directory. You should change these to $installbin after `make install'. Support for swapping real and effective user and group IDs is incomplete. On WinNT Cygwin provides setuid(), seteuid(), setgid() and setegid(). However, additional Cygwin calls for manipulating WinNT access tokens and security contexts are required. When building DLLs, `dllwrap --export-all-symbols' is used to export global symbols. It might be better to generate an explicit .def file (see makedef.pl). Also, DLLs can now be build with `gcc -shared'. AUTHORS Charles Wilson , Eric Fifer , alexander smishlajev , Steven Morlock , Sebastien Barre , Teun Burgers . HISTORY Last updated: 9 November 2000 Pod-Simple-3.45/t/search50.t0000644000175000017500000000460314243763566013647 0ustar khwkhwuse strict; use warnings; use Test::More; #sub Pod::Simple::Search::DEBUG () {5}; use Pod::Simple::Search; # print "# Test the scanning of the whole of \@INC ...\n"; my $x = Pod::Simple::Search->new; die "Couldn't make an object!?" unless ok defined $x; ok $x->inc; # make sure inc=1 is the default # print $x->_state_as_string; #$x->verbose(12); use Pod::Simple; *pretty = \&Pod::Simple::BlackBox::pretty; *pretty = \&Pod::Simple::BlackBox::pretty; # avoid 'once' warning my $found = 0; $x->callback(sub { # print "# ", join(" ", map "{$_}", @_), "\n"; ++$found; return; }); # print "# \@INC == @INC\n"; my $t = time(); my($name2where, $where2name) = $x->survey(); $t = time() - $t; ok $found; # print "# Found $found items in $t seconds!\n# See...\n"; # my $p = pretty( $where2name, $name2where )."\n"; # $p =~ s/, +/,\n/g; # $p =~ s/^/# /mg; # print $p; # print "# OK, making sure strict and strict.pm were in there...\n"; # print "# (On Debian-based distributions Pod is stripped from\n", # "# strict.pm, so skip these tests.)\n"; my $nopod = not exists ($name2where->{'strict'}); SKIP: { skip 'No Pod for strict.pm', 3 if $nopod; like $name2where->{'strict'}, qr/strict\.(pod|pm)$/; ok grep( m/strict\.(pod|pm)/, keys %$where2name); ok my $strictpath = $name2where->{'strict'}, 'Should have strict path'; my @x = ($x->find('strict')||'(nil)', $strictpath); # print "# Comparing \"$x[0]\" to \"$x[1]\"\n"; for(@x) { s{[/\\]}{/}g; } # print "# => \"$x[0]\" to \"$x[1]\"\n"; is $x[0], $x[1], " find('strict') should match survey's name2where{strict}"; } # print "# Test again on a module we know is present, in case the # strict.pm tests were skipped...\n"; # Search for all files in $name2where. while (my ($testmod, $testpath) = each %{ $name2where }) { unless ( $testmod ) { fail; # no 'thatpath/.pm' means can't test find() next; } my @x = ($x->find($testmod)||'(nil)', $testpath); # print "# Comparing \"$x[0]\" to \"$x[1]\"\n"; my $result = File::Spec->rel2abs($x[0]); # print "# => \"$result\" to \"$x[1]\"\n"; if ($result ne $x[1]) { TODO: { local $TODO = 'unstable Pod::Simple::Search'; is( $result, $x[1], " find('$testmod') should match survey's name2where{$testmod}"); } } else { is( $result, $x[1], " find('$testmod') should match survey's name2where{$testmod}"); } } done_testing; Pod-Simple-3.45/t/encod02.t0000644000175000017500000000216414243763554013464 0ustar khwkhw# encoding not error use strict; use warnings; use Test::More tests => 2; #use Pod::Simple::Debug (5); use Pod::Simple::DumpAsXML; use Pod::Simple::XMLOutStream; print "# Pod::Simple version $Pod::Simple::VERSION\n"; { my @output_lines = split m/[\cm\cj]+/, Pod::Simple::XMLOutStream->_out( q{ =encoding koi8-r =head1 NAME ëÏÇÄÁ ÞÉÔÁÌÁ ÔÙ ÍÕÞÉÔÅÌØÎÙÅ ÓÔÒÏËÉ -- Fet's "When you were reading" =cut } ); if(grep m/Unknown directive/i, @output_lines ) { ok 0; print "# I saw an Unknown directive warning here! :\n", map("#==> $_\n", @output_lines), "#\n#\n"; } else { ok 1; } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - print "# Now a control group, to make sure that =fishbladder DOES\n", "# cause an 'unknown directive' error...\n"; { my @output_lines = split m/[\cm\cj]+/, Pod::Simple::XMLOutStream->_out( q{ =fishbladder =head1 NAME Fet's "When you were reading" =cut } ); if(grep m/Unknown directive/i, @output_lines ) { ok 1; } else { ok 0; print "# But I didn't see an Unknows directive warning here! :\n", map("#==> $_\n", @output_lines), "#\n#\n"; } } Pod-Simple-3.45/t/fake-closers.t0000644000175000017500000000227114243763554014607 0ustar khwkhwuse strict; use warnings; use Test::More tests => 7; use Data::Dumper; my $i = 0; print "# Real closers ...\n"; for my $pod ( "=over\n\nblock\n\n=back", "=over\n\nblock\n\n=cut\n\ncode\n\n=pod\n\n=back", "=begin html\n\ntag\n\n=end html", ) { my $parser = Pod::Simple::Blurb->new(); $parser->parse_string_document($pod); is($parser->{'closer-flag'}, -1, "real closer ". ++$i); } $i = 0; print "# Fake closers ...\n"; for my $pod ("=begin html\n\ntag=cut", "=begin html\n\ntag\n\n=begin xml tag =end xml", "=over\n\nblock=cut", "=over\n\nanother block", ) { my $parser = Pod::Simple::Blurb->new(); $parser->parse_string_document($pod); is($parser->{'closer-flag'}, 1, "fake closer ". ++$i); } package Pod::Simple::Blurb; use warnings; use strict; use base qw/Pod::Simple::Methody/; sub new { my $new = shift->SUPER::new(@_); $new->output_string(\my $doesnotmatter); $new->accept_targets('*'); return $new; } sub end_over_block { shift->set(@_); } sub end_for { shift->set(@_); } sub set { $_[0]{'closer-flag'} = defined $_[1]{'fake-closer'} ? 1 : -1; } Pod-Simple-3.45/t/junk2.pod0000644000175000017500000000005614243754136013574 0ustar khwkhw =head9 I like pie B Pod-Simple-3.45/t/verb_fmt.t0000644000175000017500000003150014243763554014032 0ustar khwkhw# Testing verbatim formatted sections use strict; use warnings; use Test::More tests => 60; #use Pod::Simple::Debug (6); use Pod::Simple::DumpAsXML; use Pod::Simple::XMLOutStream; print "# Pod::Simple version $Pod::Simple::VERSION\n"; sub e { Pod::Simple::DumpAsXML->_duo(\&without_vf, @_) } sub ev { Pod::Simple::DumpAsXML->_duo(\&with_vf, @_) } sub with_vf { $_[0]-> accept_codes('VerbatimFormatted') } sub without_vf { $_[0]->unaccept_codes('VerbatimFormatted') } # ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ print "# Testing VerbatimFormatted...\n"; # A formatty line has to have #: in the first two columns, and uses # "^" to mean bold, "/" to mean underline, and "%" to mean bold italic. # Example: # What do you want? i like pie. [or whatever] # #:^^^^^^^^^^^^^^^^^ ///////////// &is( Pod::Simple::XMLOutStream->_out(\&with_vf, q{=pod What do you want? i like pie. [or whatever] #:^^^^^^^^^^^^^^^^^ ///////////// Hooboy. =cut }) => qq{ What do you want? i like pie. [or whatever]\n Hooboy.} ); &is( Pod::Simple::XMLOutStream->_out(\&with_vf, q{=pod What do you want? i like pie. [or whatever] #:^^^^^^^^^^^^^^^^^ ///////////// Hooboy. =cut }) => qq{ What do you want? i like pie. [or whatever]\n Hooboy.} ); &is( Pod::Simple::XMLOutStream->_out(\&with_vf, q{=pod What do you want? i like pie. [or whatever] #:^^^^^^^^^^^^^^^^^ ///////////// =cut }) => qq{ What do you want? i like pie. [or whatever]} ); &is( Pod::Simple::XMLOutStream->_out(\&with_vf, q{=pod What do you want? i like pie. [or whatever] #:^^^^^^^^^^^^^^^^^ /////////////} ) => qq{ What do you want? i like pie. [or whatever]} ); &is( Pod::Simple::XMLOutStream->_out(\&with_vf, q{=pod What do you want? i like pie. [or whatever] #:^^^^^^^^^^^^^^^^^ //////////////////} ) => qq{ What do you want? i like pie. [or whatever]} ); &is( Pod::Simple::XMLOutStream->_out(\&with_vf, q{=pod What do you want? i like pie. [or whatever] #:^^^^^^^^^^^^^^^^^ ///} ) => qq{ What do you want? i like pie. [or whatever]} ); &is( Pod::Simple::XMLOutStream->_out(\&with_vf, q{=pod What do you want? i like pie. [or whatever] #:^^^^^^^^^^^^^^^^^ /// #:^^^^^^^^^^^^^^^^^ ///} ) => qq{ What do you want? i like pie. [or whatever]\n#:^^^^^^^^^^^^^^^^^ ///} ); &is( Pod::Simple::XMLOutStream->_out(\&with_vf, # with a tab: q{=pod What do you want? i like pie. [or whatever] #:^^^^^^^^^^^^^^^^^ /// } ) => qq{ What do you want? i like pie. [or whatever]} ); # Now testing the % too: &is( Pod::Simple::XMLOutStream->_out(\&with_vf, q{=pod What do you want? i like pie. [or whatever] #:^^^^^^^^^^^^^^^^^ %%%% //////////////////} ) => qq{ What do you want? i like pie. [or whatever]} ); &is( Pod::Simple::XMLOutStream->_out(\&with_vf, q{=pod Hooboy! What do you want? i like pie. [or whatever] #: ^^^^^ %%%% //////////////////} ) => qq{ Hooboy!\n What do you want? i like pie. [or whatever]} ); #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ print "# Now running some tests adapted from verbatims.t...\n#\n#\n"; print "# Without VerbatimFormatted...\n"; &is( e "", "" ); &is( e "\n", "", ); &is( e "\n=pod\n\n foo bar baz", "\n=pod\n\n foo bar baz" ); &is( e "\n=pod\n\n foo bar baz", "\n=pod\n\n foo bar baz\n" ); print "# With VerbatimFormatted...\n"; &is( ev "", "" ); &is( ev "\n", "", ); &is( ev "\n=pod\n\n foo bar baz", "\n=pod\n\n foo bar baz" ); &is( ev "\n=pod\n\n foo bar baz", "\n=pod\n\n foo bar baz\n" ); print "# Now testing via XMLOutStream without VerbatimFormatted...\n"; is( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\n"), qq{ foo bar baz} ); is( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\n quux\n"), qq{ foo bar baz\n quux} ); is( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\nquux\n"), qq{ foo bar baz\nquux} ); print "# Contiguous verbatims...\n"; is( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\n\n quux\n"), qq{ foo bar baz\n\n quux} ); is( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\n\n\n quux\n"), qq{ foo bar baz\n\n\n quux} ); print "# Testing =cut...\n"; is( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\n=cut\n quux\n"), qq{ foo bar baz} ); print "#\n# Now retesting with VerbatimFormatted...\n"; is( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\n"), qq{ foo bar baz} ); is( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\n quux\n"), qq{ foo bar baz\n quux} ); is( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\nquux\n"), qq{ foo bar baz\nquux} ); print "# Contiguous verbatims...\n"; is( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\n\n quux\n"), qq{ foo bar baz\n\n quux} ); is( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\n\n\n quux\n"), qq{ foo bar baz\n\n\n quux} ); print "# Testing =cut...\n"; is( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\n=cut\n quux\n"), qq{ foo bar baz} ); # . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . { my $it = qq{ foo bar bazFoo quux\nquum} ; print "# Various \\n-(in)significance sanity checks...\n"; print "# verbatim/cut/head/verbatim sanity zero...\n"; is( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\n\n=head1 Foo\n\n quux\nquum\n"), $it); is( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\n=cut\nsome code here...\n=head1 Foo\n\n quux\nquum\n"), $it); is( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\n=cut\nsome code here...\n\n=head1 Foo\n\n quux\nquum\n"), $it); print "# verbatim/cut/head/verbatim sanity one...\n"; is( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\n=cut\n\nsome code here...\n=head1 Foo\n\n quux\nquum\n"), $it); is( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\n\n=cut\nsome code here...\n=head1 Foo\n\n quux\nquum\n"), $it); is( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\n\n=cut\n\nsome code here...\n=head1 Foo\n\n quux\nquum\n"), $it); print "# verbatim/cut/head/verbatim sanity two...\n"; is( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\n=cut\n\nsome code here...\n\n=head1 Foo\n\n quux\nquum\n"), $it); is( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\n\n=cut\nsome code here...\n\n=head1 Foo\n\n quux\nquum\n"), $it); is( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\n\n=cut\n\n\nsome code here...\n\n=head1 Foo\n\n quux\nquum\n"), $it); print "# verbatim/cut/head/verbatim sanity three...\n"; is( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\n=cut\n\nsome code here...\n\n\n=head1 Foo\n\n quux\nquum\n"), $it); is( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\n\n=cut\nsome code here...\n\n\n=head1 Foo\n\n quux\nquum\n"), $it); is( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\n\n=cut\n\nsome code here...\n\n\n=head1 Foo\n\n quux\nquum\n"), $it); print "# verbatim/cut/head/verbatim sanity four...\n"; is( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\n\n\n\n\n=cut\n\nsome code here...\n\n\n=head1 Foo\n\n quux\nquum\n"), $it); is( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\n\n\n\n\n\n=cut\nsome code here...\n\n\n=head1 Foo\n\n quux\nquum\n"), $it); is( Pod::Simple::XMLOutStream->_out(\&without_vf, "\n=pod\n\n foo bar baz\n\n\n\n\n\n=cut\n\nsome code here...\n\n\n=head1 Foo\n\n quux\nquum\n"), $it); } # : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : : print "#\n# Now retesting with VerbatimFormatted...\n"; { my $it = qq{ foo bar bazFoo quux\nquum} ; print "# Various \\n-(in)significance sanity checks...\n"; print "# verbatim/cut/head/verbatim sanity zero...\n"; is( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\n\n=head1 Foo\n\n quux\nquum\n"), $it); is( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\n=cut\nsome code here...\n=head1 Foo\n\n quux\nquum\n"), $it); is( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\n=cut\nsome code here...\n\n=head1 Foo\n\n quux\nquum\n"), $it); print "# verbatim/cut/head/verbatim sanity one...\n"; is( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\n=cut\n\nsome code here...\n=head1 Foo\n\n quux\nquum\n"), $it); is( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\n\n=cut\nsome code here...\n=head1 Foo\n\n quux\nquum\n"), $it); is( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\n\n=cut\n\nsome code here...\n=head1 Foo\n\n quux\nquum\n"), $it); print "# verbatim/cut/head/verbatim sanity two...\n"; is( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\n=cut\n\nsome code here...\n\n=head1 Foo\n\n quux\nquum\n"), $it); is( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\n\n=cut\nsome code here...\n\n=head1 Foo\n\n quux\nquum\n"), $it); is( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\n\n=cut\n\n\nsome code here...\n\n=head1 Foo\n\n quux\nquum\n"), $it); print "# verbatim/cut/head/verbatim sanity three...\n"; is( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\n=cut\n\nsome code here...\n\n\n=head1 Foo\n\n quux\nquum\n"), $it); is( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\n\n=cut\nsome code here...\n\n\n=head1 Foo\n\n quux\nquum\n"), $it); is( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\n\n=cut\n\nsome code here...\n\n\n=head1 Foo\n\n quux\nquum\n"), $it); print "# verbatim/cut/head/verbatim sanity four...\n"; is( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\n\n\n\n\n=cut\n\nsome code here...\n\n\n=head1 Foo\n\n quux\nquum\n"), $it); is( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\n\n\n\n\n\n=cut\nsome code here...\n\n\n=head1 Foo\n\n quux\nquum\n"), $it); is( Pod::Simple::XMLOutStream->_out(\&with_vf, "\n=pod\n\n foo bar baz\n\n\n\n\n\n=cut\n\nsome code here...\n\n\n=head1 Foo\n\n quux\nquum\n"), $it); } Pod-Simple-3.45/t/search22.t0000644000175000017500000000541514243763554013645 0ustar khwkhwuse strict; use warnings; use Test::More tests => 13; use Pod::Simple::Search; print "# ", __FILE__, ": Testing the scanning of several docroots...\n"; my $x = Pod::Simple::Search->new; die "Couldn't make an object!?" unless ok defined $x; $x->inc(0); $x->shadows(1); use File::Spec; use Cwd (); use File::Basename (); my $t_dir = File::Basename::dirname(Cwd::abs_path(__FILE__)); my $here1 = File::Spec->catdir($t_dir, 'testlib1'); my $here2 = File::Spec->catdir($t_dir, 'testlib2'); my $here3 = File::Spec->catdir($t_dir, 'testlib3'); print "# OK, found the test corpora\n# as $here1\n# and $here2\n# and $here3\n#\n"; print $x->_state_as_string; #$x->verbose(12); use Pod::Simple; *pretty = \&Pod::Simple::BlackBox::pretty; my($name2where, $where2name) = $x->survey($here1, $here2, $here3); my $p = pretty( $where2name, $name2where )."\n"; $p =~ s/, +/,\n/g; $p =~ s/^/# /mg; print $p; require File::Spec->catfile($t_dir, 'ascii_order.pl'); SKIP: { skip '-- case may or may not be preserved', 2 if $^O eq 'VMS'; { print "# won't show any shadows, since we're just looking at the name2where keys\n"; my $names = join "|", sort ascii_order keys %$name2where; is $names, "Blorm|Suzzle|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Vliff|perlflif|perlthng|perlzoned|perlzuk|squaa|squaa::Glunk|squaa::Vliff|squaa::Wowo|zikzik"; } { print "# but here we'll see shadowing:\n"; my $names = join "|", sort ascii_order values %$where2name; is $names, "Blorm|Suzzle|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Glunk|hinkhonk::Vliff|hinkhonk::Vliff|perlflif|perlthng|perlthng|perlzoned|perlzuk|squaa|squaa::Glunk|squaa::Vliff|squaa::Vliff|squaa::Vliff|squaa::Wowo|zikzik"; } } { my %count; for(values %$where2name) { ++$count{$_} }; #print pretty(\%count), "\n\n"; delete @count{ grep $count{$_} < 2, keys %count }; my $shadowed = join "|", sort ascii_order keys %count; is $shadowed, "hinkhonk::Glunk|hinkhonk::Vliff|perlthng|squaa::Vliff"; sub thar { print "# Seen $_[0] :\n", map "# {$_}\n", sort ascii_order grep $where2name->{$_} eq $_[0],keys %$where2name; return; } is $count{'perlthng'}, 2; thar 'perlthng'; is $count{'squaa::Vliff'}, 3; thar 'squaa::Vliff'; } like( ($name2where->{'squaa'} || 'huh???'), qr/squaa\.pm$/); is grep( m/squaa\.pm/, keys %$where2name ), 1; like( ($name2where->{'perlthng'} || 'huh???'), qr/[^\^]testlib1/ ); like( ($name2where->{'squaa::Vliff'} || 'huh???'), qr/[^\^]testlib1/ ); SKIP: { skip '-- case may or may not be preserved', 1 if $^O eq 'VMS'; # Some sanity: like +($name2where->{'squaa::Wowo'} || 'huh???'), qr/testlib2/; } my $in_pods = $x->find('perlzoned', $here2); like $in_pods, qr{^\Q$here2\E}; like $in_pods, qr{perlzoned.pod$}; Pod-Simple-3.45/t/encod04.t0000644000175000017500000001027214243763554013465 0ustar khwkhw# The encoding detection heuristic will choose UTF8 or CP1252. The current # implementation will usually treat CP1252 (aka "Win-Latin-1") as CP1252 but # can be fooled into seeing it as UTF8. use strict; use warnings; use Test::More tests => 5; # fail with the supplied diagnostic use Pod::Simple::DumpAsXML; use Pod::Simple::XMLOutStream; # Initial, isolated, non-ASCII byte triggers CP1252 guess and later # multi-byte sequence is not considered by heuristic. my $x97; my $x91; my $dash; if ($] ge 5.007_003) { $x97 = chr utf8::unicode_to_native(0x97); $x91 = chr utf8::unicode_to_native(0x91); $dash = '—'; } else { # Tests will fail for early EBCDICs $x97 = chr 0x97; $x91 = chr 0x91; $dash = '--'; } my @output_lines = split m/[\r\n]+/, Pod::Simple::XMLOutStream->_out( qq{ =head1 NAME Em::Dash $x97 ${x91}CAF\xC9\x92 =cut } ); my($guess) = "@output_lines" =~ m{Non-ASCII.*?Assuming ([\w-]+)}; if( $guess ) { if( $guess eq 'CP1252' ) { if( grep m{Dash $dash}, @output_lines ) { ok 1; } else { fail "failed to find expected control character in output"; } } else { fail "parser guessed wrong encoding expected 'CP1252' got '$guess'"; } } else { fail "parser failed to detect non-ASCII bytes in input"; } # Initial smart-quote character triggers CP1252 guess as expected @output_lines = split m/[\r\n]+/, Pod::Simple::XMLOutStream->_out( qq{ =head1 NAME Smart::Quote - ${x91}FUT\xC9\x92 =cut } ); if (ord("A") != 65) { # ASCII-platform dependent test skipped on this platform ok (1); } else { ($guess) = "@output_lines" =~ m{Non-ASCII.*?Assuming ([\w-]+)}; if( $guess ) { if( $guess eq 'CP1252' ) { ok 1; } else { fail "parser guessed wrong encoding expected 'CP1252' got '$guess'"; } } else { fail "parser failed to detect non-ASCII bytes in input"; } } # Initial accented character (E acute) followed by 'smart' apostrophe is legal # CP1252, which should be preferred over UTF-8 because the latter # interpretation would be "JOS" . \N{LATIN SMALL LETTER TURNED ALPHA} . "S # PLACE", and that \N{} letter is an IPA one. @output_lines = split m/[\r\n]+/, Pod::Simple::XMLOutStream->_out( qq{ =head1 NAME =head2 JOS\xC9\x92S PLACE =cut } ); if (ord("A") != 65) { # ASCII-platform dependent test skipped on this platform ok (1); } else { ($guess) = "@output_lines" =~ m{Non-ASCII.*?Assuming ([\w-]+)}; if( $guess ) { if( $guess eq 'CP1252' ) { ok 1; } else { fail "parser guessed wrong encoding expected 'CP1252' got '$guess'"; } } else { fail "parser failed to detect non-ASCII bytes in input"; } } # The previous example used a CP1252 byte sequence that also happened to be a # valid UTF8 byte sequence. In this example we use an illegal UTF-8 sequence # (it needs a third byte), so must be 1252 @output_lines = split m/[\r\n]+/, Pod::Simple::XMLOutStream->_out( qq{ =head1 NAME Smart::Apostrophe::Fail - L\xE9\x92Strange =cut } ); if (ord("A") != 65) { # ASCII-platform dependent test skipped on this platform ok (1); } else { ($guess) = "@output_lines" =~ m{Non-ASCII.*?Assuming ([\w-]+)}; if( $guess ) { if( $guess eq 'CP1252' ) { ok 1; } else { fail "parser guessed wrong encoding expected 'CP1252' got '$guess'"; } } else { fail "parser failed to detect non-ASCII bytes in input"; } } # The following is a real word example of something in CP1252 expressible in # UTF-8, but doesn't make sense in UTF-8, contributed by Bo Lindbergh. # Muvrarášša is a Sami word @output_lines = split m/[\r\n]+/, Pod::Simple::XMLOutStream->_out( qq{ =head1 NAME Muvrar\xE1\x9A\x9Aa is a mountain in Norway =cut } ); if (ord("A") != 65) { # ASCII-platform dependent test skipped on this platform ok (1); } else { ($guess) = "@output_lines" =~ m{Non-ASCII.*?Assuming ([\w-]+)}; if( $guess ) { if( $guess eq 'CP1252' ) { ok 1; } else { fail "parser guessed wrong encoding expected 'CP1252' got '$guess'"; } } else { fail "parser failed to detect non-ASCII bytes in input"; } } Pod-Simple-3.45/t/search25.t0000644000175000017500000000404014243763554013641 0ustar khwkhwuse strict; use warnings; use Test::More tests => 8; #sub Pod::Simple::Search::DEBUG () {5}; use Pod::Simple::Search; print "# ", __FILE__, ": Testing limit_glob ...\n"; my $x = Pod::Simple::Search->new; die "Couldn't make an object!?" unless ok defined $x; $x->inc(0); $x->shadows(1); use File::Spec; use Cwd (); use File::Basename (); my $t_dir = File::Basename::dirname(Cwd::abs_path(__FILE__)); my $here1 = File::Spec->catdir($t_dir, 'testlib1'); my $here2 = File::Spec->catdir($t_dir, 'testlib2'); my $here3 = File::Spec->catdir($t_dir, 'testlib3'); print "# OK, found the test corpora\n# as $here1\n# and $here2\n# and $here3\n#\n"; print $x->_state_as_string; #$x->verbose(12); use Pod::Simple; *pretty = \&Pod::Simple::BlackBox::pretty; my $glob = 'squaa::*'; print "# Limiting to $glob\n"; $x->limit_glob($glob); my($name2where, $where2name) = $x->survey($here1, $here2, $here3); my $p = pretty( $where2name, $name2where )."\n"; $p =~ s/, +/,\n/g; $p =~ s/^/# /mg; print $p; SKIP: { skip '-- case may or may not be preserved', 2 if $^O eq 'VMS'; { my $names = join "|", sort keys %$name2where; is $names, "squaa::Glunk|squaa::Vliff|squaa::Wowo"; } { my $names = join "|", sort values %$where2name; is $names, "squaa::Glunk|squaa::Vliff|squaa::Vliff|squaa::Vliff|squaa::Wowo"; } } my %count; for(values %$where2name) { ++$count{$_} }; #print pretty(\%count), "\n\n"; delete @count{ grep $count{$_} < 2, keys %count }; my $shadowed = join "|", sort keys %count; is $shadowed, "squaa::Vliff"; sub thar { print "# Seen $_[0] :\n", map "# {$_}\n", sort grep $where2name->{$_} eq $_[0],keys %$where2name; return; } is $count{'squaa::Vliff'}, 3; thar 'squaa::Vliff'; ok ! $name2where->{'squaa'}; # because squaa.pm isn't squaa::* like( ($name2where->{'squaa::Vliff'} || 'huh???'), qr/[^\^]testlib1/ ); SKIP: { skip '-- case may or may not be preserved', 1 if $^O eq 'VMS'; like +($name2where->{'squaa::Wowo'} || 'huh???'), qr/testlib2/; } Pod-Simple-3.45/t/search28.t0000644000175000017500000000213614243763554013650 0ustar khwkhwuse strict; use warnings; use Pod::Simple::Search; use Test::More tests => 2; print "# ", __FILE__, ": Testing limit_glob ...\n"; my $x = Pod::Simple::Search->new; die "Couldn't make an object!?" unless ok defined $x; $x->inc(0); $x->shadows(1); use File::Spec; use Cwd (); use File::Basename (); my $t_dir = File::Basename::dirname(Cwd::abs_path(__FILE__)); my $here1 = File::Spec->catdir($t_dir, 'testlib1'); my $here2 = File::Spec->catdir($t_dir, 'testlib2'); my $here3 = File::Spec->catdir($t_dir, 'testlib3'); print "# OK, found the test corpora\n# as $here1\n# and $here2\n# and $here3\n#\n"; print $x->_state_as_string; #$x->verbose(12); use Pod::Simple; *pretty = \&Pod::Simple::BlackBox::pretty; my $glob = '*z*k*'; print "# Limiting to $glob\n"; $x->limit_glob($glob); my($name2where, $where2name) = $x->survey($here1, $here2, $here3); my $p = pretty( $where2name, $name2where )."\n"; $p =~ s/, +/,\n/g; $p =~ s/^/# /mg; print $p; require File::Spec->catfile($t_dir, 'ascii_order.pl'); { my $names = join "|", sort ascii_order values %$where2name; is $names, "Zonk::Pronk|perlzuk|zikzik"; } Pod-Simple-3.45/t/xhtml10.t0000644000175000017500000003230414243763540013521 0ustar khwkhw# t/xhtml01.t - check basic output from Pod::Simple::XHTML use strict; use warnings; use Test::More tests => 62; use_ok('Pod::Simple::XHTML') or exit; isa_ok my $parser = Pod::Simple::XHTML->new, 'Pod::Simple::XHTML'; my $header = $parser->html_header; my $footer = $parser->html_footer; for my $spec ( [ 'foo' => 'foo', 'foo' ], [ '12foo' => 'foo1', 'foo' ], [ 'fo$bar' => 'fo-bar', 'fo-bar' ], [ 'f12' => 'f12', 'f12' ], [ '13' => 'pod13', 'pod13' ], [ '**.:' => 'pod', 'pod' ], ) { is $parser->idify( $spec->[0] ), $spec->[1], qq{ID for "$spec->[0]" should be "$spec->[1]"}; is $parser->idify( $spec->[0], 1 ), $spec->[2], qq{Non-unique ID for "$spec->[0]" should be "$spec->[2]"}; } my $results; initialize($parser, $results); $parser->html_header($header); $parser->html_footer($footer); ok $parser->parse_string_document( '=head1 Foo' ), 'Parse one header'; is $results, <<'EOF', 'Should have the index';

    Foo

    EOF initialize($parser, $results); ok $parser->parse_string_document( '=head1 Foo Bar' ), 'Parse multiword header'; is $results, <<'EOF', 'Should have the index';

    Foo Bar

    EOF initialize($parser, $results); ok $parser->parse_string_document( "=head1 Foo B\n\n=head1 Foo B" ), 'Parse two multiword headers'; is $results, <<'EOF', 'Should have the index';

    Foo Bar

    Foo Baz

    EOF initialize($parser, $results); ok $parser->parse_string_document( "=head1 Foo\n\n=head1 Bar" ), 'Parse two headers'; is $results, <<'EOF', 'Should have both and the index';

    Foo

    Bar

    EOF initialize($parser, $results); ok $parser->parse_string_document( "=head1 Foo C\n\n=head1 C" ), 'Parse two headers with C<> formatting'; is $results, <<'EOF', 'Should have the index';

    Foo Bar

    Baz

    EOF initialize($parser, $results); ok $parser->parse_string_document( "=head1 Foo\n\n=head1 Bar\n\n=head1 Baz" ), 'Parse three headers'; is $results, <<'EOF', 'Should have all three and the index';

    Foo

    Bar

    Baz

    EOF initialize($parser, $results); ok $parser->parse_string_document( "=head1 Foo\n\n=head2 Bar" ), 'Parse two levels'; is $results, <<'EOF', 'Should have the dual-level index';

    Foo

    Bar

    EOF initialize($parser, $results); ok $parser->parse_string_document( "=head1 Foo\n\n=head2 Bar\n\n=head3 Baz" ), 'Parse three levels'; is $results, <<'EOF', 'Should have the three-level index';

    Foo

    Bar

    Baz

    EOF initialize($parser, $results); ok $parser->parse_string_document( "=head1 Foo\n\n=head2 Bar\n\n=head3 Baz\n\n=head4 Howdy" ), 'Parse four levels'; is $results, <<'EOF', 'Should have the four-level index';

    Foo

    Bar

    Baz

    Howdy

    EOF initialize($parser, $results); ok $parser->parse_string_document( "=head1 Foo\n\n=head2 Bar\n\n=head3 Baz\n\n=head4 Howdy\n\n=head5 Deep\n\n=head6 Thought" ), 'Parse six levels'; is $results, <<'EOF', 'Should have the six-level index';

    Foo

    Bar

    Baz

    Howdy

    Deep
    Thought
    EOF initialize($parser, $results); ok $parser->parse_string_document( "=head1 Foo\n\n=head2 Bar\n\n=head2 Baz" ), 'Parse 1/2'; is $results, <<'EOF', 'Should have the 1/s index';

    Foo

    Bar

    Baz

    EOF initialize($parser, $results); ok $parser->parse_string_document( "=head1 Foo\n\n=head3 Bar" ), 'Parse jump from one to three'; is $results, <<'EOF', 'Should have the 1-3 index';

    Foo

    Bar

    EOF initialize($parser, $results); ok $parser->parse_string_document( "=head1 Foo\n\n=head4 Bar" ), 'Parse jump from one to four'; is $results, <<'EOF', 'Should have the 1-4 index';

    Foo

    Bar

    EOF initialize($parser, $results); ok $parser->parse_string_document( "=head2 Foo\n\n=head1 Bar" ), 'Parse two down to 1'; is $results, <<'EOF', 'Should have the 2-1 index';

    Foo

    Bar

    EOF initialize($parser, $results); ok $parser->parse_string_document( "=head2 Foo\n\n=head1 Bar\n\n=head4 Four\n\n=head4 Four2" ), 'Parse two down to 1'; is $results, <<'EOF', 'Should have the 2-1 index';

    Foo

    Bar

    Four

    Four2

    EOF initialize($parser, $results); ok $parser->parse_string_document( "=head4 Foo" ), 'Parse just a four'; is $results, <<'EOF', 'Should have the 2-1 index';

    Foo

    EOF initialize($parser, $results); ok $parser->parse_string_document( <<'EOF' ), 'Parse a mixture'; =head2 Foo =head3 Bar =head1 Baz =head4 Drink =head3 Sip =head4 Ouch =head1 Drip EOF is $results, <<'EOF', 'And it should work!';

    Foo

    Bar

    Baz

    Drink

    Sip

    Ouch

    Drip

    EOF initialize($parser, $results); $parser->html_header($header); $parser->html_footer($footer); $parser->backlink(1); ok $parser->parse_string_document( '=head1 Foo' ), 'Parse a header'; is $results, <<'EOF', 'Should have the index and a backlink';

    Foo

     EOF initialize($parser, $results); $parser->html_header($header); $parser->html_footer($footer); $parser->backlink(1); ok $parser->parse_string_document( "=head1 Foo \n\n=head2 Bar \n\n=head1 Baz" ), 'Parse headers'; is $results, <<'EOF', 'Should have the index and backlinks';

    Foo

    Bar

    Baz

     EOF initialize($parser, $results); $parser->html_header($header); $parser->html_footer($footer); $parser->index(0); $parser->backlink(1); ok $parser->parse_string_document( "=head1 Foo \n\n=head1 Bar" ), 'Parse headers'; is $results, <<'EOF', 'Should have backlinks but no index';

    Foo

    Bar

     EOF initialize($parser, $results); $parser->html_header($header); $parser->html_footer($footer); $parser->backlink(1); $parser->html_h_level(2); ok $parser->parse_string_document( "=head1 Foo \n\n=head1 Bar" ), 'Parse headers'; is $results, <<'EOF', 'Should have index and backlinks around h2 elements';

    Foo

    Bar

     EOF initialize($parser, $results); $parser->anchor_items(1); ok $parser->parse_string_document( <<'EOPOD' ), 'Parse POD'; =head1 Foo =over =item test =item Test 2 body of item =back =over =item * not anchored =back =over =item 1 still not anchored =back EOPOD is $results, <<'EOF', 'Anchor =item directives';

    Foo

    test
    Test 2

    body of item

    • not anchored

    1. still not anchored

    EOF initialize($parser, $results); $parser->anchor_items(0); ok $parser->parse_string_document( <<'EOPOD' ), 'Parse POD'; =head1 Foo =over =item test =item Test 2 body of item =back =over =item * not anchored =back =over =item 1 still not anchored =back EOPOD is $results, <<'EOF', 'Do not anchor =item directives';

    Foo

    test
    Test 2

    body of item

    • not anchored

    1. still not anchored

    EOF $ENV{FOO}= 1; initialize($parser, $results); ok $parser->parse_string_document( <<'EOPOD' ), 'Parse POD'; =head1 Foo Test links from perlpodspec: L...E Codes"> =head1 About LE...E Codes Here it is EOPOD my $id = 'About-L...-Codes'; # what should this be? is $results, <
  • Foo
  • About L<...> Codes

    • Foo

    Test links from perlpodspec: "About L<...> Codes"

    About L<...> Codes

    Here it is

    EOF sub initialize { $_[0] = Pod::Simple::XHTML->new; $_[0]->html_header(''); $_[0]->html_footer(''); $_[0]->index(1); $_[0]->output_string( \$results ); # Send the resulting output to a string $_[1] = ''; return; } Pod-Simple-3.45/t/lib/0000755000175000017500000000000014430216375012600 5ustar khwkhwPod-Simple-3.45/t/lib/helpers.pm0000644000175000017500000000035214243754137014605 0ustar khwkhw#!perl package helpers; use strict; use warnings; use Exporter; our @ISA = qw{Exporter}; our @EXPORT_OK = qw(e f); our @EXPORT = qw{e}; sub e { Pod::Simple::DumpAsXML->_duo(@_) }; sub f { Pod::Simple::DumpAsXML->_duo(@_) }; 1; Pod-Simple-3.45/t/testlib3/0000755000175000017500000000000014430216375013563 5ustar khwkhwPod-Simple-3.45/t/testlib3/squaa/0000755000175000017500000000000014430216375014675 5ustar khwkhwPod-Simple-3.45/t/testlib3/squaa/Vliff.pm0000644000175000017500000000016514243754135016306 0ustar khwkhw =head1 NAME squaa::Vliff -- blorpoesu =head1 DESCRIPTION This is just a test file. =cut print "HOOBOY!\n"; 1; Pod-Simple-3.45/t/stree.t0000644000175000017500000000601314243763554013351 0ustar khwkhwuse strict; use warnings; use Test::More tests => 30; #use Pod::Simple::Debug (6); use Pod::Simple::SimpleTree; print "# Pod::Simple version $Pod::Simple::VERSION\n"; my $hashes_dont_matter = 0; my $x = 'Pod::Simple::SimpleTree'; sub x { my $p = $x->new; $p->merge_text(1); $p->parse_string_document( shift )->root; } print "# a bit of meta-testing...\n"; ok( deq( 1, 1 )); ok(!deq( 2, 1 )); ok( deq( undef, undef )); ok(!deq( undef, 1 )); ok(!deq( 1, undef )); ok( deq( [ ], [ ] )); ok(!deq( [ ], 1 )); ok(!deq( 1, [ ] )); ok( deq( [1], [1] )); ok(!deq( [1], 1 )); ok(!deq( 1, [1] )); ok(!deq( [1], [ ] )); ok(!deq( [ ], [1] )); ok(!deq( [1], [2] )); ok(!deq( [2], [1] )); ok( deq( [ ], [ ] )); ok(!deq( [ ], 1 )); ok(!deq( 1, [ ] )); ok( deq( {}, {} )); ok(!deq( {}, 1 )); ok(!deq( 1, {} )); ok(!deq( {1,2}, {} )); ok(!deq( {}, {1,2} )); ok( deq( {1,2}, {1,2} )); ok(!deq( {2,1}, {1,2} )); print '# ', Pod::Simple::pretty(x( "=pod\n\nI like pie.\n" )), "\n"; print "# Making sure we get a tree at all...\n"; ok x( "=pod\n\nI like pie.\n" ); print "# Some real tests...\n"; ok( deq( x( "=pod\n\nI like pie.\n"), [ "Document", {"start_line"=>1}, [ "Para", {"start_line"=>3}, "I like pie." ] ] )); $hashes_dont_matter = 1; ok( deq( x("=pod\n\nB\n"), [ "Document", {}, [ "Para", {}, ["B", {}, "foo " ] ] ] )); ok( deq( x("=pod\n\nBXI>\n"), [ "Document", {}, [ "Para", {}, ["B", {}, "pie", ['F',{}, 'zorch'], ['X',{}, 'foo' ], ['I',{}, 'pling'], ] ] ] )); ok( deq( x("=over\n\n=item BXI>!\n\n=back"), [ "Document", {}, [ "over-text", {}, [ "item-text", {}, ["B", {}, "pie", ['F',{}, 'zorch'], ['X',{}, 'foo' ], ['I',{}, 'pling'], ], '!' ] ] ] )); sub deq { # deep-equals #print "# deq ", Pod::Simple::pretty($_[0], $_[1]), "\n"; return 1 unless defined $_[0] or defined $_[1]; # two undefs = same return '' if defined $_[0] xor defined $_[1]; return '' if ref($_[0]) ne ref($_[1]); # unequal referentiality return $_[0] eq $_[1] unless ref $_[0]; # So it's a ref: if(UNIVERSAL::isa($_[0], 'ARRAY')) { return '' unless @{$_[0]} == @{$_[1]}; for(my $i = 0; $i < @{$_[0]}; $i++) { print("# NEQ ", Pod::Simple::pretty($_[0]), "\n# != ", Pod::Simple::pretty($_[1]), "\n"), return '' unless deq($_[0][$i], $_[1][$i]); # recurse! } return 1; } elsif(UNIVERSAL::isa($_[0], 'HASH')) { return 1 if $hashes_dont_matter; return '' unless keys %{$_[0]} == keys %{$_[1]}; foreach my $k (keys %{$_[0]}) { return '' unless exists $_[1]{$k}; return '' unless deq($_[0]{$k}, $_[1]{$k}); } return 1; } else { print "# I don't know how to deque $_[0] & $_[1]\n"; return 1; } } Pod-Simple-3.45/t/xhtml20.t0000644000175000017500000000232114243763540013516 0ustar khwkhw# t/xhtml20.t - test subclassing of Pod::Simple::XHTML use strict; use warnings; use Test::More tests => 1; BEGIN { package MyXHTML; use base 'Pod::Simple::XHTML'; sub handle_code { my($self, $code, $kind) = @_; $code = $kind . "[$code]"; $self->SUPER::handle_code($code); } sub start_code { my($self, $kind) = @_; $self->{scratch} .= ""; } sub end_code { my($self, $kind) = @_; $self->{scratch} .= ""; } } my ($parser, $results); initialize(); $parser->parse_string_document(<<'EOT'); =head1 Foo This is C<$code> and so is: my $foo = 1; Code might even be C<<< nested( B<< C<1> >> ) >>>. EOT is($results, <<'EOT');

    Foo

    This is C[$code] and so is:

    Verbatim[  my $foo = 1;]

    Code might even be C[nested( ]C[1]C[ )].

    EOT sub initialize { $parser = MyXHTML->new; $parser->html_header(''); $parser->html_footer(''); $parser->output_string( \$results ); $results = ''; } Pod-Simple-3.45/t/output.t0000644000175000017500000000215314243763540013563 0ustar khwkhw# t/output.t - Check output_string. # use strict; use warnings; use Test::More tests => 36; use File::Spec; use Cwd (); use File::Basename (); my $t_dir = File::Basename::dirname(Cwd::abs_path(__FILE__)); for my $format (qw(XHTML HTML Text RTF)) { my $class = "Pod::Simple::$format"; use_ok $class or next; ok my $parser = $class->new, "Construct $format parser"; # Try parse_string_document(). my $output = ''; ok $parser->output_string(\$output), "Set $format output string"; ok $parser->parse_string_document( "=head1 Poit!" ), "Parse to $format via parse_string_document()"; like $output, qr{Poit!}, "Should have $format output from parse_string_document()"; # Try parse_file(). ok $parser = $class->new, "Construct another $format parser"; $output = ''; ok $parser->output_string(\$output), "Set $format output string again"; ok $parser->parse_file(File::Spec->catfile($t_dir, qw(testlib1 zikzik.pod))), "Parse to $format via parse_file()"; like $output, qr{This is just a test file}, "Should have $format output from parse_file"; } Pod-Simple-3.45/t/encod01.t0000644000175000017500000000146514243763554013466 0ustar khwkhw# encoding nonesuch use strict; use warnings; use Test::More tests => 5; use File::Spec; #use Pod::Simple::Debug (10); use Pod::Simple; use Pod::Simple::DumpAsXML; my $thefile; use File::Spec; use Cwd (); use File::Basename (); BEGIN { my $corpusdir = File::Spec->catdir(File::Basename::dirname(Cwd::abs_path(__FILE__)), 'corpus'); $thefile = File::Spec->catfile($corpusdir, 'nonesuch.txt'); } print "# Testing that $thefile parses right.\n"; my $outstring; { my $p = Pod::Simple::DumpAsXML->new; $p->output_string( \$outstring ); $p->parse_file( $thefile ); undef $p; } ok 1 ; # make sure it parsed at all ok( $outstring && length($outstring) ); # make sure it parsed to something. #print $outstring; like( $outstring, qr/Blorp/ ); like( $outstring, qr/errata/ ); like( $outstring, qr/unsupported/ ); Pod-Simple-3.45/t/encod03.t0000644000175000017500000000212014243763554013455 0ustar khwkhw# encoding not error 0 use strict; use warnings; use Test::More tests => 2; #use Pod::Simple::Debug (5); use Pod::Simple::DumpAsXML; use Pod::Simple::XMLOutStream; print "# Pod::Simple version $Pod::Simple::VERSION\n"; { my @output_lines = split m/[\cm\cj]+/, Pod::Simple::XMLOutStream->_out( q{ =encoding koi8-r =head1 NAME Bippitty Boppity Boo -- Yormp =cut } ); if(grep m/Unknown directive/i, @output_lines ) { ok 0; print "# I saw an Unknown directive warning here! :\n", map("#==> $_\n", @output_lines), "#\n#\n"; } else { ok 1; } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - print "# Now a control group, to make sure that =fishbladder DOES\n", "# cause an 'unknown directive' error...\n"; { my @output_lines = split m/[\cm\cj]+/, Pod::Simple::XMLOutStream->_out( q{ =fishbladder =head1 NAME Fet's "When you were reading" =cut } ); if(grep m/Unknown directive/i, @output_lines ) { ok 1; } else { ok 0; print "# But I didn't see an Unknows directive warning here! :\n", map("#==> $_\n", @output_lines), "#\n#\n"; } } Pod-Simple-3.45/t/enc-chars.t0000644000175000017500000000311014243763554014065 0ustar khwkhw# tell parser the source POD has already been decoded from bytes to chars # =encoding line should be ignored # utf8 characters should come through unscathed use strict; use warnings; BEGIN { use Config; if ($Config::Config{'extensions'} !~ /\bEncode\b/) { print "1..0 # Skip: Encode was not built\n"; exit 0; } } use Test::More tests => 5; 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); } ############################################################################## # Test multiple =encoding declarations. $parser = Pod::Simple::XMLOutStream->new; $output = ''; $parser->output_string( \$output ); $parser->parse_string_document(qq{ =pod =encoding UTF-8 =encoding UTF-8 =head1 DESCRIPTION Confirm that the parser detects multiple encodings and complains. }); # Should have an error. like($output, qr/POD ERRORS/); like($output, qr/Cannot have multiple =encoding directives/); Pod-Simple-3.45/t/pulltitl.t0000644000175000017500000002520114243763554014100 0ustar khwkhwuse strict; use warnings; use Test::More tests => 115; #use Pod::Simple::Debug (5); #sub Pod::Simple::MANY_LINES () {1} #sub Pod::Simple::PullParser::DEBUG () {3} use Pod::Simple::PullParser; #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ########################################################################### { print "# Testing another set, at line ", __LINE__, "\n"; my $p = Pod::Simple::PullParser->new; $p->set_source( \qq{\n=head1 NAME\n\nBzorch\n\n=pod\n\nLala\n\n\=cut\n} ); ok $p->get_title(), 'Bzorch'; my $t; ok( $t = $p->get_token); is( $t && $t->type, 'start'); is( $t && $t->type eq 'start' && $t->tagname, 'Document' ); ok( $t = $p->get_token); is( $t && $t->type, 'start'); is( $t && $t->type eq 'start' && $t->tagname, 'head1' ); ok( $t = $p->get_token); is( $t && $t->type, 'text'); is( $t && $t->type eq 'text' && $t->text, 'NAME' ); DIE: { # Make sure we die. local $@; eval { $p->set_source(\'=head1 foo') }; ok $@; like $@, qr/\QCannot assign new source to pull parser; create a new instance, instead/; } } ########################################################################### { print "# Testing a set with nocase, at line ", __LINE__, "\n"; my $p = Pod::Simple::PullParser->new; $p->set_source( \qq{\n=head1 Name\n\nShazbot\n\n=pod\n\nLala\n\n\=cut\n} ); ok $p->get_title(nocase => 1), 'Shazbot'; ok( my $t = $p->get_token); is( $t && $t->type, 'start'); is( $t && $t->type eq 'start' && $t->tagname, 'Document' ); ok( $t = $p->get_token); is( $t && $t->type, 'start'); is( $t && $t->type eq 'start' && $t->tagname, 'head1' ); ok( $t = $p->get_token); is( $t && $t->type, 'text'); is( $t && $t->type eq 'text' && $t->text, 'Name' ); } ########################################################################### { print "# Testing another set, at line ", __LINE__, "\n"; my $p = Pod::Simple::PullParser->new; $p->set_source( \qq{\n=head1 NE<65>ME\n\nBzorch\n\n=pod\n\nLala\n\n\=cut\n} ); ok $p->get_title(), 'Bzorch'; my $t; ok( $t = $p->get_token); is( $t && $t->type, 'start'); is( $t && $t->type eq 'start' && $t->tagname, 'Document' ); ok( $t = $p->get_token); is( $t && $t->type, 'start'); is( $t && $t->type eq 'start' && $t->tagname, 'head1' ); ok( $t = $p->get_token); is( $t && $t->type, 'text'); } ########################################################################### { print "# Testing another set, at line ", __LINE__, "\n"; { my $p = Pod::Simple::PullParser->new; $p->set_source( \qq{\n=head1 NAME\n\nBzorch - I lala\n\n=pod\n\nLala\n\n\=cut\n} ); is $p->get_title(), 'Bzorch - thing lala'; } my $p = Pod::Simple::PullParser->new; $p->set_source( \qq{\n=head1 NAME\n\nBzorch - I lala\n\n=pod\n\nLala\n\n\=cut\n} ); is $p->get_title(), 'Bzorch - thing lala'; my $t; ok( $t = $p->get_token); is( $t && $t->type, 'start'); is( $t && $t->type eq 'start' && $t->tagname, 'Document' ); ok( $t = $p->get_token); is( $t && $t->type, 'start'); is( $t && $t->type eq 'start' && $t->tagname, 'head1' ); ok( $t = $p->get_token); is( $t && $t->type, 'text'); is( $t && $t->type eq 'text' && $t->text, 'NAME' ); } ########################################################################### { print "# Testing another set, at line ", __LINE__, "\n"; my $p = Pod::Simple::PullParser->new; $p->set_source( \qq{\n=head1 Bzorch lala\n\n=pod\n\nLala\n\n\=cut\n} ); is $p->get_title(), 'Bzorch lala'; my $t; ok( $t = $p->get_token); is( $t && $t->type, 'start'); is( $t && $t->type eq 'start' && $t->tagname, 'Document' ); ok( $t = $p->get_token); is( $t && $t->type, 'start'); is( $t && $t->type eq 'start' && $t->tagname, 'head1' ); ok( $t = $p->get_token); is( $t && $t->type, 'text'); is( $t && $t->type eq 'text' && $t->text, 'Bzorch lala' ); } ########################################################################### { print "# Testing another set, at line ", __LINE__, "\n"; my $p = Pod::Simple::PullParser->new; $p->set_source( \qq{\n=head1 Bzorch - I lala\n\n=pod\n\nLala\n\n\=cut\n} ); is $p->get_title(), 'Bzorch - thing lala'; my $t; ok( $t = $p->get_token); is( $t && $t->type, 'start'); is( $t && $t->type eq 'start' && $t->tagname, 'Document' ); ok( $t = $p->get_token); is( $t && $t->type, 'start'); is( $t && $t->type eq 'start' && $t->tagname, 'head1' ); ok( $t = $p->get_token); is( $t && $t->type, 'text'); is( $t && $t->type eq 'text' && $t->text, 'Bzorch - ' ); } ########################################################################### { print "# Testing another set, at line ", __LINE__, "\n"; my $p = Pod::Simple::PullParser->new; $p->set_source( \qq{\n=head1 Nombre (NAME)\n\nBzorch - I lala\n\n=pod\n\nGrunk\n\n\=cut\n} ); is $p->get_version || '', ''; is $p->get_author || '', ''; ok $p->get_title(), 'Bzorch - thing lala'; my $t; ok( $t = $p->get_token); ok( $t && $t->type, 'start'); ok( $t && $t->type eq 'start' && $t->tagname, 'Document' ); } ########################################################################### { print "# Testing another set, at line ", __LINE__, "\n"; my $p = Pod::Simple::PullParser->new; $p->set_source( \qq{\n=head1 ëÏÇÄÁ ÞÉÔÁÌÁ (NAME)\n\nëÏÇÄÁ ÞÉÔÁÌÁ ÔÙ ÍÕÞÉÔÅÌØÎÙÅ ÓÔÒÏËÉ -- Fet's I<"When you were> reading\n\n=pod\n\nGrunk\n\n\=cut\n} ); ok $p->get_title(), q{ëÏÇÄÁ ÞÉÔÁÌÁ ÔÙ ÍÕÞÉÔÅÌØÎÙÅ ÓÔÒÏËÉ -- Fet's "When you were reading}; my $t; ok( $t = $p->get_token); is( $t && $t->type, 'start'); is( $t && $t->type eq 'start' && $t->tagname, 'Document' ); } ########################################################################### { print "# Testing another set, at line ", __LINE__, "\n"; my $p = Pod::Simple::PullParser->new; $p->set_source( \qq{\n=head1 (NAME) ëÏÇÄÁ ÞÉÔÁÌÁ\n\nëÏÇÄÁ ÞÉÔÁÌÁ ÔÙ ÍÕÞÉÔÅÌØÎÙÅ ÓÔÒÏËÉ -- Fet's I<"When you were> reading\n\n=pod\n\nGrunk\n\n\=cut\n} ); is $p->get_title(), q{ëÏÇÄÁ ÞÉÔÁÌÁ ÔÙ ÍÕÞÉÔÅÌØÎÙÅ ÓÔÒÏËÉ -- Fet's "When you were reading}; my $t; ok( $t = $p->get_token); is( $t && $t->type, 'start'); is( $t && $t->type eq 'start' && $t->tagname, 'Document' ); } ########################################################################### { print "# Testing another set, at line ", __LINE__, "\n"; my $p = Pod::Simple::PullParser->new; $p->set_source( \qq{\n=head1 (DESCRIPTION) ëÏÇÄÁ ÞÉÔÁÌÁ\n\nëÏÇÄÁ ÞÉÔÁÌÁ ÔÙ ÍÕÞÉÔÅÌØÎÙÅ ÓÔÒÏËÉ -- Fet's I<"When you were> reading\n\n=pod\n\nGrunk\n\n\=cut\n} ); is $p->get_title() || '', ''; is $p->get_description(), q{ëÏÇÄÁ ÞÉÔÁÌÁ ÔÙ ÍÕÞÉÔÅÌØÎÙÅ ÓÔÒÏËÉ -- Fet's "When you were reading}; my $t; ok( $t = $p->get_token); is( $t && $t->type, 'start'); is( $t && $t->type eq 'start' && $t->tagname, 'Document' ); } ########################################################################### { print "# Testing another set, at line ", __LINE__, "\n"; my $p = Pod::Simple::PullParser->new; $p->set_source( \qq{\n=head1 (DESCRIPTION) ëÏÇÄÁ ÞÉÔÁÌÁ\n\nëÏÇÄÁ ÞÉÔÁÌÁ ÔÙ ÍÕÞÉÔÅÌØÎÙÅ ÓÔÒÏËÉ -- Fet's I<"When you were> reading\n\n=pod\n\nGrunk\n\n\=cut\n} ); is $p->get_description(), q{ëÏÇÄÁ ÞÉÔÁÌÁ ÔÙ ÍÕÞÉÔÅÌØÎÙÅ ÓÔÒÏËÉ -- Fet's "When you were reading}; is $p->get_title() || '', ''; my $t; ok( $t = $p->get_token); is( $t && $t->type, 'start'); is( $t && $t->type eq 'start' && $t->tagname, 'Document' ); } ########################################################################### { print "# Testing another set, at line ", __LINE__, "\n"; my $p = Pod::Simple::PullParser->new; $p->set_source( \qq{\n=head1 NAME\n\nThingy\n\n=head1 (DESCRIPTION) ëÏÇÄÁ ÞÉÔÁÌÁ\n\nëÏÇÄÁ ÞÉÔÁÌÁ ÔÙ ÍÕÞÉÔÅÌØÎÙÅ ÓÔÒÏËÉ -- Fet's I<"When you were> reading\n\n=pod\n\nGrunk\n\n\=cut\n} ); is $p->get_description(), q{ëÏÇÄÁ ÞÉÔÁÌÁ ÔÙ ÍÕÞÉÔÅÌØÎÙÅ ÓÔÒÏËÉ -- Fet's "When you were reading}; is $p->get_title(), "Thingy"; my $t; ok( $t = $p->get_token); is( $t && $t->type, 'start'); is( $t && $t->type eq 'start' && $t->tagname, 'Document' ); } ########################################################################### { print "# Testing another set, at line ", __LINE__, "\n"; my $p = Pod::Simple::PullParser->new; $p->set_source( \qq{\n=head1 NAME\n\nThingy\n\n=head1 (DESCRIPTION) ëÏÇÄÁ ÞÉÔÁÌÁ\n\nëÏÇÄÁ ÞÉÔÁÌÁ ÔÙ ÍÕÞÉÔÅÌØÎÙÅ ÓÔÒÏËÉ -- Fet's I<"When you were> reading\n\n=pod\n\nGrunk\n\n\=cut\n} ); is $p->get_title(), "Thingy"; is $p->get_description(), q{ëÏÇÄÁ ÞÉÔÁÌÁ ÔÙ ÍÕÞÉÔÅÌØÎÙÅ ÓÔÒÏËÉ -- Fet's "When you were reading}; my $t; ok( $t = $p->get_token); is( $t && $t->type, 'start'); is( $t && $t->type eq 'start' && $t->tagname, 'Document' ); } ########################################################################### { print "# Testing another set, at line ", __LINE__, "\n"; my $p = Pod::Simple::PullParser->new; $p->set_source( \qq{\n=head1 (NAME) ÷ÄÁÌÉ ÐÅÒÅÄ\n\nThingy\n\n=head1 (DESCRIPTION) ëÏÇÄÁ ÞÉÔÁÌÁ\n\nëÏÇÄÁ ÞÉÔÁÌÁ ÔÙ ÍÕÞÉÔÅÌØÎÙÅ ÓÔÒÏËÉ -- Fet's I<"When you were> reading\n\n=pod\n\nGrunk\n\n\=cut\n} ); is $p->get_title(), "Thingy"; is $p->get_description(), q{ëÏÇÄÁ ÞÉÔÁÌÁ ÔÙ ÍÕÞÉÔÅÌØÎÙÅ ÓÔÒÏËÉ -- Fet's "When you were reading}; my $t; ok( $t = $p->get_token); is( $t && $t->type, 'start'); is( $t && $t->type eq 'start' && $t->tagname, 'Document' ); } ########################################################################### { print "# Testing another set, at line ", __LINE__, "\n"; my $p = Pod::Simple::PullParser->new; $p->set_source( \q{ =head1 (NAME) ÷ÄÁÌÉ ÐÅÒÅÄ Thingy =head1 (DESCRIPTION) ëÏÇÄÁ ÞÉÔÁÌÁ ëÏÇÄÁ ÞÉÔÁÌÁ ÔÙ ÍÕÞÉÔÅÌØÎÙÅ ÓÔÒÏËÉ -- Fet's I<"When you were> reading =pod Grunk =cut } ); is $p->get_title(), "Thingy"; is $p->get_version() || '', ''; is $p->get_description(), q{ëÏÇÄÁ ÞÉÔÁÌÁ ÔÙ ÍÕÞÉÔÅÌØÎÙÅ ÓÔÒÏËÉ -- Fet's "When you were reading}; my $t; ok( $t = $p->get_token); is( $t && $t->type, 'start'); is( $t && $t->type eq 'start' && $t->tagname, 'Document' ); } ########################################################################### { print "# Testing another set, at line ", __LINE__, "\n"; my $p = Pod::Simple::PullParser->new; $p->set_source( \q{ =head1 (NAME) ÷ÄÁÌÉ ÐÅÒÅÄ Thingy =head1 (DESCRIPTION) ëÏÇÄÁ ÞÉÔÁÌÁ ëÏÇÄÁ ÞÉÔÁÌÁ ÔÙ ÍÕÞÉÔÅÌØÎÙÅ ÓÔÒÏËÉ -- Fet's I<"When you were> reading =head1 VERSION Stuff: Thing Whatever: Um. =head1 AUTHOR Jojoj E<65>arzarz =pod Grunk =cut } ); is $p->get_title(), "Thingy"; my $v = $p->get_version || ''; $v =~ s/^ +//m; $v =~ s/^\s+//s; $v =~ s/\s+$//s; is $v, "Stuff: Thing\nWhatever: Um."; is $p->get_description(), q{ëÏÇÄÁ ÞÉÔÁÌÁ ÔÙ ÍÕÞÉÔÅÌØÎÙÅ ÓÔÒÏËÉ -- Fet's "When you were reading}; is $p->get_author() || '', 'Jojoj Aarzarz'; my $t; ok( $t = $p->get_token); is( $t && $t->type, 'start'); is( $t && $t->type eq 'start' && $t->tagname, 'Document' ); } ########################################################################### { 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\n} ); is $p->get_title(), 'NAME Foo Bar'; } Pod-Simple-3.45/t/junk1.pod0000644000175000017500000000006414243754136013572 0ustar khwkhw =cut =head9 I like pie B Pod-Simple-3.45/t/for.t0000644000175000017500000001160514243763554013020 0ustar khwkhwuse strict; use warnings; use Test::More tests => 19; #use Pod::Simple::Debug (5); BEGIN { require FindBin; unshift @INC, $FindBin::Bin . '/lib'; } use helpers; use Pod::Simple::DumpAsXML; use Pod::Simple::XMLOutStream; print "# Pod::Simple version $Pod::Simple::VERSION\n"; my $x = 'Pod::Simple::XMLOutStream'; $Pod::Simple::XMLOutStream::ATTR_PAD = ' '; $Pod::Simple::XMLOutStream::SORT_ATTRS = 1; # for predictably testable output sub moj {shift->accept_target('mojojojo')} sub mojtext {shift->accept_target_as_text('mojojojo')} sub any {shift->accept_target('*')} #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ is( $x->_out( "=pod\n\nI like pie.\n\n=for mojojojo stuff\n\nYup.\n"), 'I like pie.Yup.' ); is( $x->_out( "=pod\n\nI like pie.\n\n=for psketti,mojojojo,crunk stuff\n\nYup.\n"), 'I like pie.Yup.' ); is( $x->_out( "=pod\n\nI like pie.\n\n=for mojojojo I\n\nYup.\n"), 'I like pie.Yup.' ); is( $x->_out( "=pod\n\nI like pie.\n\n=for psketti,mojojojo,crunk I\n\nYup.\n"), 'I like pie.Yup.' ); is( $x->_out( "=pod\n\nI like pie.\n\n=for :psketti,mojojojo,crunk I\n\nYup.\n"), 'I like pie.Yup.' ); print "# Testing accept_target ...\n"; is( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=for crunk stuff\n\nYup.\n"), 'I like pie.Yup.' ); is( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=for mojojojo I\n\nYup.\n"), 'I like pie.I<stuff>Yup.' ); is( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=for psketti,mojojojo,crunk I\n\nYup.\n"), 'I like pie.I<stuff>Yup.' ); is( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=for :mojojojo I\n\nYup.\n"), 'I like pie.stuffYup.' ); is( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=for :psketti,mojojojo,crunk I\n\nYup.\n"), 'I like pie.stuffYup.' ); print "# Testing accept_target_as_text ...\n"; is( $x->_out( \&mojtext, "=pod\n\nI like pie.\n\n=for mojojojo I\n\nYup.\n"), 'I like pie.stuffYup.' ); is( $x->_out( \&mojtext, "=pod\n\nI like pie.\n\n=for psketti,mojojojo,crunk I\n\nYup.\n"), 'I like pie.stuffYup.' ); is( $x->_out( \&mojtext, "=pod\n\nI like pie.\n\n=for :mojojojo I\n\nYup.\n"), 'I like pie.stuffYup.' ); is( $x->_out( \&mojtext, "=pod\n\nI like pie.\n\n=for :psketti,mojojojo,crunk I\n\nYup.\n"), 'I like pie.stuffYup.' ); print "# Testing accept_target(*) ...\n"; is( $x->_out( \&any, "=pod\n\nI like pie.\n\n=for mojojojo I\n\nYup.\n"), 'I like pie.I<stuff>Yup.' ); is( $x->_out( \&any, "=pod\n\nI like pie.\n\n=for mojojojo I\n\nYup.\n"), 'I like pie.I<stuff>Yup.' ); is( $x->_out( \&any, "=pod\n\nI like pie.\n\n=for psketti,mojojojo,crunk I\n\nYup.\n"), 'I like pie.I<stuff>Yup.' ); is( $x->_out( \&any, "=pod\n\nI like pie.\n\n=for :mojojojo I\n\nYup.\n"), 'I like pie.stuffYup.' ); is( $x->_out( \&any, "=pod\n\nI like pie.\n\n=for :psketti,mojojojo,crunk I\n\nYup.\n"), 'I like pie.stuffYup.' ); Pod-Simple-3.45/t/fcodes_s.t0000644000175000017500000003000414243763554014011 0ustar khwkhw# fcodes S use strict; use warnings; use Test::More tests => 78; #use Pod::Simple::Debug (6); use Pod::Simple::XMLOutStream; print "# Pod::Simple version $Pod::Simple::VERSION\n"; my $x = 'Pod::Simple::XMLOutStream'; sub e { $x->_duo(@_) } $Pod::Simple::XMLOutStream::ATTR_PAD = ' '; $Pod::Simple::XMLOutStream::SORT_ATTRS = 1; # for predictably testable output print "# S as such...\n"; is( $x->_out("=pod\n\nI like S.\n"), => 'I like bric-a-brac.' ); is( $x->_out("=pod\n\nI like S.\n"), => 'I like bric-a-brac a gogo .' ); is( $x->_out("=pod\n\nI like S<< bric-a-brac a gogo >>.\n"), => 'I like bric-a-brac a gogo.' ); SKIP: { if (chr(65) ne 'A') { skip "Skip because not in ASCIIland", 4; } is( $x->_out( sub { $_[0]->nbsp_for_S(1) }, "=pod\n\nI like S.\n"), 'I like bric-a-brac a gogo.' ); is( $x->_out( sub { $_[0]->nbsp_for_S(1) }, qq{=pod\n\nI like S>.\n}), 'I like "bric-a-brac a gogo".' ); is( $x->_out( sub { $_[0]->nbsp_for_S(1) }, qq{=pod\n\nI like S>.\n}), 'I like Stuff like that.' ); is( $x->_out( sub { $_[0]->nbsp_for_S(1) }, qq{=pod\n\nI like S|/"bric-a-brac a gogo">>.\n}), 'I like Stuff like that.' ); } &is( $x->_duo( sub { $_[0]->nbsp_for_S(1) }, "=pod\n\nI like S.\n", "=pod\n\nI like bric-a-bracE<160>aE<160>gogo.\n", )); &is( map {my $z = $_; $z =~ s/content-implicit="yes" //g; $z =~ s/raw=".+?" //g; $z } $x->_duo( sub { $_[0]->nbsp_for_S(1) }, qq{=pod\n\nI like S>.\n}, qq{=pod\n\nI like L<"bric-a-bracE<160>aE<160>gogo"|/"bric-a-brac a gogo">.\n}, )); &is( map {my $z = $_; $z =~ s/raw=".+?" //g; $z } $x->_duo( sub { $_[0]->nbsp_for_S(1) }, qq{=pod\n\nI like S>.\n}, qq{=pod\n\nI like LlikeE<160>that|"bric-a-brac a gogo">.\n}, )); &is( map {my $z = $_; $z =~ s/content-implicit="yes" //g; $z =~ s/raw=".+?" //g; $z } $x->_duo( sub { $_[0]->nbsp_for_S(1) }, qq{=pod\n\nI like S|"bric-a-brac a gogo">>.\n}, qq{=pod\n\nI like LIthat>|"bric-a-brac a gogo">.\n}, )); use Pod::Simple::Text; $x = Pod::Simple::Text->new; $x->preserve_whitespace(1); # RT#25679 ok( $x->_out(< > foo >> is being rendered Both pod2text and pod2man S< > lose the rest of the line =head1 Do they always S< > lose the rest of the line? =cut END ), < foo is being rendered Both pod2text and pod2man lose the rest of the line Do they always lose the rest of the line? END ); $x = 'Pod::Simple::Text'; # Test text output of links. is( $x->_out(qq{=pod\n\nL\n}), " Net::Ping\n\n" ); is( $x->_out(qq{=pod\n\nBe sure to read the L docs\n}), " Be sure to read the Net::Ping docs\n\n" ); is( $x->_out(qq{=pod\n\nL\n}), " http://www.perl.com\n\n" ); is( $x->_out(qq{=pod\n\nL\n}), " crontab(5)\n\n" ); is( $x->_out(qq{=pod\n\nL\n}), qq{ "Ping-pong" in Net::Ping\n\n} ); is( $x->_out(qq{=pod\n\nL\n}), qq{ "Object Methods"\n\n} ); is( $x->_out(qq{=pod\n\nL

    • \n}), qq{ "Object Methods"\n\n} ); is( $x->_out(qq{=pod\n\nL<"Object Methods">\n}), qq{ "Object Methods"\n\n} ); is( $x->_out(qq{=pod\n\nLong>\n}), qq{ "Ping-pong" in Net::Ping\n\n} ); is( $x->_out(qq{=pod\n\nL\n}), " news:comp.lang.perl.misc\n\n" ); is( $x->_out(qq{=pod\n\nL\n}), " http://www.perl.org\n\n" ); is( $x->_out(qq{=pod\n\nSee L\n}), " See http://www.perl.org\n\n" ); is( $x->_out(qq{=pod\n\nL\n}), " http://www.perl.org/CPAN/authors/id/S/SB/SBURKE/\n\n" ); is( $x->_out(qq{=pod\n\nLlang.perl.misc>\n}), " news:comp.lang.perl.misc\n\n" ); is( $x->_out(qq{=pod\n\nLperl.org>\n}), " http://www.perl.org\n\n" ); is( $x->_out(qq{=pod\n\nL\n}), " things\n\n" ); is( $x->_out(qq{=pod\n\nL\n}), " things\n\n" ); is( $x->_out(qq{=pod\n\nL\n}), " Perl Error Messages\n\n" ); is( $x->_out(qq{=pod\n\nL\n}), " Perl Error Messages\n\n" ); is( $x->_out(qq{=pod\n\nL\n}), " Perl Error Messages\n\n" ); is( $x->_out(qq{=pod\n\nL\n}), " perl.org \n\n" ); is( $x->_out(qq{=pod\n\nSee L\n}), " See perl.org \n\n" ); # Test HTML output of links. use Pod::Simple::HTML; my $PERLDOC = "https://metacpan.org/pod"; my $MANURL = "http://man.he.net/man"; sub x { Pod::Simple::HTML->_out( sub { $_[0]->bare_output(1) }, "=pod\n\n$_[0]", ) } is( x(qq{L\n}), qq{\n

    Net::Ping

    \n} ); is( x(qq{Be sure to read the L docs\n}), qq{\n

    Be sure to read the Net::Ping docs

    \n} ); is( x(qq{L\n}), qq{\n

    http://www.perl.com

    \n} ); is( x(qq{L\n}), qq{\n

    crontab(5)

    \n} ); is( x(qq{L\n}), qq{\n

    "Ping-pong" in Net::Ping

    \n} ); is( x(qq{L\n}), qq{\n

    "Object Methods"

    \n} ); is( x(qq{L\n}), qq{\n

    "Object Methods"

    \n} ); is( x(qq{L<"Object Methods">\n}), qq{\n

    "Object Methods"

    \n} ); is( x(qq{Long>\n}), qq{\n

    "Ping-pong" in Net::Ping

    \n} ); is( x(qq{L\n}), qq{\n

    news:comp.lang.perl.misc

    \n} ); is( x(qq{L\n}), qq{\n

    http://www.perl.org

    \n} ); is( x(qq{See L\n}), qq{\n

    See http://www.perl.org

    \n} ); is( x(qq{L\n}), qq{\n

    http://www.perl.org/CPAN/authors/id/S/SB/SBURKE/

    \n} ); is( x(qq{Llang.perl.misc>\n}), qq{\n

    news:comp.lang.perl.misc

    \n} ); is( x(qq{Lperl.org>\n}), qq{\n

    http://www.perl.org

    \n} ); is( x(qq{L\n}), qq{\n

    things

    \n} ); is( x(qq{L\n}), qq{\n

    things

    \n} ); is( x(qq{L\n}), qq{\n

    Perl Error Messages

    \n} ); is( x(qq{L\n}), qq{\n

    Perl Error Messages

    \n} ); is( x(qq{L\n}), qq{\n

    Perl Error Messages

    \n} ); is( x(qq{L\n}), qq{\n

    perl.org

    \n} ); is( x(qq{See L\n}), qq{\n

    See perl.org

    \n} ); # Test link output in XHTML. use Pod::Simple::XHTML; sub o ($) { my $p = Pod::Simple::XHTML->new; $p->html_header(""); $p->html_footer(""); my $results = ''; $p->output_string( \$results ); # Send the resulting output to a string $p->parse_string_document("=pod\n\n$_[0]"); return $results; } is( o(qq{L}), qq{

    Net::Ping

    \n\n} ); is( o(qq{Be sure to read the L docs}), qq{

    Be sure to read the Net::Ping docs

    \n\n} ); is( o(qq{L}), qq{

    http://www.perl.com

    \n\n} ); is( o(qq{L}), qq{

    crontab(5)

    \n\n} ); is( o(qq{L}), qq{

    "Ping-pong" in Net::Ping

    \n\n} ); is( o(qq{L}), qq{

    "Object Methods"

    \n\n} ); is( o(qq{L}), qq{

    "Object Methods"

    \n\n} ); is( o(qq{L<"Object Methods">}), qq{

    "Object Methods"

    \n\n} ); is( o(qq{Long>}), qq{

    "Ping-pong" in Net::Ping

    \n\n} ); is( o(qq{L}), qq{

    news:comp.lang.perl.misc

    \n\n} ); is( o(qq{L}), qq{

    http://www.perl.org

    \n\n} ); is( o(qq{See L}), qq{

    See http://www.perl.org

    \n\n} ); is( o(qq{L}), qq{

    http://www.perl.org/CPAN/authors/id/S/SB/SBURKE/

    \n\n} ); is( o(qq{Llang.perl.misc>}), qq{

    news:comp.lang.perl.misc

    \n\n} ); is( o(qq{Lperl.org>}), qq{

    http://www.perl.org

    \n\n} ); is( o(qq{L}), qq{

    things

    \n\n} ); is( o(qq{L}), qq{

    things

    \n\n} ); is( o(qq{L}), qq{

    Perl Error Messages

    \n\n} ); is( o(qq{L}), qq{

    Perl Error Messages

    \n\n} ); is( o(qq{L}), qq{

    Perl Error Messages

    \n\n} ); is( o(qq{L}), qq{

    perl.org

    \n\n} ); is( o(qq{See L}), qq{

    See perl.org

    \n\n} ); Pod-Simple-3.45/t/heads.t0000644000175000017500000000562014243763554013316 0ustar khwkhwuse strict; use warnings; use Test::More tests => 21; #use Pod::Simple::Debug (6); BEGIN { require FindBin; unshift @INC, $FindBin::Bin . '/lib'; } use helpers; use Pod::Simple::DumpAsXML; use Pod::Simple::XMLOutStream; print "# Pod::Simple version $Pod::Simple::VERSION\n"; print "# Simple tests for head1 - head6...\n"; is( Pod::Simple::XMLOutStream->_out("\n=head1 Chacha\n\n"), 'Chacha' ); is( Pod::Simple::XMLOutStream->_out("\n=head2 Chacha\n\n"), 'Chacha' ); is( Pod::Simple::XMLOutStream->_out("\n=head3 Chacha\n\n"), 'Chacha' ); is( Pod::Simple::XMLOutStream->_out("\n=head4 Chacha\n\n"), 'Chacha' ); is( Pod::Simple::XMLOutStream->_out("\n=head5 Chacha\n\n"), 'Chacha' ); is( Pod::Simple::XMLOutStream->_out("\n=head6 Chacha\n\n"), 'Chacha' ); print "# Testing whitespace equivalence...\n"; &is(e "\n=head1 Chacha\n\n", "\n=head1 Chacha\n\n"); &is(e "\n=head1 Chacha\n\n", "\n=head1\tChacha\n\n"); &is(e "\n=head1 Chacha\n\n", "\n=head1\tChacha \n\n"); is( Pod::Simple::XMLOutStream->_out("=head1 Chachacha"), 'Chachacha' ); print "# Testing whitespace variance ...\n"; is( Pod::Simple::XMLOutStream->_out("=head1 Cha cha cha \n"), 'Cha cha cha' ); is( Pod::Simple::XMLOutStream->_out("=head1 Cha cha\tcha \n"), 'Cha cha cha' ); print "# Testing head2 ... head6 more...\n"; is( Pod::Simple::XMLOutStream->_out("=head2 Cha cha\tcha \n"), 'Cha cha cha' ); is( Pod::Simple::XMLOutStream->_out("=head3 Cha cha\tcha \n"), 'Cha cha cha' ); is( Pod::Simple::XMLOutStream->_out("=head4 Cha cha\tcha \n"), 'Cha cha cha' ); is( Pod::Simple::XMLOutStream->_out("=head5 Cha cha\tcha \n"), 'Cha cha cha' ); is( Pod::Simple::XMLOutStream->_out("=head6 Cha cha\tcha \n"), 'Cha cha cha' ); print "# Testing entity expansion...\n"; is( Pod::Simple::XMLOutStream->_out("=head4 fooE<64>bar!\n"), Pod::Simple::XMLOutStream->_out("\n=head4 foo\@bar!\n\n"), ); # TODO: a mode so that DumpAsXML can ask for all contiguous string # sequences to be fused? # &ok( e "=head4 fooE<64>bar!\n", "\n=head4 foo\@bar!\n\n"); print "# Testing formatting sequences...\n"; # True only if the sequences resolve, as they should... &is( e "=head4 C\n", "\n=head4 C<< foobar! >>\n\n"); &is( e "=head4 C\n", "\n\n=head4 C<<< foobar! >>>\n"); &is( e "=head4 C\n", "\n=head4 C<< foobar!\n\t>>\n\n"); Pod-Simple-3.45/t/perlfaqo.txt0000644000175000017500000007363114243754135014421 0ustar khwkhwNAME perlfaq3 - Programming Tools ($Revision: 1.38 $, $Date: 1999/05/23 16:08:30 $) DESCRIPTION This section of the FAQ answers questions related to programmer tools and programming support. How do I do (anything)? Have you looked at CPAN (see perlfaq2)? The chances are that someone has already written a module that can solve your problem. Have you read the appropriate man pages? Here's a brief index: Basics perldata, perlvar, perlsyn, perlop, perlsub Execution perlrun, perldebug Functions perlfunc Objects perlref, perlmod, perlobj, perltie Data Structures perlref, perllol, perldsc Modules perlmod, perlmodlib, perlsub Regexes perlre, perlfunc, perlop, perllocale Moving to perl5 perltrap, perl Linking w/C perlxstut, perlxs, perlcall, perlguts, perlembed Various http://www.perl.com/CPAN/doc/FMTEYEWTK/index.html (not a man-page but still useful) A crude table of contents for the Perl man page set is found in perltoc. How can I use Perl interactively? The typical approach uses the Perl debugger, described in the perldebug(1) man page, on an ``empty'' program, like this: perl -de 42 Now just type in any legal Perl code, and it will be immediately evaluated. You can also examine the symbol table, get stack backtraces, check variable values, set breakpoints, and other operations typically found in symbolic debuggers. Is there a Perl shell? In general, no. The Shell.pm module (distributed with Perl) makes Perl try commands which aren't part of the Perl language as shell commands. perlsh from the source distribution is simplistic and uninteresting, but may still be what you want. How do I debug my Perl programs? Have you tried use warnings or used -w? They enable warnings to detect dubious practices. Have you tried use strict? It prevents you from using symbolic references, makes you predeclare any subroutines that you call as bare words, and (probably most importantly) forces you to predeclare your variables with my, our, or use vars. Did you check the return values of each and every system call? The operating system (and thus Perl) tells you whether they worked, and if not why. open(FH, "> /etc/cantwrite") or die "Couldn't write to /etc/cantwrite: $!\n"; Did you read perltrap? It's full of gotchas for old and new Perl programmers and even has sections for those of you who are upgrading from languages like awk and C. Have you tried the Perl debugger, described in perldebug? You can step through your program and see what it's doing and thus work out why what it's doing isn't what it should be doing. How do I profile my Perl programs? You should get the Devel::DProf module from the standard distribution (or separately on CPAN) and also use Benchmark.pm from the standard distribution. The Benchmark module lets you time specific portions of your code, while Devel::DProf gives detailed breakdowns of where your code spends its time. Here's a sample use of Benchmark: use Benchmark; @junk = `cat /etc/motd`; $count = 10_000; timethese($count, { 'map' => sub { my @a = @junk; map { s/a/b/ } @a; return @a }, 'for' => sub { my @a = @junk; local $_; for (@a) { s/a/b/ }; return @a }, }); This is what it prints (on one machine--your results will be dependent on your hardware, operating system, and the load on your machine): Benchmark: timing 10000 iterations of for, map... for: 4 secs ( 3.97 usr 0.01 sys = 3.98 cpu) map: 6 secs ( 4.97 usr 0.00 sys = 4.97 cpu) Be aware that a good benchmark is very hard to write. It only tests the data you give it and proves little about the differing complexities of contrasting algorithms. How do I cross-reference my Perl programs? The B::Xref module, shipped with the new, alpha-release Perl compiler (not the general distribution prior to the 5.005 release), can be used to generate cross-reference reports for Perl programs. perl -MO=Xref[,OPTIONS] scriptname.plx Is there a pretty-printer (formatter) for Perl? There is no program that will reformat Perl as much as indent(1) does for C. The complex feedback between the scanner and the parser (this feedback is what confuses the vgrind and emacs programs) makes it challenging at best to write a stand-alone Perl parser. Of course, if you simply follow the guidelines in perlstyle, you shouldn't need to reformat. The habit of formatting your code as you write it will help prevent bugs. Your editor can and should help you with this. The perl-mode or newer cperl-mode for emacs can provide remarkable amounts of help with most (but not all) code, and even less programmable editors can provide significant assistance. Tom swears by the following settings in vi and its clones: set ai sw=4 map! ^O {^M}^[O^T Now put that in your .exrc file (replacing the caret characters with control characters) and away you go. In insert mode, ^T is for indenting, ^D is for undenting, and ^O is for blockdenting-- as it were. If you haven't used the last one, you're missing a lot. A more complete example, with comments, can be found at http://www.perl.com/CPAN-local/authors/id/TOMC/scripts/toms.exrc.gz If you are used to using the vgrind program for printing out nice code to a laser printer, you can take a stab at this using http://www.perl.com/CPAN/doc/misc/tips/working.vgrind.entry, but the results are not particularly satisfying for sophisticated code. The a2ps at http://www.infres.enst.fr/%7Edemaille/a2ps/ does lots of things related to generating nicely printed output of documents. Is there a ctags for Perl? There's a simple one at http://www.perl.com/CPAN/authors/id/TOMC/scripts/ptags.gz which may do the trick. And if not, it's easy to hack into what you want. Is there an IDE or Windows Perl Editor? Perl programs are just plain text, so any editor will do. If you're on Unix, you already have an IDE--Unix itself. The UNIX philosophy is the philosophy of several small tools that each do one thing and do it well. It's like a carpenter's toolbox. If you want a Windows IDE, check the following: CodeMagicCD http://www.codemagiccd.com/ Komodo ActiveState's cross-platform, multi-language IDE has Perl support, including a regular expression debugger and remote debugging (http://www.ActiveState.com/Products/Komodo/index.html). (Visual Perl, a Visual Studio.NET plug-in is currently (early 2001) in beta (http://www.ActiveState.com/Products/VisualPerl/index.html)). The Object System (http://www.castlelink.co.uk/object_system/) is a Perl web applications development IDE. PerlBuilder (http://www.solutionsoft.com/perl.htm) is an integrated development environment for Windows that supports Perl development. Perl code magic (http://www.petes-place.com/codemagic.html). visiPerl+ http://helpconsulting.net/visiperl/, from Help Consulting. For editors: if you're on Unix you probably have vi or a vi clone already, and possibly an emacs too, so you may not need to download anything. In any emacs the cperl-mode (M-x cperl-mode) gives you perhaps the best available Perl editing mode in any editor. For Windows editors: you can download an Emacs GNU Emacs http://www.gnu.org/software/emacs/windows/ntemacs.html MicroEMACS http://members.nbci.com/uemacs/ XEmacs http://www.xemacs.org/Download/index.html or a vi clone such as Elvis ftp://ftp.cs.pdx.edu/pub/elvis/ http://www.fh-wedel.de/elvis/ Vile http://vile.cx/ Vim http://www.vim.org/ win32: http://www.cs.vu.nl/%7Etmgil/vi.html For vi lovers in general, Windows or elsewhere: http://www.thomer.com/thomer/vi/vi.html. nvi (http://www.bostic.com/vi/, available from CPAN in src/misc/) is yet another vi clone, unfortunately not available for Windows, but in UNIX platforms you might be interested in trying it out, firstly because strictly speaking it is not a vi clone, it is the real vi, or the new incarnation of it, and secondly because you can embed Perl inside it to use Perl as the scripting language. nvi is not alone in this, though: at least also vim and vile offer an embedded Perl. The following are Win32 multilanguage editor/IDESs that support Perl: Codewright http://www.starbase.com/ MultiEdit http://www.MultiEdit.com/ SlickEdit http://www.slickedit.com/ There is also a toyedit Text widget based editor written in Perl that is distributed with the Tk module on CPAN. The ptkdb (http://world.std.com/~aep/ptkdb/) is a Perl/tk based debugger that acts as a development environment of sorts. Perl Composer (http://perlcomposer.sourceforge.net/vperl.html) is an IDE for Perl/Tk GUI creation. In addition to an editor/IDE you might be interested in a more powerful shell environment for Win32. Your options include Bash from the Cygwin package (http://sources.redhat.com/cygwin/) Ksh from the MKS Toolkit (http://www.mks.com/), or the Bourne shell of the U/WIN environment (http://www.research.att.com/sw/tools/uwin/) Tcsh ftp://ftp.astron.com/pub/tcsh/, see also http://www.primate.wisc.edu/software/csh-tcsh-book/ Zsh ftp://ftp.blarg.net/users/amol/zsh/, see also http://www.zsh.org/ MKS and U/WIN are commercial (U/WIN is free for educational and research purposes), Cygwin is covered by the GNU Public License (but that shouldn't matter for Perl use). The Cygwin, MKS, and U/WIN all contain (in addition to the shells) a comprehensive set of standard UNIX toolkit utilities. If you're transferring text files between Unix and Windows using FTP be sure to transfer them in ASCII mode so the ends of lines are appropriately converted. On Mac OS the MacPerl Application comes with a simple 32k text editor that behaves like a rudimentary IDE. In contrast to the MacPerl Application the MPW Perl tool can make use of the MPW Shell itself as an editor (with no 32k limit). BBEdit and BBEdit Lite are text editors for Mac OS that have a Perl sensitivity mode (http://web.barebones.com/). Alpha is an editor, written and extensible in Tcl, that nonetheless has built in support for several popular markup and programming languages including Perl and HTML (http://alpha.olm.net/). Pepper and Pe are programming language sensitive text editors for Mac OS X and BeOS respectively (http://www.hekkelman.com/). Where can I get Perl macros for vi? For a complete version of Tom Christiansen's vi configuration file, see http://www.perl.com/CPAN/authors/Tom_Christiansen/scripts/toms.exrc.gz , the standard benchmark file for vi emulators. The file runs best with nvi, the current version of vi out of Berkeley, which incidentally can be built with an embedded Perl interpreter--see http://www.perl.com/CPAN/src/misc. Where can I get perl-mode for emacs? Since Emacs version 19 patchlevel 22 or so, there have been both a perl-mode.el and support for the Perl debugger built in. These should come with the standard Emacs 19 distribution. In the Perl source directory, you'll find a directory called "emacs", which contains a cperl-mode that color-codes keywords, provides context-sensitive help, and other nifty things. Note that the perl-mode of emacs will have fits with "main'foo" (single quote), and mess up the indentation and highlighting. You are probably using "main::foo" in new Perl code anyway, so this shouldn't be an issue. How can I use curses with Perl? The Curses module from CPAN provides a dynamically loadable object module interface to a curses library. A small demo can be found at the directory http://www.perl.com/CPAN/authors/Tom_Christiansen/scripts/rep; this program repeats a command and updates the screen as needed, rendering rep ps axu similar to top. How can I use X or Tk with Perl? Tk is a completely Perl-based, object-oriented interface to the Tk toolkit that doesn't force you to use Tcl just to get at Tk. Sx is an interface to the Athena Widget set. Both are available from CPAN. See the directory http://www.perl.com/CPAN/modules/by-category/08_User_Interfaces/ Invaluable for Perl/Tk programming are the Perl/Tk FAQ at http://w4.lns.cornell.edu/%7Epvhp/ptk/ptkTOC.html , the Perl/Tk Reference Guide available at http://www.perl.com/CPAN-local/authors/Stephen_O_Lidie/ , and the online manpages at http://www-users.cs.umn.edu/%7Eamundson/perl/perltk/toc.html . How can I generate simple menus without using CGI or Tk? The http://www.perl.com/CPAN/authors/id/SKUNZ/perlmenu.v4.0.tar.gz module, which is curses-based, can help with this. What is undump? See the next question on ``How can I make my Perl program run faster?'' How can I make my Perl program run faster? The best way to do this is to come up with a better algorithm. This can often make a dramatic difference. Jon Bentley's book ``Programming Pearls'' (that's not a misspelling!) has some good tips on optimization, too. Advice on benchmarking boils down to: benchmark and profile to make sure you're optimizing the right part, look for better algorithms instead of microtuning your code, and when all else fails consider just buying faster hardware. A different approach is to autoload seldom-used Perl code. See the AutoSplit and AutoLoader modules in the standard distribution for that. Or you could locate the bottleneck and think about writing just that part in C, the way we used to take bottlenecks in C code and write them in assembler. Similar to rewriting in C, modules that have critical sections can be written in C (for instance, the PDL module from CPAN). In some cases, it may be worth it to use the backend compiler to produce byte code (saving compilation time) or compile into C, which will certainly save compilation time and sometimes a small amount (but not much) execution time. See the question about compiling your Perl programs for more on the compiler--the wins aren't as obvious as you'd hope. If you're currently linking your perl executable to a shared libc.so, you can often gain a 10-25% performance benefit by rebuilding it to link with a static libc.a instead. This will make a bigger perl executable, but your Perl programs (and programmers) may thank you for it. See the INSTALL file in the source distribution for more information. Unsubstantiated reports allege that Perl interpreters that use sfio outperform those that don't (for I/O intensive applications). To try this, see the INSTALL file in the source distribution, especially the ``Selecting File I/O mechanisms'' section. The undump program was an old attempt to speed up your Perl program by storing the already-compiled form to disk. This is no longer a viable option, as it only worked on a few architectures, and wasn't a good solution anyway. How can I make my Perl program take less memory? When it comes to time-space tradeoffs, Perl nearly always prefers to throw memory at a problem. Scalars in Perl use more memory than strings in C, arrays take more than that, and hashes use even more. While there's still a lot to be done, recent releases have been addressing these issues. For example, as of 5.004, duplicate hash keys are shared amongst all hashes using them, so require no reallocation. In some cases, using substr() or vec() to simulate arrays can be highly beneficial. For example, an array of a thousand booleans will take at least 20,000 bytes of space, but it can be turned into one 125-byte bit vector--a considerable memory savings. The standard Tie::SubstrHash module can also help for certain types of data structure. If you're working with specialist data structures (matrices, for instance) modules that implement these in C may use less memory than equivalent Perl modules. Another thing to try is learning whether your Perl was compiled with the system malloc or with Perl's builtin malloc. Whichever one it is, try using the other one and see whether this makes a difference. Information about malloc is in the INSTALL file in the source distribution. You can find out whether you are using perl's malloc by typing perl -V:usemymalloc. Is it unsafe to return a pointer to local data? No, Perl's garbage collection system takes care of this. sub makeone { my @a = ( 1 .. 10 ); return \@a; } for $i ( 1 .. 10 ) { push @many, makeone(); } print $many[4][5], "\n"; print "@many\n"; How can I free an array or hash so my program shrinks? You can't. On most operating systems, memory allocated to a program can never be returned to the system. That's why long-running programs sometimes re-exec themselves. Some operating systems (notably, FreeBSD and Linux) allegedly reclaim large chunks of memory that is no longer used, but it doesn't appear to happen with Perl (yet). The Mac appears to be the only platform that will reliably (albeit, slowly) return memory to the OS. We've had reports that on Linux (Redhat 5.1) on Intel, undef $scalar will return memory to the system, while on Solaris 2.6 it won't. In general, try it yourself and see. However, judicious use of my() on your variables will help make sure that they go out of scope so that Perl can free up that space for use in other parts of your program. A global variable, of course, never goes out of scope, so you can't get its space automatically reclaimed, although undef()ing and/or delete()ing it will achieve the same effect. In general, memory allocation and de-allocation isn't something you can or should be worrying about much in Perl, but even this capability (preallocation of data types) is in the works. How can I make my CGI script more efficient? Beyond the normal measures described to make general Perl programs faster or smaller, a CGI program has additional issues. It may be run several times per second. Given that each time it runs it will need to be re-compiled and will often allocate a megabyte or more of system memory, this can be a killer. Compiling into C isn't going to help you because the process start-up overhead is where the bottleneck is. There are two popular ways to avoid this overhead. One solution involves running the Apache HTTP server (available from http://www.apache.org/) with either of the mod_perl or mod_fastcgi plugin modules. With mod_perl and the Apache::Registry module (distributed with mod_perl), httpd will run with an embedded Perl interpreter which pre-compiles your script and then executes it within the same address space without forking. The Apache extension also gives Perl access to the internal server API, so modules written in Perl can do just about anything a module written in C can. For more on mod_perl, see http://perl.apache.org/ With the FCGI module (from CPAN) and the mod_fastcgi module (available from http://www.fastcgi.com/) each of your Perl programs becomes a permanent CGI daemon process. Both of these solutions can have far-reaching effects on your system and on the way you write your CGI programs, so investigate them with care. See http://www.perl.com/CPAN/modules/by-category/15_World_Wide_Web_HTML_HTTP_CGI/ . A non-free, commercial product, ``The Velocity Engine for Perl'', (http://www.binevolve.com/ or http://www.binevolve.com/velocigen/ ) might also be worth looking at. It will allow you to increase the performance of your Perl programs, running programs up to 25 times faster than normal CGI Perl when running in persistent Perl mode or 4 to 5 times faster without any modification to your existing CGI programs. Fully functional evaluation copies are available from the web site. How can I hide the source for my Perl program? Delete it. :-) Seriously, there are a number of (mostly unsatisfactory) solutions with varying levels of ``security''. First of all, however, you can't take away read permission, because the source code has to be readable in order to be compiled and interpreted. (That doesn't mean that a CGI script's source is readable by people on the web, though--only by people with access to the filesystem.) So you have to leave the permissions at the socially friendly 0755 level. Some people regard this as a security problem. If your program does insecure things and relies on people not knowing how to exploit those insecurities, it is not secure. It is often possible for someone to determine the insecure things and exploit them without viewing the source. Security through obscurity, the name for hiding your bugs instead of fixing them, is little security indeed. You can try using encryption via source filters (Filter::* from CPAN), but any decent programmer will be able to decrypt it. You can try using the byte code compiler and interpreter described below, but the curious might still be able to de-compile it. You can try using the native-code compiler described below, but crackers might be able to disassemble it. These pose varying degrees of difficulty to people wanting to get at your code, but none can definitively conceal it (true of every language, not just Perl). If you're concerned about people profiting from your code, then the bottom line is that nothing but a restrictive license will give you legal security. License your software and pepper it with threatening statements like ``This is unpublished proprietary software of XYZ Corp. Your access to it does not give you permission to use it blah blah blah.'' We are not lawyers, of course, so you should see a lawyer if you want to be sure your license's wording will stand up in court. How can I compile my Perl program into byte code or C? Malcolm Beattie has written a multifunction backend compiler, available from CPAN, that can do both these things. It is included in the perl5.005 release, but is still considered experimental. This means it's fun to play with if you're a programmer but not really for people looking for turn-key solutions. Merely compiling into C does not in and of itself guarantee that your code will run very much faster. That's because except for lucky cases where a lot of native type inferencing is possible, the normal Perl run-time system is still present and so your program will take just as long to run and be just as big. Most programs save little more than compilation time, leaving execution no more than 10-30% faster. A few rare programs actually benefit significantly (even running several times faster), but this takes some tweaking of your code. You'll probably be astonished to learn that the current version of the compiler generates a compiled form of your script whose executable is just as big as the original perl executable, and then some. That's because as currently written, all programs are prepared for a full eval() statement. You can tremendously reduce this cost by building a shared libperl.so library and linking against that. See the INSTALL podfile in the Perl source distribution for details. If you link your main perl binary with this, it will make it minuscule. For example, on one author's system, /usr/bin/perl is only 11k in size! In general, the compiler will do nothing to make a Perl program smaller, faster, more portable, or more secure. In fact, it can make your situation worse. The executable will be bigger, your VM system may take longer to load the whole thing, the binary is fragile and hard to fix, and compilation never stopped software piracy in the form of crackers, viruses, or bootleggers. The real advantage of the compiler is merely packaging, and once you see the size of what it makes (well, unless you use a shared libperl.so), you'll probably want a complete Perl install anyway. How can I compile Perl into Java? You can also integrate Java and Perl with the Perl Resource Kit from O'Reilly and Associates. See http://www.oreilly.com/catalog/prkunix/ . Perl 5.6 comes with Java Perl Lingo, or JPL. JPL, still in development, allows Perl code to be called from Java. See jpl/README in the Perl source tree. How can I get #!perl to work on [MS-DOS,NT,...]? For OS/2 just use extproc perl -S -your_switches as the first line in *.cmd file (-S due to a bug in cmd.exe's `extproc' handling). For DOS one should first invent a corresponding batch file and codify it in ALTERNATIVE_SHEBANG (see the INSTALL file in the source distribution for more information). The Win95/NT installation, when using the ActiveState port of Perl, will modify the Registry to associate the .pl extension with the perl interpreter. If you install another port, perhaps even building your own Win95/NT Perl from the standard sources by using a Windows port of gcc (e.g., with cygwin or mingw32), then you'll have to modify the Registry yourself. In addition to associating .pl with the interpreter, NT people can use: SET PATHEXT=%PATHEXT%;.PL to let them run the program install-linux.pl merely by typing install-linux. Macintosh Perl programs will have the appropriate Creator and Type, so that double-clicking them will invoke the Perl application. IMPORTANT!: Whatever you do, PLEASE don't get frustrated, and just throw the perl interpreter into your cgi-bin directory, in order to get your programs working for a web server. This is an EXTREMELY big security risk. Take the time to figure out how to do it correctly. Can I write useful Perl programs on the command line? Yes. Read perlrun for more information. Some examples follow. (These assume standard Unix shell quoting rules.) # sum first and last fields perl -lane 'print $F[0] + $F[-1]' * # identify text files perl -le 'for(@ARGV) {print if -f && -T _}' * # remove (most) comments from C program perl -0777 -pe 's{/\*.*?\*/}{}gs' foo.c # make file a month younger than today, defeating reaper daemons perl -e '$X=24*60*60; utime(time(),time() + 30 * $X,@ARGV)' * # find first unused uid perl -le '$i++ while getpwuid($i); print $i' # display reasonable manpath echo $PATH | perl -nl -072 -e ' s![^/+]*$!man!&&-d&&!$s{$_}++&&push@m,$_;END{print"@m"}' OK, the last one was actually an Obfuscated Perl Contest entry. :-) Why don't Perl one-liners work on my DOS/Mac/VMS system? The problem is usually that the command interpreters on those systems have rather different ideas about quoting than the Unix shells under which the one-liners were created. On some systems, you may have to change single-quotes to double ones, which you must NOT do on Unix or Plan9 systems. You might also have to change a single % to a %%. For example: # Unix perl -e 'print "Hello world\n"' # DOS, etc. perl -e "print \"Hello world\n\"" # Mac print "Hello world\n" (then Run "Myscript" or Shift-Command-R) # VMS perl -e "print ""Hello world\n""" The problem is that none of these examples are reliable: they depend on the command interpreter. Under Unix, the first two often work. Under DOS, it's entirely possible that neither works. If 4DOS was the command shell, you'd probably have better luck like this: perl -e "print "Hello world\n"" Under the Mac, it depends which environment you are using. The MacPerl shell, or MPW, is much like Unix shells in its support for several quoting variants, except that it makes free use of the Mac's non-ASCII characters as control characters. Using qq(), q(), and qx(), instead of "double quotes", 'single quotes', and `backticks`, may make one-liners easier to write. There is no general solution to all of this. It is a mess, pure and simple. Sucks to be away from Unix, huh? :-) [Some of this answer was contributed by Kenneth Albanowski.] Where can I learn about CGI or Web programming in Perl? For modules, get the CGI or LWP modules from CPAN. For textbooks, see the two especially dedicated to web stuff in the question on books. For problems and questions related to the web, like ``Why do I get 500 Errors'' or ``Why doesn't it run from the browser right when it runs fine on the command line'', see these sources: WWW Security FAQ http://www.w3.org/Security/Faq/ Web FAQ http://www.boutell.com/faq/ CGI FAQ http://www.webthing.com/tutorials/cgifaq.html HTTP Spec http://www.w3.org/pub/WWW/Protocols/HTTP/ HTML Spec http://www.w3.org/TR/REC-html40/ http://www.w3.org/pub/WWW/MarkUp/ CGI Spec http://www.w3.org/CGI/ CGI Security FAQ http://www.go2net.com/people/paulp/cgi-security/safe-cgi.txt Where can I learn about object-oriented Perl programming? A good place to start is perltoot, and you can use perlobj, perlboot, and perlbot for reference. Perltoot didn't come out until the 5.004 release; you can get a copy (in pod, html, or postscript) from http://www.perl.com/CPAN/doc/FMTEYEWTK/ . Where can I learn about linking C with Perl? [h2xs, xsubpp] If you want to call C from Perl, start with perlxstut, moving on to perlxs, xsubpp, and perlguts. If you want to call Perl from C, then read perlembed, perlcall, and perlguts. Don't forget that you can learn a lot from looking at how the authors of existing extension modules wrote their code and solved their problems. I've read perlembed, perlguts, etc., but I can't embed perl in my C program; what am I doing wrong? Download the ExtUtils::Embed kit from CPAN and run `make test'. If the tests pass, read the pods again and again and again. If they fail, see perlbug and send a bug report with the output of make test TEST_VERBOSE=1 along with perl -V. When I tried to run my script, I got this message. What does it mean? A complete list of Perl's error messages and warnings with explanatory text can be found in perldiag. You can also use the splain program (distributed with Perl) to explain the error messages: perl program 2>diag.out splain [-v] [-p] diag.out or change your program to explain the messages for you: use diagnostics; or use diagnostics -verbose; What's MakeMaker? This module (part of the standard Perl distribution) is designed to write a Makefile for an extension module from a Makefile.PL. For more information, see ExtUtils::MakeMaker. AUTHOR AND COPYRIGHT Copyright (c) 1997-1999 Tom Christiansen and Nathan Torkington. All rights reserved. When included as an integrated part of the Standard Distribution of Perl or of its documentation (printed or otherwise), this works is covered under Perl's Artistic License. For separate distributions of all or part of this FAQ outside of that, see perlfaq. Irrespective of its distribution, all code examples here are in the public domain. You are permitted and encouraged to use this code and any derivatives thereof in your own programs for fun or for profit as you see fit. A simple comment in the code giving credit to the FAQ would be courteous but is not required.Pod-Simple-3.45/t/corpus/0000755000175000017500000000000014430216375013345 5ustar khwkhwPod-Simple-3.45/t/corpus/plain_utf8.txt0000644000175000017500000000073314243754135016165 0ustar khwkhw #Doesn't actually use any of the utf8 bytes. =encoding utf8 =head1 NAME simple_text_document -- an explicitly UTF8 (ASCII subset) test document =head1 TEXT The quick brown fox jumps over the lazy dog. Military Intelligence Yukon rhosts penrep Weekly World News DSD Time Cohiba finks rail gun DF ~ Corporate Security NATOA CCS DEVGRP CONUS Khaddafi NATIA data havens Spetznaz afsatcom BOP Semtex garbage KGB ^? 737 1080H 1080H Satellite imagery smuggle [end] =cut Pod-Simple-3.45/t/corpus/s2763_sjis.xml0000644000175000017500000000354414243754135015714 0ustar khwkhw shiftjis NAME 型番S2763 -- test document in Shift-JIS DESCRIPTION This is a test Pod document in Shift-JIS. Its content is some uninteresting product specs I found on the Net. It's an textitem list: 型番 S2763 光源 GZ4 ダイクロイックミラーランプ 12V 10W×1 寸法 高・295 幅・365 奥・76mm 質量 8.0kg 材質 樹脂 アルミ、アルマイト仕上 ガラス 価格 76,000円（ランプ・トランス込み） 2001年10月3日（水）発売開始 [end] Pod-Simple-3.45/t/corpus/cp1256.txt0000644000175000017500000000174114243754136015035 0ustar khwkhw =head1 NAME buniya1256 -- test document: a paragraph in Arabic as CP-1256 =head1 DESCRIPTION This Pod document is a paragraph in Arabic from "The Five Pillars of Islam" as CP-1256. =encoding cp1256 æÚä ÚãÇÑÉ Èä ÍÒã ÞÇá ÞÇá ÑÓæá Çááå Õáì Çááå Úáíå æÓáã: ÇÑÈÚ ÝÑÖåä Çááå ÚÒ æÌá Ýí ÇáÇÓáÇã Ýãä ÌÇÁ ÈËáÇË áã íÛäíä Úäå ÔíÆÇ ÍÊì íÃÊí Èåä ÌãíÚÇ ÇáÕáÇÉ æÇáÒßÇÉ æÕíÇã ÑãÖÇä æÍÌ ÇáÈíÊ. ÑæÇå ÇÍãÏ æÇáØÈÑÇäí Ýí ÇáßÈíÑ æÝí ÇÓäÇÏå ÇÈä áåíÚÉ. And now as a real single paragraph: æÚä ÚãÇÑÉ Èä ÍÒã ÞÇá ÞÇá ÑÓæá Çááå Õáì Çááå Úáíå æÓáã: ÇÑÈÚ ÝÑÖåä Çááå ÚÒ æÌá Ýí ÇáÇÓáÇã Ýãä ÌÇÁ ÈËáÇË áã íÛäíä Úäå ÔíÆÇ ÍÊì íÃÊí Èåä ÌãíÚÇ ÇáÕáÇÉ æÇáÒßÇÉ æÕíÇã ÑãÖÇä æÍÌ ÇáÈíÊ. ÑæÇå ÇÍãÏ æÇáØÈÑÇäí Ýí ÇáßÈíÑ æÝí ÇÓäÇÏå ÇÈä áåíÚÉ. And now as a verbatim paragraph: æÚä ÚãÇÑÉ Èä ÍÒã ÞÇá ÞÇá ÑÓæá Çááå Õáì Çááå Úáíå æÓáã: ÇÑÈÚ ÝÑÖåä Çááå ÚÒ æÌá Ýí ÇáÇÓáÇã Ýãä ÌÇÁ ÈËáÇË áã íÛäíä Úäå ÔíÆÇ ÍÊì íÃÊí Èåä ÌãíÚÇ ÇáÕáÇÉ æÇáÒßÇÉ æÕíÇã ÑãÖÇä æÍÌ ÇáÈíÊ. ÑæÇå ÇÍãÏ æÇáØÈÑÇäí Ýí ÇáßÈíÑ æÝí ÇÓäÇÏå ÇÈä áåíÚÉ. [end] =cut Pod-Simple-3.45/t/corpus/cp1256.xml0000644000175000017500000001201614243754136015013 0ustar khwkhw NAME buniya1256 -- test document: a paragraph in Arabic as CP-1256 DESCRIPTION This Pod document is a paragraph in Arabic from "The Five Pillars of Islam" as CP-1256. cp1256 وعن عمارة بن حزم قال قال رسول الله صلى الله عليه وسلم: اربع فرضهن الله عز وجل في الاسلام فمن جاء بثلاث لم يغنين عنه شيئا حتى يأتي بهن جميعا الصلاة والزكاة وصيام رمضان وحج البيت. رواه احمد والطبراني في الكبير وفي اسناده ابن لهيعة. And now as a real single paragraph: وعن عمارة بن حزم قال قال رسول الله صلى الله عليه وسلم: اربع فرضهن الله عز وجل في الاسلام فمن جاء بثلاث لم يغنين عنه شيئا حتى يأتي بهن جميعا الصلاة والزكاة وصيام رمضان وحج البيت. رواه احمد والطبراني في الكبير وفي اسناده ابن لهيعة. And now as a verbatim paragraph: وعن عمارة بن حزم قال قال رسول الله صلى الله عليه وسلم: اربع فرضهن الله عز وجل في الاسلام فمن جاء بثلاث لم يغنين عنه شيئا حتى يأتي بهن جميعا الصلاة والزكاة وصيام رمضان وحج البيت. رواه احمد والطبراني في الكبير وفي اسناده ابن لهيعة. [end] Pod-Simple-3.45/t/corpus/plain_explicit.xml0000644000175000017500000000135214243754135017077 0ustar khwkhw ascii NAME simple_text_document -- an explicitly US-ASCII test document. TEXT The quick brown fox jumps over the lazy dog. Military Intelligence Yukon rhosts penrep Weekly World News DSD Time Cohiba finks rail gun DF ~ Corporate Security NATOA CCS DEVGRP CONUS Khaddafi NATIA data havens Spetznaz afsatcom BOP Semtex garbage KGB ^? 737 1080H 1080H Satellite imagery smuggle [end] Pod-Simple-3.45/t/corpus/koi8r.txt0000644000175000017500000000225414243754136015151 0ustar khwkhw =encoding koi8-r =head1 NAME ëÏÇÄÁ ÞÉÔÁÌÁ ÔÙ ÍÕÞÉÔÅÌØÎÙÅ ÓÔÒÏËÉ -- Fet's "When you were reading" =head1 TEXT (This is a test Pod pocument in KOI8-R.) ëÏÇÄÁ ÞÉÔÁÌÁ ÔÙ ÍÕÞÉÔÅÌØÎÙÅ ÓÔÒÏËÉ, / çÄÅ ÓÅÒÄÃÁ Ú×ÕÞÎÙÊ ÐÙÌ ÓÉÑÎØÅ ÌØÅÔ ËÒÕÇÏÍ / é ÓÔÒÁÓÔÉ ÒÏËÏ×ÏÊ ×ÚÄÙÍÁÀÔÓÑ ÐÏÔÏËÉ,- / îÅ ×ÓÐÏÍÎÉÌÁ ÌØ Ï ÞÅÍ? ñ ×ÅÒÉÔØ ÎÅ ÈÏÞÕ! ëÏÇÄÁ × ÓÔÅÐÉ, ËÁË ÄÉ×Ï, / ÷ ÐÏÌÎÏÞÎÏÊ ÔÅÍÎÏÔÅ ÂÅÚ×ÒÅÍÅÎÎÏ ÇÏÒÑ, / ÷ÄÁÌÉ ÐÅÒÅÄ ÔÏÂÏÊ ÐÒÏÚÒÁÞÎÏ É ËÒÁÓÉ×Ï / ÷ÓÔÁ×ÁÌÁ ×ÄÒÕÇÚÁÒÑ. é × ÜÔÕ ËÒÁÓÏÔÕ ÎÅ×ÏÌØÎÏ ×ÚÏÒ ÔÑÎÕÌÏ, / ÷ ÔÏÔ ×ÅÌÉÞÁ×ÙÊ ÂÌÅÓË ÚÁ ÔÅÍÎÙÊ ×ÅÓØ ÐÒÅÄÅÌ,- / õÖÅÌØ ÎÉÞÔÏ ÔÅÂÅ × ÔÏ ×ÒÅÍÑ ÎÅ ÛÅÐÎÕÌÏ: / ôÁÍ ÞÅÌÏ×ÅË ÓÇÏÒÅÌ! 15 ÆÅ×ÒÁÌÑ 1887 And now, as a verbatim section: ëÏÇÄÁ ÞÉÔÁÌÁ ÔÙ ÍÕÞÉÔÅÌØÎÙÅ ÓÔÒÏËÉ, çÄÅ ÓÅÒÄÃÁ Ú×ÕÞÎÙÊ ÐÙÌ ÓÉÑÎØÅ ÌØÅÔ ËÒÕÇÏÍ é ÓÔÒÁÓÔÉ ÒÏËÏ×ÏÊ ×ÚÄÙÍÁÀÔÓÑ ÐÏÔÏËÉ,- îÅ ×ÓÐÏÍÎÉÌÁ ÌØ Ï ÞÅÍ? ñ ×ÅÒÉÔØ ÎÅ ÈÏÞÕ! ëÏÇÄÁ × ÓÔÅÐÉ, ËÁË ÄÉ×Ï, ÷ ÐÏÌÎÏÞÎÏÊ ÔÅÍÎÏÔÅ ÂÅÚ×ÒÅÍÅÎÎÏ ÇÏÒÑ, ÷ÄÁÌÉ ÐÅÒÅÄ ÔÏÂÏÊ ÐÒÏÚÒÁÞÎÏ É ËÒÁÓÉ×Ï ÷ÓÔÁ×ÁÌÁ ×ÄÒÕÇÚÁÒÑ. é × ÜÔÕ ËÒÁÓÏÔÕ ÎÅ×ÏÌØÎÏ ×ÚÏÒ ÔÑÎÕÌÏ, ÷ ÔÏÔ ×ÅÌÉÞÁ×ÙÊ ÂÌÅÓË ÚÁ ÔÅÍÎÙÊ ×ÅÓØ ÐÒÅÄÅÌ,- õÖÅÌØ ÎÉÞÔÏ ÔÅÂÅ × ÔÏ ×ÒÅÍÑ ÎÅ ÛÅÐÎÕÌÏ: ôÁÍ ÞÅÌÏ×ÅË ÓÇÏÒÅÌ! 15 ÆÅ×ÒÁÌÑ 1887 [end] =cut Pod-Simple-3.45/t/corpus/encwarn02.txt0000644000175000017500000000032514243754136015711 0ustar khwkhw =head1 NAME Encoding Warning 1 - implicitly UTF-8 =head2 DESCRIPTION This line should warn that the price €9.99 contains a non-ASCII character. But château should not generate a warning - once is enough. Pod-Simple-3.45/t/corpus/pasternak_cp1251.txt0000644000175000017500000000326414243754135017101 0ustar khwkhw =encoding cp1251 =head1 NAME Çèìíÿÿ íî÷ü -- Pasternak Russian test file (cp1251) =head1 TEXT (This is a test Pod pocument in cp1251.) Çèìíÿÿ íî÷ü. Ìåëî, ìåëî ïî âñåé çåìëå / Âî âñå ïðåäåëû. / Ñâå÷à ãîðåëà íà ñòîëå, / Ñâå÷à ãîðåëà. Êàê ëåòîì ðîåì ìîøêîðà / Ëåòèò íà ïëàìÿ, / Ñëåòàëèñü õëîïüÿ ñî äâîðà / Ê îêîííîé ðàìå. Ìåòåëü ëåïèëà íà ñòîëå / Êðóæêè è ñòðåëû. / Ñâå÷à ãîðåëà íà ñòîëå, / Ñâå÷à ãîðåëà. Íà îçàðåííûé ïîòîëîê / Ëîæèëèñü òåíè, / Ñêðåùåíüÿ ðóê, ñêðêùåíüÿ íîã, / Ñóäüáû ñêðåùåíüÿ. È ïàäàëè äâà áàøìà÷êà / Ñî ñòóêîì íà ïîë, / È âîñê ñëåçàìè ñ íî÷íèêà / Íà ïëàòüå êàïàë. È âñå òåðÿëîñü â ñíåæíîé ìãëå / Ñåäîé è áåëîé. / Ñâå÷à ãîðåëà íà ñòîëå, / Ñâå÷à ãîðåëà. Íà ñâå÷êó äóëî èç óãëà, / È æàð ñîáëàçíà / Âçäûìàë, êàê àíãåë, äâà êðûëà / Êðåñòîîáðàçíî. / Ìåëî âåñü ìåñÿö â ôåâðàëå, / È òî è äåëî / Ñâå÷à ãîðåëà íà ñòîëå, / Ñâå÷à ãîðåëà. -- Áîðèñ Ïàñòåðíàê, 1946 =head2 As Preformatted And now as a preformatted section: Çèìíÿÿ íî÷ü. Ìåëî, ìåëî ïî âñåé çåìëå Âî âñå ïðåäåëû. Ñâå÷à ãîðåëà íà ñòîëå, Ñâå÷à ãîðåëà. Êàê ëåòîì ðîåì ìîøêîðà Ëåòèò íà ïëàìÿ, Ñëåòàëèñü õëîïüÿ ñî äâîðà Ê îêîííîé ðàìå. Ìåòåëü ëåïèëà íà ñòîëå Êðóæêè è ñòðåëû. Ñâå÷à ãîðåëà íà ñòîëå, Ñâå÷à ãîðåëà. Íà îçàðåííûé ïîòîëîê Ëîæèëèñü òåíè, Ñêðåùåíüÿ ðóê, ñêðêùåíüÿ íîã, Ñóäüáû ñêðåùåíüÿ. È ïàäàëè äâà áàøìà÷êà Ñî ñòóêîì íà ïîë, È âîñê ñëåçàìè ñ íî÷íèêà Íà ïëàòüå êàïàë. È âñå òåðÿëîñü â ñíåæíîé ìãëå Ñåäîé è áåëîé. Ñâå÷à ãîðåëà íà ñòîëå, Ñâå÷à ãîðåëà. Íà ñâå÷êó äóëî èç óãëà, È æàð ñîáëàçíà Âçäûìàë, êàê àíãåë, äâà êðûëà Êðåñòîîáðàçíî. Ìåëî âåñü ìåñÿö â ôåâðàëå, È òî è äåëî Ñâå÷à ãîðåëà íà ñòîëå, Ñâå÷à ãîðåëà. -- Áîðèñ Ïàñòåðíàê, 1946 [end] =cut Pod-Simple-3.45/t/corpus/laozi38b.xml0000644000175000017500000000611514243754135015530 0ustar khwkhw big5-eten 老子道德經 三十八章 -- Big5 (Chinese) encoding test 上德不德，是以有德﹔ 下德不失德，是以無德。 上德無為而無以為﹔ 下德無為而有以為。 上仁為之而無以為﹔ 上義為之而有以為。 上禮為之而莫之應，則攘臂而扔之。 故失道而后德，失德而后仁，失仁而后義，失義而后禮。夫禮者，忠信之薄，而亂之首。 前識者，道之華，而愚之始。 是以大丈夫居其厚，不居其薄﹔居其實，不居其華。 故去彼取此。 And as a verbatim section: 上德不德，是以有德﹔ 下德不失德，是以無德。 上德無為而無以為﹔ 下德無為而有以為。 上仁為之而無以為﹔ 上義為之而有以為。 上禮為之而莫之應，則攘臂而扔之。 故失道而后德，失德而后仁，失仁而后義，失義而后禮。夫禮者，忠信之薄，而亂之首。 前識者，道之華，而愚之始。 是以大丈夫居其厚，不居其薄﹔居其實，不居其華。 故去彼取此。 [end] Pod-Simple-3.45/t/corpus/2202jpx.txt0000644000175000017500000000276614243754136015234 0ustar khwkhw =head1 NAME haiku-iso2022jp -- a test Japanese document in iso-2022-jp =head1 DESCRIPTION =encoding iso-2022-jp This is a test Pod document in ISO-2202-JP. Its content is some Japanese haiku by famous poets. =head2 MATSUO BASHO ($B>>HxGN>V(B 1644 - 1694) : $B8ECS$d3?$H$S9~$`?e$N2;(B (furuike ya / kawazu tobikomu / mizu no oto) As verbatim: $B8ECS$d3?$H$S9~$`?e$N2;(B =head2 YOSA BUSON ($BM?L?$$$/$P$/$+$"$kLkC;$7(B (yomei / ikubakuka aru / yo mijikashi) $BM>L?$$$/$P$/$+$"$kLkC;$7(B =head1 AS A LIST =over =item MATSUO BASHO ($B>>HxGN>V(B 1644 - 1694) : $B8ECS$d3?$H$S9~$`?e$N2;(B (furuike ya / kawazu tobikomu / mizu no oto) As verbatim: $B8ECS$d3?$H$S9~$`?e$N2;(B =item YOSA BUSON ($BM?L?$$$/$P$/$+$"$kLkC;$7(B (yomei / ikubakuka aru / yo mijikashi) $BM>L?$$$/$P$/$+$"$kLkC;$7(B =back .end. =cut Pod-Simple-3.45/t/corpus/fet_dup.xml0000644000175000017500000001452214243754135015524 0ustar khwkhw koi8-r NAME Когда читала ты мучительные строки -- Fet's "When you were reading" TEXT (This is a test Pod pocument in KOI8-R.) Когда читала ты мучительные строки, / Где сердца звучный пыл сиянье льет кругом / И страсти роковой вздымаются потоки,- / Не вспомнила ль о чем? Я верить не хочу! Когда в степи, как диво, / В полночной темноте безвременно горя, / Вдали перед тобой прозрачно и красиво / Вставала вдругзаря. И в эту красоту невольно взор тянуло, / В тот величавый блеск за темный весь предел,- / Ужель ничто тебе в то время не шепнуло: / Там человек сгорел! 15 февраля 1887 And now, as a verbatim section: Когда читала ты мучительные строки, Где сердца звучный пыл сиянье льет кругом И страсти роковой вздымаются потоки,- Не вспомнила ль о чем? Я верить не хочу! Когда в степи, как диво, В полночной темноте безвременно горя, Вдали перед тобой прозрачно и красиво Вставала вдругзаря. koi8-r И в эту красоту невольно взор тянуло, В тот величавый блеск за темный весь предел,- Ужель ничто тебе в то время не шепнуло: Там человек сгорел! 15 февраля 1887 [end] Pod-Simple-3.45/t/corpus/plain_latin1.xml0000644000175000017500000000137514243754135016453 0ustar khwkhw iso-8859-1 NAME simple_text_document -- an explicitly Latin-1 (ASCII subset) test document TEXT The quick brown fox jumps over the lazy dog. Military Intelligence Yukon rhosts penrep Weekly World News DSD Time Cohiba finks rail gun DF ~ Corporate Security NATOA CCS DEVGRP CONUS Khaddafi NATIA data havens Spetznaz afsatcom BOP Semtex garbage KGB ^? 737 1080H 1080H Satellite imagery smuggle [end] Pod-Simple-3.45/t/corpus/encwarn03.xml0000644000175000017500000000006714243754135015675 0ustar khwkhw Pod-Simple-3.45/t/corpus/polish_utf8.xml0000644000175000017500000000623714243754135016346 0ustar khwkhw utf8 NAME WŚRÓD NOCNEJ CISZY -- explicitly utf8 test document in Polish DESCRIPTION This is a test Pod document in UTF8. Its content is the lyrics to the Polish Christmas carol "Wśród nocnej ciszy", except it includes a few lines to test RTF specially. ff is a character in the upper half of Plane 0, so should be negative in RTF 𝔸 is a character in Plane 1, so should be expressed as a surrogate pair in RTF All the ASCII printables !"#$%&\'()*+,-./0123456789:;<=>?@ ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_` abcdefghijklmnopqrstuvwxyz{|}~ Wśród nocnej ciszy głos się rozchodzi: / Wstańcie, pasterze, Bóg się nam rodzi! / Czym prędzej się wybierajcie, / Do Betlejem pospieszajcie / Przywitać Pana. Poszli, znaleźli Dzieciątko w żłobie / Z wszystkimi znaki danymi sobie. / Jako Bogu cześć Mu dali, / A witając zawołali / Z wielkiej radości: Ach, witaj Zbawco z dawno żądany, / Wiele tysięcy lat wyglądany / Na Ciebie króle, prorocy / Czekali, a Tyś tej nocy / Nam się objawił. I my czekamy na Ciebie, Pana, / A skoro przyjdziesz na głos kapłana, / Padniemy na twarz przed Tobą, / Wierząc, żeś jest pod osłoną / Chleba i wina. As Verbatim And now as verbatim text: ff upper half, Plane 0 𝔸 Plane 1 All the ASCII printables !"#$%&\'()*+,-./0123456789:;<=>?@ ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_` abcdefghijklmnopqrstuvwxyz{|}~ Wśród nocnej ciszy głos się rozchodzi: Wstańcie, pasterze, Bóg się nam rodzi! Czym prędzej się wybierajcie, Do Betlejem pospieszajcie Przywitać Pana. Poszli, znaleźli Dzieciątko w żłobie Z wszystkimi znaki danymi sobie. Jako Bogu cześć Mu dali, A witając zawołali Z wielkiej radości: Ach, witaj Zbawco z dawno żądany, Wiele tysięcy lat wyglądany Na Ciebie króle, prorocy Czekali, a Tyś tej nocy Nam się objawił. I my czekamy na Ciebie, Pana, A skoro przyjdziesz na głos kapłana, Padniemy na twarz przed Tobą, Wierząc, żeś jest pod osłoną Chleba i wina. [end] Pod-Simple-3.45/t/corpus/pasternak_cp1251.xml0000644000175000017500000002254714243754136017070 0ustar khwkhw cp1251 NAME Зимняя ночь -- Pasternak Russian test file (cp1251) TEXT (This is a test Pod pocument in cp1251.) Зимняя ночь. Мело, мело по всей земле / Во все пределы. / Свеча горела на столе, / Свеча горела. Как летом роем мошкора / Летит на пламя, / Слетались хлопья со двора / К оконной раме. Метель лепила на столе / Кружки и стрелы. / Свеча горела на столе, / Свеча горела. На озаренный потолок / Ложились тени, / Скрещенья рук, скркщенья ног, / Судьбы скрещенья. И падали два башмачка / Со стуком на пол, / И воск слезами с ночника / На платье капал. И все терялось в снежной мгле / Седой и белой. / Свеча горела на столе, / Свеча горела. На свечку дуло из угла, / И жар соблазна / Вздымал, как ангел, два крыла / Крестообразно. / Мело весь месяц в феврале, / И то и дело / Свеча горела на столе, / Свеча горела. -- Борис Пастернак, 1946 As Preformatted And now as a preformatted section: Зимняя ночь. Мело, мело по всей земле Во все пределы. Свеча горела на столе, Свеча горела. Как летом роем мошкора Летит на пламя, Слетались хлопья со двора К оконной раме. Метель лепила на столе Кружки и стрелы. Свеча горела на столе, Свеча горела. На озаренный потолок Ложились тени, Скрещенья рук, скркщенья ног, Судьбы скрещенья. И падали два башмачка Со стуком на пол, И воск слезами с ночника На платье капал. И все терялось в снежной мгле Седой и белой. Свеча горела на столе, Свеча горела. На свечку дуло из угла, И жар соблазна Вздымал, как ангел, два крыла Крестообразно. Мело весь месяц в феврале, И то и дело Свеча горела на столе, Свеча горела. -- Борис Пастернак, 1946 [end] Pod-Simple-3.45/t/corpus/plain_latin1.txt0000644000175000017500000000074714243754135016474 0ustar khwkhw #Doesn't actually use any of the Latin-1 bytes. =encoding iso-8859-1 =head1 NAME simple_text_document -- an explicitly Latin-1 (ASCII subset) test document =head1 TEXT The quick brown fox jumps over the lazy dog. Military Intelligence Yukon rhosts penrep Weekly World News DSD Time Cohiba finks rail gun DF ~ Corporate Security NATOA CCS DEVGRP CONUS Khaddafi NATIA data havens Spetznaz afsatcom BOP Semtex garbage KGB ^? 737 1080H 1080H Satellite imagery smuggle [end] =cut Pod-Simple-3.45/t/corpus/encwarn03.txt0000644000175000017500000000033714243754135015714 0ustar khwkhwpackage 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; Pod-Simple-3.45/t/corpus/2202jpy.xml0000644000175000017500000001141514243754135015204 0ustar khwkhw NAME haiku-iso2022jp -- a test Japanese document in iso-2022-jp DESCRIPTION iso-2022-jp This is a test Pod document in ISO-2202-JP. Its content is some Japanese haiku by famous poets. MATSUO BASHO (松尾芭蕉 1644 - 1694) : 古池や蛙とび込む水の音 (furuike ya / kawazu tobikomu / mizu no oto) As verbatim: 古池や蛙とび込む水の音 YOSA BUSON (与謝蕪村1716 - 1783) 方八里雨雲よせぬ牡丹かな (ho hachiri / amagumo yosenu / botan kana) As verbatim: 方八里雨雲よせぬ牡丹かな MASAOKA SHIKI (正岡子規 1867 - 1902) いちはつの一輪白し春の暮 (ichihatsu no / ichirin shiroshi / haruno kure) As verbatim: いちはつの一輪白し春の暮 余命いくばくかある夜短し (yomei / ikubakuka aru / yo mijikashi) 余命いくばくかある夜短し AS A LIST MATSUO BASHO (松尾芭蕉 1644 - 1694) : 古池や蛙とび込む水の音 (furuike ya / kawazu tobikomu / mizu no oto) As verbatim: 古池や蛙とび込む水の音 YOSA BUSON (与謝蕪村1716 - 1783) 方八里雨雲よせぬ牡丹かな (ho hachiri / amagumo yosenu / botan kana) As verbatim: 方八里雨雲よせぬ牡丹かな MASAOKA SHIKI (正岡子規 1867 - 1902) いちはつの一輪白し春の暮 (ichihatsu no / ichirin shiroshi / haruno kure) As verbatim: いちはつの一輪白し春の暮 余命いくばくかある夜短し (yomei / ikubakuka aru / yo mijikashi) 余命いくばくかある夜短し "end" Pod-Simple-3.45/t/corpus/iso6.xml0000644000175000017500000001202714243754135014754 0ustar khwkhw NAME buniya-iso-6 -- test document: a paragraph in Arabic as ISO-8859-6 DESCRIPTION This document is a paragraph in Arabic from "The Five Pillars of Islam" as ISO-8859-6. iso-8859-6 وعن عمارة بن حزم قال قال رسول الله صلى الله عليه وسلم: اربع فرضهن الله عز وجل في الاسلام فمن جاء بثلاث لم يغنين عنه شيئا حتى يأتي بهن جميعا الصلاة والزكاة وصيام رمضان وحج البيت. رواه احمد والطبراني في الكبير وفي اسناده ابن لهيعة. And now as a real single paragraph: وعن عمارة بن حزم قال قال رسول الله صلى الله عليه وسلم: اربع فرضهن الله عز وجل في الاسلام فمن جاء بثلاث لم يغنين عنه شيئا حتى يأتي بهن جميعا الصلاة والزكاة وصيام رمضان وحج البيت. رواه احمد والطبراني في الكبير وفي اسناده ابن لهيعة. And now as a verbatim paragraph: وعن عمارة بن حزم قال قال رسول الله صلى الله عليه وسلم: اربع فرضهن الله عز وجل في الاسلام فمن جاء بثلاث لم يغنين عنه شيئا حتى يأتي بهن جميعا الصلاة والزكاة وصيام رمضان وحج البيت. رواه احمد والطبراني في الكبير وفي اسناده ابن لهيعة. [end] Pod-Simple-3.45/t/corpus/polish_utf8.txt0000644000175000017500000000402414243754135016355 0ustar khwkhw =encoding utf8 =head1 NAME WÅšRÓD NOCNEJ CISZY -- explicitly utf8 test document in Polish =head1 DESCRIPTION This is a test Pod document in UTF8. Its content is the lyrics to the Polish Christmas carol "WÅ›ród nocnej ciszy", except it includes a few lines to test RTF specially. ff is a character in the upper half of Plane 0, so should be negative in RTF 𔸠is a character in Plane 1, so should be expressed as a surrogate pair in RTF All the ASCII printables !"#$%&\'()*+,-./0123456789:;<=>?@ ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_` abcdefghijklmnopqrstuvwxyz{|}~ WÅ›ród nocnej ciszy gÅ‚os siÄ™ rozchodzi: / WstaÅ„cie, pasterze, Bóg siÄ™ nam rodzi! / Czym prÄ™dzej siÄ™ wybierajcie, / Do Betlejem pospieszajcie / Przywitać Pana. Poszli, znaleźli DzieciÄ…tko w żłobie / Z wszystkimi znaki danymi sobie. / Jako Bogu cześć Mu dali, / A witajÄ…c zawoÅ‚ali / Z wielkiej radoÅ›ci: Ach, witaj Zbawco z dawno żądany, / Wiele tysiÄ™cy lat wyglÄ…dany / Na Ciebie króle, prorocy / Czekali, a TyÅ› tej nocy / Nam siÄ™ objawiÅ‚. I my czekamy na Ciebie, Pana, / A skoro przyjdziesz na gÅ‚os kapÅ‚ana, / Padniemy na twarz przed TobÄ…, / WierzÄ…c, żeÅ› jest pod osÅ‚onÄ… / Chleba i wina. =head2 As Verbatim And now as verbatim text: ff upper half, Plane 0 𔸠Plane 1 All the ASCII printables !"#$%&\'()*+,-./0123456789:;<=>?@ ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_` abcdefghijklmnopqrstuvwxyz{|}~ WÅ›ród nocnej ciszy gÅ‚os siÄ™ rozchodzi: WstaÅ„cie, pasterze, Bóg siÄ™ nam rodzi! Czym prÄ™dzej siÄ™ wybierajcie, Do Betlejem pospieszajcie Przywitać Pana. Poszli, znaleźli DzieciÄ…tko w żłobie Z wszystkimi znaki danymi sobie. Jako Bogu cześć Mu dali, A witajÄ…c zawoÅ‚ali Z wielkiej radoÅ›ci: Ach, witaj Zbawco z dawno żądany, Wiele tysiÄ™cy lat wyglÄ…dany Na Ciebie króle, prorocy Czekali, a TyÅ› tej nocy Nam siÄ™ objawiÅ‚. I my czekamy na Ciebie, Pana, A skoro przyjdziesz na gÅ‚os kapÅ‚ana, Padniemy na twarz przed TobÄ…, WierzÄ…c, żeÅ› jest pod osÅ‚onÄ… Chleba i wina. [end] =cut Pod-Simple-3.45/t/corpus/enc_char_wrong_directive.xml0000644000175000017500000000227014243754136021110 0ustar khwkhw NAME Implicit Encoding with Warning in UTF8 and wrong encoding directive iso-8859-1 DESCRIPTION This line should warn that the price €9.99 contains a non-ASCII character. iso-8859-1 And château should not generate a warning. POD ERRORS Hey! The above document had some coding errors, which are explained below: Around line 8: Non-ASCII character seen before =encoding in '€9.99'. Assuming UTF-8 Around line 10: Couldn't do =encoding iso-8859-1: Encoding is already set to UTF-8 Pod-Simple-3.45/t/corpus/laozi38.xml0000644000175000017500000000611014243754136015362 0ustar khwkhw big5 老子道德經 三十八章 -- Big5 (Chinese) encoding test 上德不德，是以有德﹔ 下德不失德，是以無德。 上德無為而無以為﹔ 下德無為而有以為。 上仁為之而無以為﹔ 上義為之而有以為。 上禮為之而莫之應，則攘臂而扔之。 故失道而后德，失德而后仁，失仁而后義，失義而后禮。夫禮者，忠信之薄，而亂之首。 前識者，道之華，而愚之始。 是以大丈夫居其厚，不居其薄﹔居其實，不居其華。 故去彼取此。 And as a verbatim section: 上德不德，是以有德﹔ 下德不失德，是以無德。 上德無為而無以為﹔ 下德無為而有以為。 上仁為之而無以為﹔ 上義為之而有以為。 上禮為之而莫之應，則攘臂而扔之。 故失道而后德，失德而后仁，失仁而后義，失義而后禮。夫禮者，忠信之薄，而亂之首。 前識者，道之華，而愚之始。 是以大丈夫居其厚，不居其薄﹔居其實，不居其華。 故去彼取此。 [end] Pod-Simple-3.45/t/corpus/nonesuch.txt0000644000175000017500000000013414243754135015731 0ustar khwkhw=encoding blorpy =head1 nonesuch -- Document in an unknown encoding Blorp. [end] =cut Pod-Simple-3.45/t/corpus/laozi38.txt0000644000175000017500000000142114243754135015400 0ustar khwkhw=encoding big5 =head1 ¦Ñ¤l¹D¼w¸g¡@¤T¤Q¤K³¹ -- Big5 (Chinese) encoding test ¤W¼w¤£¼w¡A¬O¥H¦³¼w¡Q ¤U¼w¤£¥¢¼w¡A¬O¥HµL¼w¡C ¤W¼wµL¬°¦ÓµL¥H¬°¡Q ¤U¼wµL¬°¦Ó¦³¥H¬°¡C ¤W¤¯¬°¤§¦ÓµL¥H¬°¡Q ¤W¸q¬°¤§¦Ó¦³¥H¬°¡C ¤W§¬°¤§¦Ó²ö¤§À³¡A«hÄcÁu¦Ó¥µ¤§¡C ¬G¥¢¹D¦Ó¦Z¼w¡A¥¢¼w¦Ó¦Z¤¯¡A¥¢¤¯¦Ó¦Z¸q¡A¥¢¸q¦Ó¦Z§¡C¤Ò§ªÌ¡A©¾«H¤§Á¡¡A¦Ó¶Ã¤§­º¡C «eÃѪ̡A¹D¤§µØ¡A¦Ó·M¤§©l¡C ¬O¥H¤j¤V¤Ò©~¨ä«p¡A¤£©~¨äÁ¡¡Q©~¨ä¹ê¡A¤£©~¨äµØ¡C ¬G¥h©¼¨ú¦¹¡C And as a verbatim section: ¤W¼w¤£¼w¡A¬O¥H¦³¼w¡Q ¤U¼w¤£¥¢¼w¡A¬O¥HµL¼w¡C ¤W¼wµL¬°¦ÓµL¥H¬°¡Q ¤U¼wµL¬°¦Ó¦³¥H¬°¡C ¤W¤¯¬°¤§¦ÓµL¥H¬°¡Q ¤W¸q¬°¤§¦Ó¦³¥H¬°¡C ¤W§¬°¤§¦Ó²ö¤§À³¡A«hÄcÁu¦Ó¥µ¤§¡C ¬G¥¢¹D¦Ó¦Z¼w¡A¥¢¼w¦Ó¦Z¤¯¡A¥¢¤¯¦Ó¦Z¸q¡A¥¢¸q¦Ó¦Z§¡C¤Ò§ªÌ¡A©¾«H¤§Á¡¡A¦Ó¶Ã¤§­º¡C «eÃѪ̡A¹D¤§µØ¡A¦Ó·M¤§©l¡C ¬O¥H¤j¤V¤Ò©~¨ä«p¡A¤£©~¨äÁ¡¡Q©~¨ä¹ê¡A¤£©~¨äµØ¡C ¬G¥h©¼¨ú¦¹¡C [end] =cut Pod-Simple-3.45/t/corpus/laozi38p.xml0000644000175000017500000000671414243754135015553 0ustar khwkhw big5 NAME 老子道德經 三十八章 -- Big5 (Chinese) encoding test DESCRIPTION This is a test Pod document in the Big5 encoding. Its content is the 38th canto from the Dao De Jing . 老子道德經 三十八章 上德不德，是以有德﹔ 下德不失德，是以無德。 上德無為而無以為﹔ 下德無為而有以為。 上仁為之而無以為﹔ 上義為之而有以為。 上禮為之而莫之應，則攘臂而扔之。 故失道而后德，失德而后仁，失仁而后義，失義而后禮。夫禮者，忠信之薄，而亂之首。 前識者，道之華，而愚之始。 是以大丈夫居其厚，不居其薄﹔居其實，不居其華。 故去彼取此。 And as a verbatim section: 上德不德，是以有德﹔ 下德不失德，是以無德。 上德無為而無以為﹔ 下德無為而有以為。 上仁為之而無以為﹔ 上義為之而有以為。 上禮為之而莫之應，則攘臂而扔之。 故失道而后德，失德而后仁，失仁而后義，失義而后禮。夫禮者，忠信之薄，而亂之首。 前識者，道之華，而愚之始。 是以大丈夫居其厚，不居其薄﹔居其實，不居其華。 故去彼取此。 [end] Pod-Simple-3.45/t/corpus/nonesuch.xml0000644000175000017500000000373214243754136015722 0ustar khwkhw nonesuch -- Document in an unknown encoding Blorp. [end] POD ERRORS Hey! The above document had some coding errors, which are explained below: Around line 1: This document probably does not appear as it should, because its "=encoding blorpy" line calls for an unsupported encoding. [Encode.pm v1.98's supported encodings are: 7bit-jis AdobeStandardEncoding AdobeSymbol AdobeZdingbat ascii ascii-ctrl big5-eten big5-hkscs cp1006 cp1026 cp1047 cp1250 cp1251 cp1252 cp1253 cp1254 cp1255 cp1256 cp1257 cp1258 cp37 cp424 cp437 cp500 cp737 cp775 cp850 cp852 cp855 cp856 cp857 cp860 cp861 cp862 cp863 cp864 cp865 cp866 cp869 cp874 cp875 cp932 cp936 cp949 cp950 dingbats euc-cn euc-jp euc-kr gb12345-raw gb2312-raw gsm0338 hp-roman8 hz iso-2022-jp iso-2022-jp-1 iso-2022-kr iso-8859-1 iso-8859-10 iso-8859-11 iso-8859-13 iso-8859-14 iso-8859-15 iso-8859-16 iso-8859-2 iso-8859-3 iso-8859-4 iso-8859-5 iso-8859-6 iso-8859-7 iso-8859-8 iso-8859-9 iso-ir-165 jis0201-raw jis0208-raw jis0212-raw johab koi8-f koi8-r koi8-u ksc5601-raw MacArabic MacCentralEurRoman MacChineseSimp MacChineseTrad MacCroatian MacCyrillic MacDingbats MacFarsi MacGreek MacHebrew MacIcelandic MacJapanese MacKorean MacRoman MacRomanian MacRumanian MacSami MacSymbol MacThai MacTurkish MacUkrainian MIME-B MIME-Header MIME-Q nextstep null posix-bc shiftjis symbol UCS-2BE UCS-2LE UTF-16 UTF-16BE UTF-16LE UTF-32 UTF-32BE UTF-32LE UTF-7 utf8 viscii] Pod-Simple-3.45/t/corpus/koi8r.xml0000644000175000017500000001431714243754135015134 0ustar khwkhw koi8-r NAME Когда читала ты мучительные строки -- Fet's "When you were reading" TEXT (This is a test Pod pocument in KOI8-R.) Когда читала ты мучительные строки, / Где сердца звучный пыл сиянье льет кругом / И страсти роковой вздымаются потоки,- / Не вспомнила ль о чем? Я верить не хочу! Когда в степи, как диво, / В полночной темноте безвременно горя, / Вдали перед тобой прозрачно и красиво / Вставала вдругзаря. И в эту красоту невольно взор тянуло, / В тот величавый блеск за темный весь предел,- / Ужель ничто тебе в то время не шепнуло: / Там человек сгорел! 15 февраля 1887 And now, as a verbatim section: Когда читала ты мучительные строки, Где сердца звучный пыл сиянье льет кругом И страсти роковой вздымаются потоки,- Не вспомнила ль о чем? Я верить не хочу! Когда в степи, как диво, В полночной темноте безвременно горя, Вдали перед тобой прозрачно и красиво Вставала вдругзаря. И в эту красоту невольно взор тянуло, В тот величавый блеск за темный весь предел,- Ужель ничто тебе в то время не шепнуло: Там человек сгорел! 15 февраля 1887 [end] Pod-Simple-3.45/t/corpus/lat1frim.xml0000644000175000017500000000471414243754135015617 0ustar khwkhw NAME French-Latin-1 -- implicitly Latin-1 test document in French DESCRIPTION This is a test Pod document in Latin-1. Its content is the last two paragraphs of Baudelaire's Le Joujou du pauvre . A travers ces barreaux symboliques séparant deux mondes, la grande route et le château, l'enfant pauvre montrait à l'enfant riche son propre joujou, que celui-ci examinait avidement comme un objet rare et inconnu. Or, ce joujou, que le petit souillon agaçait, agitait et secouait dans une boîte grillée, c'était un rat vivant ! Les parents, par économie sans doute, avaient tiré le joujou de la vie elle-même. Et les deux enfants se riaient l'un à l'autre fraternellement, avec des dents d'une égale blancheur. As Verbatim A travers ces barreaux symboliques séparant deux mondes, la grande route et le château, l'enfant pauvre montrait à l'enfant riche son propre joujou, que celui-ci examinait avidement comme un objet rare et inconnu. Or, ce joujou, que le petit souillon agaçait, agitait et secouait dans une boîte grillée, c'était un rat vivant ! Les parents, par économie sans doute, avaient tiré le joujou de la vie elle-même. Et les deux enfants se riaient l'un à l'autre fraternellement, avec des dents d'une égale blancheur. [end] POD ERRORS Hey! The above document had some coding errors, which are explained below: Around line 11: Non-ASCII character seen before =encoding in 'séparant'. Assuming CP1252 Pod-Simple-3.45/t/corpus/thai_iso11.txt0000644000175000017500000000260214243754136016053 0ustar khwkhw =head1 NAME Khun::Thong::Dang -- a test Thai document in ISO-8859-11 =head1 DESCRIPTION =encoding iso-8859-11 This is a test Pod document in ISO-8859-11. Its content is a poem to (by?) Khun Thong Dang (ÀÒ¾ÁÔè§Á§¤Å), the pet of Bhumibol, the King of Thailand. As four flowed paragraphs: ï ¾ÃÐàÁµµÒá¨èÁ¨Ñºã¨ä¼·ÊÂÒÁ / ¾ÃзѧÒÁ...ÁͧÀÒ¾¶èÒÂÁÔ¶èÒ¶͹ / à¡ÅéÒÏ ¹éÍÁà¡ÅéÒÏ ¾¨¹ìàÃÕ§༴Õ§¡Å͹ / Ê×èÍÊзé͹¾ÃСÒÃسÂìÍØ蹴ǧÁÒ¹ú ï ·Ø¡ÀÒ¾ÁÔè§Á§¤ÅÂÅáÅéÇÂÔéÁ / àÍ×éÍÍ¡ÍÔèÁÅéÓ¤èÒÁËÒÈÒÅ / ÍÂÒ¡à»ç¹¤Ø³·Í§á´§¹Ñ¡¨Ñ¡ÍÂÙè§Ò¹ / à½éÒ¤ÅÍà¤ÅÕº·ÁÒÅÂì¾ÃÐÀÙÁÔ¾Åú ï ¾ÃÐËѵ¶ìºØ­·Ã§àºÔ¡ËÅéÒ¾ÅÔ¡ËÅéÒà¢ÕÂÇ / ¾ÃÐâÍÉ°ìàÃÕÂǵÃÑÊËéÒÁʧ¤ÃÒÁ©Å / ¾ÃзÑ ¸ âÍÀÒʼèͧ¶èͧʡŠ/ ¾ÃÐÂؤźҷÂèÒ§Ê׺ÊÃéÒ§ä·Âú ï ¹éÍÁà¡ÅéÒà·Ô´Í§¤ìÃҪѹÈÃѹÂìÈÃÕ / ºÒÃÁÕËÁ×蹤Ù褧Íʧä¢Â / ¡ÃôÔÃÒª¡ÄɮҡéͧËÅéÒä¡Å / »Å×éÁ»ÃзѺ¶éǹ·Ø¡ã¨áËè§ä·éàÍÂúÐû =head2 Verbatim Section And as a verbatim section: ï ¾ÃÐàÁµµÒá¨èÁ¨Ñºã¨ä¼·ÊÂÒÁ ¾ÃзѧÒÁ...ÁͧÀÒ¾¶èÒÂÁÔ¶èÒ¶͹ à¡ÅéÒÏ ¹éÍÁà¡ÅéÒÏ ¾¨¹ìàÃÕ§༴Õ§¡Å͹ Ê×èÍÊзé͹¾ÃСÒÃسÂìÍØ蹴ǧÁÒ¹ú ï ·Ø¡ÀÒ¾ÁÔè§Á§¤ÅÂÅáÅéÇÂÔéÁ àÍ×éÍÍ¡ÍÔèÁÅéÓ¤èÒÁËÒÈÒÅ ÍÂÒ¡à»ç¹¤Ø³·Í§á´§¹Ñ¡¨Ñ¡ÍÂÙè§Ò¹ à½éÒ¤ÅÍà¤ÅÕº·ÁÒÅÂì¾ÃÐÀÙÁÔ¾Åú ï ¾ÃÐËѵ¶ìºØ­·Ã§àºÔ¡ËÅéÒ¾ÅÔ¡ËÅéÒà¢ÕÂÇ ¾ÃÐâÍÉ°ìàÃÕÂǵÃÑÊËéÒÁʧ¤ÃÒÁ©Å ¾ÃзÑ ¸ âÍÀÒʼèͧ¶èͧʡŠ¾ÃÐÂؤźҷÂèÒ§Ê׺ÊÃéÒ§ä·Âú ï ¹éÍÁà¡ÅéÒà·Ô´Í§¤ìÃҪѹÈÃѹÂìÈÃÕ ºÒÃÁÕËÁ×蹤Ù褧Íʧä¢Â ¡ÃôÔÃÒª¡ÄɮҡéͧËÅéÒä¡Å »Å×éÁ»ÃзѺ¶éǹ·Ø¡ã¨áËè§ä·éàÍÂúÐû [end] =cut Pod-Simple-3.45/t/corpus/lat1frim.txt0000644000175000017500000000241614243754135015633 0ustar khwkhw =head1 NAME French-Latin-1 -- implicitly Latin-1 test document in French =head1 DESCRIPTION This is a test Pod document in Latin-1. Its content is the last two paragraphs of Baudelaire's I. A travers ces barreaux symboliques séparant deux mondes, la grande route et le château, l'enfant pauvre montrait à l'enfant riche son propre joujou, que celui-ci examinait avidement comme un objet rare et inconnu. Or, ce joujou, que le petit souillon agaçait, agitait et secouait dans une boîte grillée, c'était un rat vivantE<160>! Les parents, par économie sans doute, avaient tiré le joujou de la vie elle-même. Et les deux enfants se riaient l'un à l'autre fraternellement, avec des dents d'une I<égale> blancheur. =head2 As Verbatim A travers ces barreaux symboliques séparant deux mondes, la grande route et le château, l'enfant pauvre montrait à l'enfant riche son propre joujou, que celui-ci examinait avidement comme un objet rare et inconnu. Or, ce joujou, que le petit souillon agaçait, agitait et secouait dans une boîte grillée, c'était un rat vivant ! Les parents, par économie sans doute, avaient tiré le joujou de la vie elle-même. Et les deux enfants se riaient l'un à l'autre fraternellement, avec des dents d'une égale blancheur. [end] =cut Pod-Simple-3.45/t/corpus/lat1fr.xml0000644000175000017500000000402514243754136015265 0ustar khwkhw iso-8859-1 NAME French-Latin-1 -- explicitly Latin-1 test document in French DESCRIPTION This is a test Pod document in Latin-1. Its content is the last two paragraphs of Baudelaire's Le Joujou du pauvre . A travers ces barreaux symboliques séparant deux mondes, la grande route et le château, l'enfant pauvre montrait à l'enfant riche son propre joujou, que celui-ci examinait avidement comme un objet rare et inconnu. Or, ce joujou, que le petit souillon agaçait, agitait et secouait dans une boîte grillée, c'était un rat vivant ! Les parents, par économie sans doute, avaient tiré le joujou de la vie elle-même. Et les deux enfants se riaient l'un à l'autre fraternellement, avec des dents d'une égale blancheur. As Verbatim A travers ces barreaux symboliques séparant deux mondes, la grande route et le château, l'enfant pauvre montrait à l'enfant riche son propre joujou, que celui-ci examinait avidement comme un objet rare et inconnu. Or, ce joujou, que le petit souillon agaçait, agitait et secouait dans une boîte grillée, c'était un rat vivant ! Les parents, par économie sans doute, avaient tiré le joujou de la vie elle-même. Et les deux enfants se riaient l'un à l'autre fraternellement, avec des dents d'une égale blancheur. [end] Pod-Simple-3.45/t/corpus/plain.txt0000644000175000017500000000062314243754136015216 0ustar khwkhw =head1 NAME simple_text_document -- an implicitly US-ASCII test document. =head1 TEXT The quick brown fox jumps over the lazy dog. Military Intelligence Yukon rhosts penrep Weekly World News DSD Time Cohiba finks rail gun DF ~ Corporate Security NATOA CCS DEVGRP CONUS Khaddafi NATIA data havens Spetznaz afsatcom BOP Semtex garbage KGB ^? 737 1080H 1080H Satellite imagery smuggle [end] =cut Pod-Simple-3.45/t/corpus/fet_cont.xml0000644000175000017500000000234314243754136015676 0ustar khwkhw koi8-r NAME Когда читала ты мучительные строки -- Fet's "When you were reading" TEXT Shift-JIS (This is a test Pod pocument in KOI8-R.) 15 февраля 1887 [end] POD ERRORS Hey! The above document had some coding errors, which are explained below: Around line 13: Couldn't do =encoding Shift-JIS: Encoding is already set to koi8-r Pod-Simple-3.45/t/corpus/8859_7.pod0000644000175000017500000000117514243754136014724 0ustar khwkhw =encoding iso-8859-7 =head1 NAME Ïëõìðéáêüò ¾ìíïò -- ÊùóôÞò ÐáëáìÜò =head1 DESCRIPTION Áñ÷áßï Ðíåýì' áèÜíáôïí, áãíÝ ðáôÝñá ôïõ ùñáßïõ, ôïõ ìåãÜëïõ êáé ô' áëçèéíïý, êáôÝâá, öáíåñþóïõ êé Üóôñáø' åäþ ðÝñá óôç äüîá ôçò äéêÞò óïõ ãçò êáé ô' ïõñáíïý. Óôï äñüìï êáé óôï ðÜëåìá êáé óôï ëéèÜñé, óôùí åõãåíþí Áãþíùí ëÜìøå ôçí ïñìÞ, êáé ìå ô' áìÜñáíôï óôåöÜíùóå êëùíÜñé êáé óéäåñÝíéï ðëÜóå êé Üîéï ôï êïñìß. ÊÜìðïé, âïõíÜ êáé ðÝëáãá öÝããïõí ìáæß óïõ óáí Ýíáò ëåõêïðüñöõñïò ìÝãáò íáüò, êáé ôñÝ÷åé óôï íáü åäþ ðñïóêõíçôÞò óïõ. Áñ÷áßï Ðíåýì' áèÜíáôï, êÜèå ëáüò. =cut The above is the Olympic Hymn, by Kostis Palamas. Yup, it's in Greek. Pod-Simple-3.45/t/corpus/plain_explicit.txt0000644000175000017500000000064414243754135017121 0ustar khwkhw =encoding ascii =head1 NAME simple_text_document -- an explicitly US-ASCII test document. =head1 TEXT The quick brown fox jumps over the lazy dog. Military Intelligence Yukon rhosts penrep Weekly World News DSD Time Cohiba finks rail gun DF ~ Corporate Security NATOA CCS DEVGRP CONUS Khaddafi NATIA data havens Spetznaz afsatcom BOP Semtex garbage KGB ^? 737 1080H 1080H Satellite imagery smuggle [end] =cut Pod-Simple-3.45/t/corpus/enc_char_directive.xml0000644000175000017500000000173714243754135017702 0ustar khwkhw NAME Implicit Encoding with Warning and encoding directive in UTF-8 DESCRIPTION This line should warn that the price €9.99 contains a non-ASCII character. utf8 And château should not generate a warning. POD ERRORS Hey! The above document had some coding errors, which are explained below: Around line 8: Non-ASCII character seen before =encoding in '€9.99'. Assuming UTF-8 Pod-Simple-3.45/t/corpus/laozi38p.pod0000644000175000017500000000166514243754135015535 0ustar khwkhw =encoding big5 =head1 NAME ¦Ñ¤l¹D¼w¸g¡@¤T¤Q¤K³¹ -- Big5 (Chinese) encoding test =head1 DESCRIPTION This is a test Pod document in the Big5 encoding. Its content is the 38th canto from the I. =head2 ¦Ñ¤l¹D¼w¸g¡@¤T¤Q¤K³¹ ¤W¼w¤£¼w¡A¬O¥H¦³¼w¡Q ¤U¼w¤£¥¢¼w¡A¬O¥HµL¼w¡C ¤W¼wµL¬°¦ÓµL¥H¬°¡Q ¤U¼wµL¬°¦Ó¦³¥H¬°¡C ¤W¤¯¬°¤§¦ÓµL¥H¬°¡Q ¤W¸q¬°¤§¦Ó¦³¥H¬°¡C ¤W§¬°¤§¦Ó²ö¤§À³¡A«hÄcÁu¦Ó¥µ¤§¡C ¬G¥¢¹D¦Ó¦Z¼w¡A¥¢¼w¦Ó¦Z¤¯¡A¥¢¤¯¦Ó¦Z¸q¡A¥¢¸q¦Ó¦Z§¡C¤Ò§ªÌ¡A©¾«H¤§Á¡¡A¦Ó¶Ã¤§­º¡C «eÃѪ̡A¹D¤§µØ¡A¦Ó·M¤§©l¡C ¬O¥H¤j¤V¤Ò©~¨ä«p¡A¤£©~¨äÁ¡¡Q©~¨ä¹ê¡A¤£©~¨äµØ¡C ¬G¥h©¼¨ú¦¹¡C And as a verbatim section: ¤W¼w¤£¼w¡A¬O¥H¦³¼w¡Q ¤U¼w¤£¥¢¼w¡A¬O¥HµL¼w¡C ¤W¼wµL¬°¦ÓµL¥H¬°¡Q ¤U¼wµL¬°¦Ó¦³¥H¬°¡C ¤W¤¯¬°¤§¦ÓµL¥H¬°¡Q ¤W¸q¬°¤§¦Ó¦³¥H¬°¡C ¤W§¬°¤§¦Ó²ö¤§À³¡A«hÄcÁu¦Ó¥µ¤§¡C ¬G¥¢¹D¦Ó¦Z¼w¡A¥¢¼w¦Ó¦Z¤¯¡A¥¢¤¯¦Ó¦Z¸q¡A¥¢¸q¦Ó¦Z§¡C¤Ò§ªÌ¡A©¾«H¤§Á¡¡A¦Ó¶Ã¤§­º¡C «eÃѪ̡A¹D¤§µØ¡A¦Ó·M¤§©l¡C ¬O¥H¤j¤V¤Ò©~¨ä«p¡A¤£©~¨äÁ¡¡Q©~¨ä¹ê¡A¤£©~¨äµØ¡C ¬G¥h©¼¨ú¦¹¡C [end] =cut Pod-Simple-3.45/t/corpus/encwarn01.xml0000644000175000017500000000164114243754136015673 0ustar khwkhw NAME Encoding Warning 1 - implicitly Latin-1 DESCRIPTION This line should warn that the word café contains a non-ASCII character. But château should not generate a warning - once is enough. POD ERRORS Hey! The above document had some coding errors, which are explained below: Around line 8: Non-ASCII character seen before =encoding in 'café'. Assuming CP1252 Pod-Simple-3.45/t/corpus/enc_char_wrong_directive.txt0000644000175000017500000000040314243754136021123 0ustar khwkhw =head1 NAME Implicit Encoding with Warning in UTF8 and wrong encoding directive iso-8859-1 =head2 DESCRIPTION This line should warn that the price €9.99 contains a non-ASCII character. =encoding iso-8859-1 And château should not generate a warning. Pod-Simple-3.45/t/corpus/encwarn04.txt0000644000175000017500000000046414243754136015717 0ustar khwkhwpackage 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). Pod-Simple-3.45/t/corpus/2202jpz.txt0000644000175000017500000000025114243754136015221 0ustar khwkhw =head1 NAME haiku-iso2022jp -- a test Japanese document in iso-2022-jp =head1 DESCRIPTION =encoding iso-2022-jp This is a test Pod document in ISO-2202-JP. =cut Pod-Simple-3.45/t/corpus/2202jp.xml0000644000175000017500000001140514243754136015013 0ustar khwkhw NAME haiku-iso2022jp -- a test Japanese document in iso-2022-jp DESCRIPTION iso-2022-jp This is a test Pod document in ISO-2202-JP. Its content is some Japanese haiku by famous poets. MATSUO BASHO (松尾芭蕉 1644 - 1694) : 古池や蛙とび込む水の音 (furuike ya / kawazu tobikomu / mizu no oto) As verbatim: 古池や蛙とび込む水の音 YOSA BUSON (与謝蕪村1716 - 1783) 方八里雨雲よせぬ牡丹かな (ho hachiri / amagumo yosenu / botan kana) As verbatim: 方八里雨雲よせぬ牡丹かな MASAOKA SHIKI (正岡子規 1867 - 1902) いちはつの一輪白し春の暮 (ichihatsu no / ichirin shiroshi / haruno kure) As verbatim: いちはつの一輪白し春の暮 余命いくばくかある夜短し (yomei / ikubakuka aru / yo mijikashi) 余命いくばくかある夜短し AS A LIST MATSUO BASHO (松尾芭蕉 1644 - 1694) : 古池や蛙とび込む水の音 (furuike ya / kawazu tobikomu / mizu no oto) As verbatim: 古池や蛙とび込む水の音 YOSA BUSON (与謝蕪村1716 - 1783) 方八里雨雲よせぬ牡丹かな (ho hachiri / amagumo yosenu / botan kana) As verbatim: 方八里雨雲よせぬ牡丹かな MASAOKA SHIKI (正岡子規 1867 - 1902) いちはつの一輪白し春の暮 (ichihatsu no / ichirin shiroshi / haruno kure) As verbatim: いちはつの一輪白し春の暮 余命いくばくかある夜短し (yomei / ikubakuka aru / yo mijikashi) 余命いくばくかある夜短し [end] Pod-Simple-3.45/t/corpus/enc_char_directive.txt0000644000175000017500000000035514243754136017715 0ustar khwkhw =head1 NAME Implicit Encoding with Warning and encoding directive in UTF-8 =head2 DESCRIPTION This line should warn that the price €9.99 contains a non-ASCII character. =encoding utf8 And château should not generate a warning. Pod-Simple-3.45/t/corpus/s2763_sjis.txt0000644000175000017500000000100314243754136015720 0ustar khwkhw =encoding shiftjis =head1 NAME Œ^”ÔS2763 -- test document in Shift-JIS =head1 DESCRIPTION This is a test Pod document in Shift-JIS. Its content is some uninteresting product specs I found on the Net. It's an textitem list: =over =item Œ^”Ô S2763 =item ŒõŒ¹ GZ4 ƒ_ƒCƒNƒƒCƒbƒNƒ~ƒ‰[ƒ‰ƒ“ƒv 12V 10W~1 =item ¡–@ ‚E295 •E365 ‰œE76mm =item Ž¿—Ê 8.0kg =item ÞŽ¿ Ž÷Ž‰@ƒAƒ‹ƒ~AƒAƒ‹ƒ}ƒCƒgŽdã@ƒKƒ‰ƒX =item ‰¿Ši 76,000‰~iƒ‰ƒ“ƒvEƒgƒ‰ƒ“ƒXž‚Ýj =back 2001”N10ŒŽ3“úi…j”­”„ŠJŽn [end] =cut Pod-Simple-3.45/t/corpus/2202jp.txt0000644000175000017500000000276614243754136015044 0ustar khwkhw =head1 NAME haiku-iso2022jp -- a test Japanese document in iso-2022-jp =head1 DESCRIPTION =encoding iso-2022-jp This is a test Pod document in ISO-2202-JP. Its content is some Japanese haiku by famous poets. =head2 MATSUO BASHO ($B>>HxGN>V(B 1644 - 1694) : $B8ECS$d3?$H$S9~$`?e$N2;(B (furuike ya / kawazu tobikomu / mizu no oto) As verbatim: $B8ECS$d3?$H$S9~$`?e$N2;(B =head2 YOSA BUSON ($BM?L?$$$/$P$/$+$"$kLkC;$7(B (yomei / ikubakuka aru / yo mijikashi) $BM>L?$$$/$P$/$+$"$kLkC;$7(B =head1 AS A LIST =over =item MATSUO BASHO ($B>>HxGN>V(B 1644 - 1694) : $B8ECS$d3?$H$S9~$`?e$N2;(B (furuike ya / kawazu tobikomu / mizu no oto) As verbatim: $B8ECS$d3?$H$S9~$`?e$N2;(B =item YOSA BUSON ($BM?L?$$$/$P$/$+$"$kLkC;$7(B (yomei / ikubakuka aru / yo mijikashi) $BM>L?$$$/$P$/$+$"$kLkC;$7(B =back [end] =cut Pod-Simple-3.45/t/corpus/thai_iso11.xml0000644000175000017500000001702114243754136016035 0ustar khwkhw NAME Khun::Thong::Dang -- a test Thai document in ISO-8859-11 DESCRIPTION iso-8859-11 This is a test Pod document in ISO-8859-11. Its content is a poem to (by?) Khun Thong Dang (ภาพมิ่งมงคล), the pet of Bhumibol, the King of Thailand. As four flowed paragraphs: ๏ พระเมตตาแจ่มจับใจไผทสยาม / พระทัยงาม...มองภาพถ่ายมิถ่ายถอน / เกล้าฯ น้อมเกล้าฯ พจน์เรียงเผดียงกลอน / สื่อสะท้อนพระการุณย์อุ่นดวงมาน๚ ๏ ทุกภาพมิ่งมงคลยลแล้วยิ้ม / เอื้ออกอิ่มล้ำค่ามหาศาล / อยากเป็นคุณทองแดงนักจักอยู่งาน / เฝ้าคลอเคลียบทมาลย์พระภูมิพล๚ ๏ พระหัตถ์บุญทรงเบิกหล้าพลิกหล้าเขียว / พระโอษฐ์เรียวตรัสห้ามสงครามฉล / พระทัย ธ โอภาสผ่องถ่องสกล / พระยุคลบาทย่างสืบสร้างไทย๚ ๏ น้อมเกล้าเทิดองค์ราชันศรันย์ศรี / บารมีหมื่นคู่คงอสงไขย / กรรดิราชกฤษฎาก้องหล้าไกล / ปลื้มประทับถ้วนทุกใจแห่งไท้เอย๚ะ๛ Verbatim Section And as a verbatim section: ๏ พระเมตตาแจ่มจับใจไผทสยาม พระทัยงาม...มองภาพถ่ายมิถ่ายถอน เกล้าฯ น้อมเกล้าฯ พจน์เรียงเผดียงกลอน สื่อสะท้อนพระการุณย์อุ่นดวงมาน๚ ๏ ทุกภาพมิ่งมงคลยลแล้วยิ้ม เอื้ออกอิ่มล้ำค่ามหาศาล อยากเป็นคุณทองแดงนักจักอยู่งาน เฝ้าคลอเคลียบทมาลย์พระภูมิพล๚ ๏ พระหัตถ์บุญทรงเบิกหล้าพลิกหล้าเขียว พระโอษฐ์เรียวตรัสห้ามสงครามฉล พระทัย ธ โอภาสผ่องถ่องสกล พระยุคลบาทย่างสืบสร้างไทย๚ ๏ น้อมเกล้าเทิดองค์ราชันศรันย์ศรี บารมีหมื่นคู่คงอสงไขย กรรดิราชกฤษฎาก้องหล้าไกล ปลื้มประทับถ้วนทุกใจแห่งไท้เอย๚ะ๛ [end] Pod-Simple-3.45/t/corpus/fet_dup.txt0000644000175000017500000000242114243754135015536 0ustar khwkhw We have deliberately redundant =encoding statements here. This should generate no errata. =encoding koi8-r =head1 NAME ëÏÇÄÁ ÞÉÔÁÌÁ ÔÙ ÍÕÞÉÔÅÌØÎÙÅ ÓÔÒÏËÉ -- Fet's "When you were reading" =head1 TEXT (This is a test Pod pocument in KOI8-R.) ëÏÇÄÁ ÞÉÔÁÌÁ ÔÙ ÍÕÞÉÔÅÌØÎÙÅ ÓÔÒÏËÉ, / çÄÅ ÓÅÒÄÃÁ Ú×ÕÞÎÙÊ ÐÙÌ ÓÉÑÎØÅ ÌØÅÔ ËÒÕÇÏÍ / é ÓÔÒÁÓÔÉ ÒÏËÏ×ÏÊ ×ÚÄÙÍÁÀÔÓÑ ÐÏÔÏËÉ,- / îÅ ×ÓÐÏÍÎÉÌÁ ÌØ Ï ÞÅÍ? ñ ×ÅÒÉÔØ ÎÅ ÈÏÞÕ! ëÏÇÄÁ × ÓÔÅÐÉ, ËÁË ÄÉ×Ï, / ÷ ÐÏÌÎÏÞÎÏÊ ÔÅÍÎÏÔÅ ÂÅÚ×ÒÅÍÅÎÎÏ ÇÏÒÑ, / ÷ÄÁÌÉ ÐÅÒÅÄ ÔÏÂÏÊ ÐÒÏÚÒÁÞÎÏ É ËÒÁÓÉ×Ï / ÷ÓÔÁ×ÁÌÁ ×ÄÒÕÇÚÁÒÑ. é × ÜÔÕ ËÒÁÓÏÔÕ ÎÅ×ÏÌØÎÏ ×ÚÏÒ ÔÑÎÕÌÏ, / ÷ ÔÏÔ ×ÅÌÉÞÁ×ÙÊ ÂÌÅÓË ÚÁ ÔÅÍÎÙÊ ×ÅÓØ ÐÒÅÄÅÌ,- / õÖÅÌØ ÎÉÞÔÏ ÔÅÂÅ × ÔÏ ×ÒÅÍÑ ÎÅ ÛÅÐÎÕÌÏ: / ôÁÍ ÞÅÌÏ×ÅË ÓÇÏÒÅÌ! 15 ÆÅ×ÒÁÌÑ 1887 And now, as a verbatim section: ëÏÇÄÁ ÞÉÔÁÌÁ ÔÙ ÍÕÞÉÔÅÌØÎÙÅ ÓÔÒÏËÉ, çÄÅ ÓÅÒÄÃÁ Ú×ÕÞÎÙÊ ÐÙÌ ÓÉÑÎØÅ ÌØÅÔ ËÒÕÇÏÍ é ÓÔÒÁÓÔÉ ÒÏËÏ×ÏÊ ×ÚÄÙÍÁÀÔÓÑ ÐÏÔÏËÉ,- îÅ ×ÓÐÏÍÎÉÌÁ ÌØ Ï ÞÅÍ? ñ ×ÅÒÉÔØ ÎÅ ÈÏÞÕ! ëÏÇÄÁ × ÓÔÅÐÉ, ËÁË ÄÉ×Ï, ÷ ÐÏÌÎÏÞÎÏÊ ÔÅÍÎÏÔÅ ÂÅÚ×ÒÅÍÅÎÎÏ ÇÏÒÑ, ÷ÄÁÌÉ ÐÅÒÅÄ ÔÏÂÏÊ ÐÒÏÚÒÁÞÎÏ É ËÒÁÓÉ×Ï ÷ÓÔÁ×ÁÌÁ ×ÄÒÕÇÚÁÒÑ. =encoding koi8-r é × ÜÔÕ ËÒÁÓÏÔÕ ÎÅ×ÏÌØÎÏ ×ÚÏÒ ÔÑÎÕÌÏ, ÷ ÔÏÔ ×ÅÌÉÞÁ×ÙÊ ÂÌÅÓË ÚÁ ÔÅÍÎÙÊ ×ÅÓØ ÐÒÅÄÅÌ,- õÖÅÌØ ÎÉÞÔÏ ÔÅÂÅ × ÔÏ ×ÒÅÍÑ ÎÅ ÛÅÐÎÕÌÏ: ôÁÍ ÞÅÌÏ×ÅË ÓÇÏÒÅÌ! 15 ÆÅ×ÒÁÌÑ 1887 [end] =cut Pod-Simple-3.45/t/corpus/8859_7.xml0000644000175000017500000000602414243754136014740 0ustar khwkhw iso-8859-7 NAME Ολυμπιακός Ύμνος -- Κωστής Παλαμάς DESCRIPTION Αρχαίο Πνεύμ' αθάνατον, αγνέ πατέρα του ωραίου, του μεγάλου και τ' αληθινού, κατέβα, φανερώσου κι άστραψ' εδώ πέρα στη δόξα της δικής σου γης και τ' ουρανού. Στο δρόμο και στο πάλεμα και στο λιθάρι, στων ευγενών Αγώνων λάμψε την ορμή, και με τ' αμάραντο στεφάνωσε κλωνάρι και σιδερένιο πλάσε κι άξιο το κορμί. Κάμποι, βουνά και πέλαγα φέγγουν μαζί σου σαν ένας λευκοπόρφυρος μέγας ναός, και τρέχει στο ναό εδώ προσκυνητής σου. Αρχαίο Πνεύμ' αθάνατο, κάθε λαός. Pod-Simple-3.45/t/corpus/encwarn04.xml0000644000175000017500000000140214243754135015670 0ustar khwkhw 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). POD ERRORS Hey! The above document had some coding errors, which are explained below: Around line 13: Non-ASCII character seen before =encoding in 'TŨTORIAL'. Assuming UTF-8 Pod-Simple-3.45/t/corpus/fet_cont.txt0000644000175000017500000000045314243754136015715 0ustar khwkhw We have deliberately contradictory =encoding statements here. This should generate errata. =encoding koi8-r =head1 NAME ëÏÇÄÁ ÞÉÔÁÌÁ ÔÙ ÍÕÞÉÔÅÌØÎÙÅ ÓÔÒÏËÉ -- Fet's "When you were reading" =head1 TEXT =encoding Shift-JIS (This is a test Pod pocument in KOI8-R.) 15 ÆÅ×ÒÁÌÑ 1887 [end] =cut Pod-Simple-3.45/t/corpus/encwarn02.xml0000644000175000017500000000164314243754135015675 0ustar khwkhw NAME Encoding Warning 1 - implicitly UTF-8 DESCRIPTION This line should warn that the price €9.99 contains a non-ASCII character. But château should not generate a warning - once is enough. POD ERRORS Hey! The above document had some coding errors, which are explained below: Around line 8: Non-ASCII character seen before =encoding in '€9.99'. Assuming UTF-8 Pod-Simple-3.45/t/corpus/iso6.txt0000644000175000017500000000175414243754136015001 0ustar khwkhw =head1 NAME buniya-iso-6 -- test document: a paragraph in Arabic as ISO-8859-6 =head1 DESCRIPTION This document is a paragraph in Arabic from "The Five Pillars of Islam" as ISO-8859-6. =encoding iso-8859-6 èÙæ ÙåÇÑÉ Èæ ÍÒå âÇä âÇä ÑÓèä Çääç Õäé Çääç Ùäêç èÓäå: ÇÑÈÙ áÑÖçæ Çääç ÙÒ èÌä áê ÇäÇÓäÇå áåæ ÌÇÁ ÈËäÇË äå êÚæêæ Ùæç ÔêÆÇ ÍÊé êÃÊê Èçæ ÌåêÙÇ ÇäÕäÇÉ èÇäÒãÇÉ èÕêÇå ÑåÖÇæ èÍÌ ÇäÈêÊ. ÑèÇç ÇÍåÏ èÇä×ÈÑÇæê áê ÇäãÈêÑ èáê ÇÓæÇÏç ÇÈæ äçêÙÉ. And now as a real single paragraph: èÙæ ÙåÇÑÉ Èæ ÍÒå âÇä âÇä ÑÓèä Çääç Õäé Çääç Ùäêç èÓäå: ÇÑÈÙ áÑÖçæ Çääç ÙÒ èÌä áê ÇäÇÓäÇå áåæ ÌÇÁ ÈËäÇË äå êÚæêæ Ùæç ÔêÆÇ ÍÊé êÃÊê Èçæ ÌåêÙÇ ÇäÕäÇÉ èÇäÒãÇÉ èÕêÇå ÑåÖÇæ èÍÌ ÇäÈêÊ. ÑèÇç ÇÍåÏ èÇä×ÈÑÇæê áê ÇäãÈêÑ èáê ÇÓæÇÏç ÇÈæ äçêÙÉ. And now as a verbatim paragraph: èÙæ ÙåÇÑÉ Èæ ÍÒå âÇä âÇä ÑÓèä Çääç Õäé Çääç Ùäêç èÓäå: ÇÑÈÙ áÑÖçæ Çääç ÙÒ èÌä áê ÇäÇÓäÇå áåæ ÌÇÁ ÈËäÇË äå êÚæêæ Ùæç ÔêÆÇ ÍÊé êÃÊê Èçæ ÌåêÙÇ ÇäÕäÇÉ èÇäÒãÇÉ èÕêÇå ÑåÖÇæ èÍÌ ÇäÈêÊ. ÑèÇç ÇÍåÏ èÇä×ÈÑÇæê áê ÇäãÈêÑ èáê ÇÓæÇÏç ÇÈæ äçêÙÉ. [end] =cut Pod-Simple-3.45/t/corpus/plain.xml0000644000175000017500000000126514243754136015202 0ustar khwkhw NAME simple_text_document -- an implicitly US-ASCII test document. TEXT The quick brown fox jumps over the lazy dog. Military Intelligence Yukon rhosts penrep Weekly World News DSD Time Cohiba finks rail gun DF ~ Corporate Security NATOA CCS DEVGRP CONUS Khaddafi NATIA data havens Spetznaz afsatcom BOP Semtex garbage KGB ^? 737 1080H 1080H Satellite imagery smuggle [end] Pod-Simple-3.45/t/corpus/lat1fr.txt0000644000175000017500000000244414243754135015306 0ustar khwkhw =encoding iso-8859-1 =head1 NAME French-Latin-1 -- explicitly Latin-1 test document in French =head1 DESCRIPTION This is a test Pod document in Latin-1. Its content is the last two paragraphs of Baudelaire's I. A travers ces barreaux symboliques séparant deux mondes, la grande route et le château, l'enfant pauvre montrait à l'enfant riche son propre joujou, que celui-ci examinait avidement comme un objet rare et inconnu. Or, ce joujou, que le petit souillon agaçait, agitait et secouait dans une boîte grillée, c'était un rat vivantE<160>! Les parents, par économie sans doute, avaient tiré le joujou de la vie elle-même. Et les deux enfants se riaient l'un à l'autre fraternellement, avec des dents d'une I<égale> blancheur. =head2 As Verbatim A travers ces barreaux symboliques séparant deux mondes, la grande route et le château, l'enfant pauvre montrait à l'enfant riche son propre joujou, que celui-ci examinait avidement comme un objet rare et inconnu. Or, ce joujou, que le petit souillon agaçait, agitait et secouait dans une boîte grillée, c'était un rat vivant ! Les parents, par économie sans doute, avaient tiré le joujou de la vie elle-même. Et les deux enfants se riaient l'un à l'autre fraternellement, avec des dents d'une égale blancheur. [end] =cut Pod-Simple-3.45/t/corpus/laozi38b.txt0000644000175000017500000000142614243754135015547 0ustar khwkhw=encoding big5-eten =head1 ¦Ñ¤l¹D¼w¸g¡@¤T¤Q¤K³¹ -- Big5 (Chinese) encoding test ¤W¼w¤£¼w¡A¬O¥H¦³¼w¡Q ¤U¼w¤£¥¢¼w¡A¬O¥HµL¼w¡C ¤W¼wµL¬°¦ÓµL¥H¬°¡Q ¤U¼wµL¬°¦Ó¦³¥H¬°¡C ¤W¤¯¬°¤§¦ÓµL¥H¬°¡Q ¤W¸q¬°¤§¦Ó¦³¥H¬°¡C ¤W§¬°¤§¦Ó²ö¤§À³¡A«hÄcÁu¦Ó¥µ¤§¡C ¬G¥¢¹D¦Ó¦Z¼w¡A¥¢¼w¦Ó¦Z¤¯¡A¥¢¤¯¦Ó¦Z¸q¡A¥¢¸q¦Ó¦Z§¡C¤Ò§ªÌ¡A©¾«H¤§Á¡¡A¦Ó¶Ã¤§­º¡C «eÃѪ̡A¹D¤§µØ¡A¦Ó·M¤§©l¡C ¬O¥H¤j¤V¤Ò©~¨ä«p¡A¤£©~¨äÁ¡¡Q©~¨ä¹ê¡A¤£©~¨äµØ¡C ¬G¥h©¼¨ú¦¹¡C And as a verbatim section: ¤W¼w¤£¼w¡A¬O¥H¦³¼w¡Q ¤U¼w¤£¥¢¼w¡A¬O¥HµL¼w¡C ¤W¼wµL¬°¦ÓµL¥H¬°¡Q ¤U¼wµL¬°¦Ó¦³¥H¬°¡C ¤W¤¯¬°¤§¦ÓµL¥H¬°¡Q ¤W¸q¬°¤§¦Ó¦³¥H¬°¡C ¤W§¬°¤§¦Ó²ö¤§À³¡A«hÄcÁu¦Ó¥µ¤§¡C ¬G¥¢¹D¦Ó¦Z¼w¡A¥¢¼w¦Ó¦Z¤¯¡A¥¢¤¯¦Ó¦Z¸q¡A¥¢¸q¦Ó¦Z§¡C¤Ò§ªÌ¡A©¾«H¤§Á¡¡A¦Ó¶Ã¤§­º¡C «eÃѪ̡A¹D¤§µØ¡A¦Ó·M¤§©l¡C ¬O¥H¤j¤V¤Ò©~¨ä«p¡A¤£©~¨äÁ¡¡Q©~¨ä¹ê¡A¤£©~¨äµØ¡C ¬G¥h©¼¨ú¦¹¡C [end] =cut Pod-Simple-3.45/t/corpus/encwarn01.txt0000644000175000017500000000032214243754136015705 0ustar khwkhw =head1 NAME Encoding Warning 1 - implicitly Latin-1 =head2 DESCRIPTION This line should warn that the word café contains a non-ASCII character. But château should not generate a warning - once is enough. Pod-Simple-3.45/t/corpus/plain_utf8.xml0000644000175000017500000000136414243754136016150 0ustar khwkhw utf8 NAME simple_text_document -- an explicitly UTF8 (ASCII subset) test document TEXT The quick brown fox jumps over the lazy dog. Military Intelligence Yukon rhosts penrep Weekly World News DSD Time Cohiba finks rail gun DF ~ Corporate Security NATOA CCS DEVGRP CONUS Khaddafi NATIA data havens Spetznaz afsatcom BOP Semtex garbage KGB ^? 737 1080H 1080H Satellite imagery smuggle [end] Pod-Simple-3.45/t/corpus/2202jpy.txt0000644000175000017500000000276614243754136015235 0ustar khwkhw =head1 NAME haiku-iso2022jp -- a test Japanese document in iso-2022-jp =head1 DESCRIPTION =encoding iso-2022-jp This is a test Pod document in ISO-2202-JP. Its content is some Japanese haiku by famous poets. =head2 MATSUO BASHO ($B>>HxGN>V(B 1644 - 1694) : $B8ECS$d3?$H$S9~$`?e$N2;(B (furuike ya / kawazu tobikomu / mizu no oto) As verbatim: $B8ECS$d3?$H$S9~$`?e$N2;(B =head2 YOSA BUSON ($BM?L?$$$/$P$/$+$"$kLkC;$7(B (yomei / ikubakuka aru / yo mijikashi) $BM>L?$$$/$P$/$+$"$kLkC;$7(B =head1 AS A LIST =over =item MATSUO BASHO ($B>>HxGN>V(B 1644 - 1694) : $B8ECS$d3?$H$S9~$`?e$N2;(B (furuike ya / kawazu tobikomu / mizu no oto) As verbatim: $B8ECS$d3?$H$S9~$`?e$N2;(B =item YOSA BUSON ($BM?L?$$$/$P$/$+$"$kLkC;$7(B (yomei / ikubakuka aru / yo mijikashi) $BM>L?$$$/$P$/$+$"$kLkC;$7(B =back "end" =cut Pod-Simple-3.45/t/corpus/2202jpx.xml0000644000175000017500000001140514243754135015202 0ustar khwkhw NAME haiku-iso2022jp -- a test Japanese document in iso-2022-jp DESCRIPTION iso-2022-jp This is a test Pod document in ISO-2202-JP. Its content is some Japanese haiku by famous poets. MATSUO BASHO (松尾芭蕉 1644 - 1694) : 古池や蛙とび込む水の音 (furuike ya / kawazu tobikomu / mizu no oto) As verbatim: 古池や蛙とび込む水の音 YOSA BUSON (与謝蕪村1716 - 1783) 方八里雨雲よせぬ牡丹かな (ho hachiri / amagumo yosenu / botan kana) As verbatim: 方八里雨雲よせぬ牡丹かな MASAOKA SHIKI (正岡子規 1867 - 1902) いちはつの一輪白し春の暮 (ichihatsu no / ichirin shiroshi / haruno kure) As verbatim: いちはつの一輪白し春の暮 余命いくばくかある夜短し (yomei / ikubakuka aru / yo mijikashi) 余命いくばくかある夜短し AS A LIST MATSUO BASHO (松尾芭蕉 1644 - 1694) : 古池や蛙とび込む水の音 (furuike ya / kawazu tobikomu / mizu no oto) As verbatim: 古池や蛙とび込む水の音 YOSA BUSON (与謝蕪村1716 - 1783) 方八里雨雲よせぬ牡丹かな (ho hachiri / amagumo yosenu / botan kana) As verbatim: 方八里雨雲よせぬ牡丹かな MASAOKA SHIKI (正岡子規 1867 - 1902) いちはつの一輪白し春の暮 (ichihatsu no / ichirin shiroshi / haruno kure) As verbatim: いちはつの一輪白し春の暮 余命いくばくかある夜短し (yomei / ikubakuka aru / yo mijikashi) 余命いくばくかある夜短し .end. Pod-Simple-3.45/t/corpus/2202jpz.xml0000644000175000017500000000056514243754136015212 0ustar khwkhw NAME haiku-iso2022jp -- a test Japanese document in iso-2022-jp DESCRIPTION iso-2022-jp This is a test Pod document in ISO-2202-JP. Pod-Simple-3.45/t/items.t0000644000175000017500000002047014243763554013353 0ustar khwkhwuse strict; use warnings; use Test::More tests => 22; BEGIN { require FindBin; unshift @INC, $FindBin::Bin . '/lib'; } use helpers; my $d; #use Pod::Simple::Debug (\$d,0); use Pod::Simple::DumpAsXML; use Pod::Simple::XMLOutStream; print "# Pod::Simple version $Pod::Simple::VERSION\n"; 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 simple =item *'s\n"; is( $x->_out("\n=over\n\n=item *\n\nStuff\n\n=item *\n\nBar I!\n\n=back\n\n"), 'StuffBar baz!' ); is( $x->_out("\n=over\n\n=item *\n\nStuff\n\n=cut\n\nStuff\n\n=item *\n\nBar I!\n\n=back\n\n"), 'StuffBar baz!' ); is( $x->_out("\n=over 10\n\n=item *\n\nStuff\n\n=cut\n\nStuff\n\n=item *\n\nBar I!\n\n=back\n\n"), 'StuffBar baz!' ); is( $x->_out("\n=over\n\n=item *\n\nStuff\n=cut\nStuff\n\n=item *\n\nBar I!\n\n=back"), 'StuffBar baz!' ); print "#\n# Tests for simple =item 1.'s\n"; is( $x->_out("\n=over\n\n=item 1.\n\nStuff\n\n=item 2.\n\nBar I!\n\n=back\n\n"), 'StuffBar baz!' ); is( $x->_out("\n=over\n\n=item 1.\n\nStuff\n\n=cut\n\nStuff\n\n=item 2.\n\nBar I!\n\n=back\n\n"), 'StuffBar baz!' ); # Now without a dot is( $x->_out("\n=over\n\n=item 1\n\nStuff\n\n=cut\n\nStuff\n\n=item 2\n\nBar I!\n\n=back\n\n"), 'StuffBar baz!' ); is( $x->_out("\n=over\n\n=item 1\n\nStuff\n=cut\nStuff\n\n=item 2\n\nBar I!\n\n=back"), 'StuffBar baz!' ); print "#\n# Tests for =over blocks (without =items)\n"; is( $x->_out("\n=over\n\nStuff\n\nBar I!\n\n=back\n\n"), 'StuffBar baz!' ); is( $x->_out("\n=over\n\n Stuff\n\nBar I!\n\n=back\n\n"), ' StuffBar baz!' ); is( $x->_out("\n=over\n\nBar I!\n\n Stuff\n\n=back\n\n"), 'Bar baz! Stuff' ); print "#\n# Tests for =item Text blocks...\n"; is( $x->_out("\n=over\n\n=item Foo\n\nStuff\n\n=cut\n\nCrunk\nZorp\n\n=item Bar I!\n\nQuux\n\n=back\n\n"), 'FooStuffBar baz!Quux' ); is( $x->_out("\n=over\n\n=item Foo\n\n Stuff\n\tSnork\n\n=cut\n\nCrunk\nZorp\n\n=item Bar I!\n\nQuux\n\n=back\n\n"), qq{Foo Stuff\n Snork} . qq{Bar baz!Quux} ); is( $x->_out("\n=over\n\n=item Foo\n\n Stuff\n\tSnork\n=cut\n\nCrunk\nZorp\n\n=item Bar I!\n\nQuux\n\n=back\n\n"), qq{Foo Stuff\n Snork} . qq{Bar baz!Quux} ); print "#\n# Test for mixed =item blocks...\n"; is( $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!\n\nQuux\n\n=item *\n\nThwoong\n\n=back\n\n"), qq{FooStuff} . qq{2.Bar baz!Quux} . qq{*Thwoong} ); # ok( $x->_out("\n=over\n\n=item *\n\nStuff\n\n=item 2.\n\nBar I!\n\nQuux\n\n=item *\n\nThwoong\n\n=back\n\n"), # ok( $x->_out("\n=over\n\n=item 1.\n\nStuff\n\n=item 2.\n\nBar I!\n\nQuux\n\n=item *\n\nThwoong\n\n=back\n\n"), print "#\n# Tests for indenting\n"; is( $x->_out("\n=over 19\n\n=item *\n\nStuff\n\n=item *\n\nBar I!\n\n=back\n\n"), 'StuffBar baz!' ); is( $x->_out("\n=over 19\n\n=item 1.\n\nStuff\n\n=item 2.\n\nBar I!\n\n=back\n\n"), 'StuffBar baz!' ); is( $x->_out("\n=over 19\n\nStuff\n\nBar I!\n\n=back\n\n"), 'StuffBar baz!' ); is( $x->_out("\n=over 19\n\n=item Foo\n\nStuff\n\n=cut\n\nCrunk\nZorp\n\n=item Bar I!\n\nQuux\n\n=back\n\n"), 'FooStuffBar baz!Quux' ); #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ print "# Now testing nesting...\n"; is( $x->_out(join "\n\n", '', '=over', '=item *', 'Stuff', '=cut', 'Stuff', '=over', '=item 1.', '=item 2.', 'Bar I!', '=back', '=item *', 'Bar I!', '=back', '' ), join '', '', '', 'Stuff', '', '', 'Bar baz!', '', 'Bar baz!', '' ); #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ is( $x->_out( join "\n\n", '', '', '=over', '=item *', 'Stuff', '=cut', 'Stuff', '=over', '=item 1.', '=over 19', 'Gleiven', 'Squim F<.thingrc>!', '=back', '=item 2.', 'Bar I!', '=back', '=item *', 'Bar I!', '=back', '', '' ), join '', '', '', 'Stuff', '', '', '', 'Gleiven', 'Squim .thingrc!', '', 'Bar baz!', '', 'Bar baz!', '' ); #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ $d = 11; print "# Now checking that document-end closes things right...\n"; is( $x->_out( # We know there'd be a warning about implicit =back; disable it! sub { $_[0]->no_whining(1); }, join( "\n\n", '', '', '=over', '=item *', 'Stuff', '=cut', 'Stuff', '=over', '=item 1.', '=over 19', 'Gleiven', 'Squim F<.thingrc>!', '', '', ), ), join '', '', '', 'Stuff', '', '', '', 'Gleiven', 'Squim .thingrc!', '', '', '' ); # TODO: more checking of coercion in nesting? Pod-Simple-3.45/t/ac_d.t0000644000175000017500000000572114243763554013122 0ustar khwkhwuse strict; use warnings; use Test::More tests => 12; #use Pod::Simple::Debug (6); use Pod::Simple::DumpAsXML; use Pod::Simple::XMLOutStream; $Pod::Simple::XMLOutStream::ATTR_PAD = ' '; $Pod::Simple::XMLOutStream::SORT_ATTRS = 1; # for predictably testable output $Pod::Simple::XMLOutStream::ATTR_PAD = ' '; $Pod::Simple::XMLOutStream::SORT_ATTRS = 1; # for predictably testable output my $x = 'Pod::Simple::XMLOutStream'; print "# Testing exceptions being thrown...\n"; eval { $x->new->accept_directive('head1') }; if($@) { ok 1 } # print " # Good: exception thrown: $@\n" } else { ok 0, 'No exception thrown!' } eval { $x->new->accept_directive('I like pie') }; if($@) { ok 1 } # print " # Good: exception thrown: $@\n" } else { ok 0, 'No exception thrown!' } #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # print "Testing basic directive behavior...\n"; sub Pd { shift->accept_directive_as_data( 'freepies') } sub Pv { shift->accept_directive_as_verbatim( 'freepies') } sub Pp { shift->accept_directive_as_processed('freepies') } like( $x->_out( "\n=freepies Mmmmpie\n\n") => qr/POD ERROR/ ); is( $x->_out(\&Pp, "\n=freepies Mmmmpie\n\n"), 'Mmmmpie' ); is( $x->_out(\&Pv, "\n=freepies Mmmmpie\n\n"), 'Mmmmpie' ); is( $x->_out(\&Pd, "\n=freepies Mmmmpie\n\n"), 'Mmmmpie' ); # print "Testing more complex directive behavior...\n"; is( $x->_out(\&Pp, "\n=freepies Mmmmpie \n\tI! \n\n"), 'Mmmmpie is good!' ); is( $x->_out(\&Pd, "\n=freepies Mmmmpie \n\tI! \n\n"), qq{Mmmmpie \n\tI<is good>! } ); is( $x->_out(\&Pv, "\n=freepies Mmmmpie \n\tI! \n\n"), qq{Mmmmpie \n I<is good>! } ); # print "Testing within larger documents...\n"; is( $x->_out(\&Pp, "\n=head1 NAME\n\nPie Consortium -- me gustan pasteles\n\n=freepies Mmmmpie \n\tI! \n\nGoody!"), 'NAMEPie Consortium -- me gustan pastelesMmmmpie is good!Goody!' ); is( $x->_out(\&Pd, "\n=head1 NAME\n\nPie Consortium -- me gustan pasteles\n\n=freepies Mmmmpie \n\tI! \n\nGoody!"), qq{NAMEPie Consortium -- me gustan pastelesMmmmpie \n\tI<is good>! Goody!} ); is( $x->_out(\&Pv, "\n=head1 NAME\n\nPie Consortium -- me gustan pasteles\n\n=freepies Mmmmpie \n\tI! \n\nGoody!"), qq{NAMEPie Consortium -- me gustan pastelesMmmmpie \n I<is good>! Goody!} ); Pod-Simple-3.45/t/perlvar.pod0000644000175000017500000012111214243754136014213 0ustar khwkhw=head1 NAME perlvar - Perl predefined variables =head1 DESCRIPTION =head2 Predefined Names The following names have special meaning to Perl. Most punctuation names have reasonable mnemonics, or analogs in the shells. Nevertheless, if you wish to use long variable names, you need only say use English; at the top of your program. This will alias all the short names to the long names in the current package. Some even have medium names, generally borrowed from B. If you don't mind the performance hit, variables that depend on the currently selected filehandle may instead be set by calling an appropriate object method on the IO::Handle object. (Summary lines below for this contain the word HANDLE.) First you must say use IO::Handle; after which you may use either method HANDLE EXPR or more safely, HANDLE->method(EXPR) Each method returns the old value of the IO::Handle attribute. The methods each take an optional EXPR, which if supplied specifies the new value for the IO::Handle attribute in question. If not supplied, most methods do nothing to the current value--except for autoflush(), which will assume a 1 for you, just to be different. Because loading in the IO::Handle class is an expensive operation, you should learn how to use the regular built-in variables. A few of these variables are considered "read-only". This means that if you try to assign to this variable, either directly or indirectly through a reference, you'll raise a run-time exception. The following list is ordered by scalar variables first, then the arrays, then the hashes. =over 8 =item $ARG =item $_ The default input and pattern-searching space. The following pairs are equivalent: while (<>) {...} # equivalent only in while! while (defined($_ = <>)) {...} /^Subject:/ $_ =~ /^Subject:/ tr/a-z/A-Z/ $_ =~ tr/a-z/A-Z/ chomp chomp($_) Here are the places where Perl will assume $_ even if you don't use it: =over 3 =item * Various unary functions, including functions like ord() and int(), as well as the all file tests (C<-f>, C<-d>) except for C<-t>, which defaults to STDIN. =item * Various list functions like print() and unlink(). =item * The pattern matching operations C, C, and C when used without an C<=~> operator. =item * The default iterator variable in a C loop if no other variable is supplied. =item * The implicit iterator variable in the grep() and map() functions. =item * The default place to put an input record when a C<< >> operation's result is tested by itself as the sole criterion of a C test. Outside a C test, this will not happen. =back (Mnemonic: underline is understood in certain operations.) =back =over 8 =item $> Contains the subpattern from the corresponding set of capturing parentheses from the last pattern match, not counting patterns matched in nested blocks that have been exited already. (Mnemonic: like \digits.) These variables are all read-only and dynamically scoped to the current BLOCK. =item $MATCH =item $& The string matched by the last successful pattern match (not counting any matches hidden within a BLOCK or eval() enclosed by the current BLOCK). (Mnemonic: like & in some editors.) This variable is read-only and dynamically scoped to the current BLOCK. The use of this variable anywhere in a program imposes a considerable performance penalty on all regular expression matches. See L. =item $PREMATCH =item $` The string preceding whatever was matched by the last successful pattern match (not counting any matches hidden within a BLOCK or eval enclosed by the current BLOCK). (Mnemonic: C<`> often precedes a quoted string.) This variable is read-only. The use of this variable anywhere in a program imposes a considerable performance penalty on all regular expression matches. See L. =item $POSTMATCH =item $' The string following whatever was matched by the last successful pattern match (not counting any matches hidden within a BLOCK or eval() enclosed by the current BLOCK). (Mnemonic: C<'> often follows a quoted string.) Example: $_ = 'abcdefghi'; /def/; print "$`:$&:$'\n"; # prints abc:def:ghi This variable is read-only and dynamically scoped to the current BLOCK. The use of this variable anywhere in a program imposes a considerable performance penalty on all regular expression matches. See L. =item $LAST_PAREN_MATCH =item $+ The last bracket matched by the last search pattern. This is useful if you don't know which one of a set of alternative patterns matched. For example: /Version: (.*)|Revision: (.*)/ && ($rev = $+); (Mnemonic: be positive and forward looking.) This variable is read-only and dynamically scoped to the current BLOCK. =item @LAST_MATCH_END =item @+ This array holds the offsets of the ends of the last successful submatches in the currently active dynamic scope. C<$+[0]> is the offset into the string of the end of the entire match. This is the same value as what the C function returns when called on the variable that was matched against. The Ith element of this array holds the offset of the Ith submatch, so C<$+[1]> is the offset past where $1 ends, C<$+[2]> the offset past where $2 ends, and so on. You can use C<$#+> to determine how many subgroups were in the last successful match. See the examples given for the C<@-> variable. =item $MULTILINE_MATCHING =item $* Set to a non-zero integer value to do multi-line matching within a string, 0 (or undefined) to tell Perl that it can assume that strings contain a single line, for the purpose of optimizing pattern matches. Pattern matches on strings containing multiple newlines can produce confusing results when C<$*> is 0 or undefined. Default is undefined. (Mnemonic: * matches multiple things.) This variable influences the interpretation of only C<^> and C<$>. A literal newline can be searched for even when C<$* == 0>. Use of C<$*> is deprecated in modern Perl, supplanted by the C and C modifiers on pattern matching. Assigning a non-numerical value to C<$*> triggers a warning (and makes C<$*> act if C<$* == 0>), while assigning a numerical value to C<$*> makes that an implicit C is applied on the value. =item input_line_number HANDLE EXPR =item $INPUT_LINE_NUMBER =item $NR =item $. The current input record number for the last file handle from which you just read() (or called a C or C on). The value may be different from the actual physical line number in the file, depending on what notion of "line" is in effect--see C<$/> on how to change that. An explicit close on a filehandle resets the line number. Because C<< <> >> never does an explicit close, line numbers increase across ARGV files (but see examples in L). Consider this variable read-only: setting it does not reposition the seek pointer; you'll have to do that on your own. Localizing C<$.> has the effect of also localizing Perl's notion of "the last read filehandle". (Mnemonic: many programs use "." to mean the current line number.) =item input_record_separator HANDLE EXPR =item $INPUT_RECORD_SEPARATOR =item $RS =item $/ The input record separator, newline by default. This influences Perl's idea of what a "line" is. Works like B's RS variable, including treating empty lines as a terminator if set to the null string. (An empty line cannot contain any spaces or tabs.) You may set it to a multi-character string to match a multi-character terminator, or to C to read through the end of file. Setting it to C<"\n\n"> means something slightly different than setting to C<"">, if the file contains consecutive empty lines. Setting to C<""> will treat two or more consecutive empty lines as a single empty line. Setting to C<"\n\n"> will blindly assume that the next input character belongs to the next paragraph, even if it's a newline. (Mnemonic: / delimits line boundaries when quoting poetry.) undef $/; # enable "slurp" mode $_ = ; # whole file now here s/\n[ \t]+/ /g; Remember: the value of C<$/> is a string, not a regex. B has to be better for something. :-) Setting C<$/> to a reference to an integer, scalar containing an integer, or scalar that's convertible to an integer will attempt to read records instead of lines, with the maximum record size being the referenced integer. So this: $/ = \32768; # or \"32768", or \$var_containing_32768 open(FILE, $myfile); $_ = ; will read a record of no more than 32768 bytes from FILE. If you're not reading from a record-oriented file (or your OS doesn't have record-oriented files), then you'll likely get a full chunk of data with every read. If a record is larger than the record size you've set, you'll get the record back in pieces. On VMS, record reads are done with the equivalent of C, so it's best not to mix record and non-record reads on the same file. (This is unlikely to be a problem, because any file you'd want to read in record mode is probably unusable in line mode.) Non-VMS systems do normal I/O, so it's safe to mix record and non-record reads of a file. See also L. Also see C<$.>. =item autoflush HANDLE EXPR =item $OUTPUT_AUTOFLUSH =item $| If set to nonzero, forces a flush right away and after every write or print on the currently selected output channel. Default is 0 (regardless of whether the channel is really buffered by the system or not; C<$|> tells you only whether you've asked Perl explicitly to flush after each write). STDOUT will typically be line buffered if output is to the terminal and block buffered otherwise. Setting this variable is useful primarily when you are outputting to a pipe or socket, such as when you are running a Perl program under B and want to see the output as it's happening. This has no effect on input buffering. See L for that. (Mnemonic: when you want your pipes to be piping hot.) =item output_field_separator HANDLE EXPR =item $OUTPUT_FIELD_SEPARATOR =item $OFS =item $, The output field separator for the print operator. Ordinarily the print operator simply prints out its arguments without further adornment. To get behavior more like B, set this variable as you would set B's OFS variable to specify what is printed between fields. (Mnemonic: what is printed when there is a "," in your print statement.) =item output_record_separator HANDLE EXPR =item $OUTPUT_RECORD_SEPARATOR =item $ORS =item $\ The output record separator for the print operator. Ordinarily the print operator simply prints out its arguments as is, with no trailing newline or other end-of-record string added. To get behavior more like B, set this variable as you would set B's ORS variable to specify what is printed at the end of the print. (Mnemonic: you set C<$\> instead of adding "\n" at the end of the print. Also, it's just like C<$/>, but it's what you get "back" from Perl.) =item $LIST_SEPARATOR =item $" This is like C<$,> except that it applies to array and slice values interpolated into a double-quoted string (or similar interpreted string). Default is a space. (Mnemonic: obvious, I think.) =item $SUBSCRIPT_SEPARATOR =item $SUBSEP =item $; The subscript separator for multidimensional array emulation. If you refer to a hash element as $foo{$a,$b,$c} it really means $foo{join($;, $a, $b, $c)} But don't put @foo{$a,$b,$c} # a slice--note the @ which means ($foo{$a},$foo{$b},$foo{$c}) Default is "\034", the same as SUBSEP in B. If your keys contain binary data there might not be any safe value for C<$;>. (Mnemonic: comma (the syntactic subscript separator) is a semi-semicolon. Yeah, I know, it's pretty lame, but C<$,> is already taken for something more important.) Consider using "real" multidimensional arrays as described in L. =item $OFMT =item $# The output format for printed numbers. This variable is a half-hearted attempt to emulate B's OFMT variable. There are times, however, when B and Perl have differing notions of what counts as numeric. The initial value is "%.Ig", where I is the value of the macro DBL_DIG from your system's F. This is different from B's default OFMT setting of "%.6g", so you need to set C<$#> explicitly to get B's value. (Mnemonic: # is the number sign.) Use of C<$#> is deprecated. =item format_page_number HANDLE EXPR =item $FORMAT_PAGE_NUMBER =item $% The current page number of the currently selected output channel. Used with formats. (Mnemonic: % is page number in B.) =item format_lines_per_page HANDLE EXPR =item $FORMAT_LINES_PER_PAGE =item $= The current page length (printable lines) of the currently selected output channel. Default is 60. Used with formats. (Mnemonic: = has horizontal lines.) =item format_lines_left HANDLE EXPR =item $FORMAT_LINES_LEFT =item $- The number of lines left on the page of the currently selected output channel. Used with formats. (Mnemonic: lines_on_page - lines_printed.) =item @LAST_MATCH_START =item @- $-[0] is the offset of the start of the last successful match. C<$-[>IC<]> is the offset of the start of the substring matched by I-th subpattern, or undef if the subpattern did not match. Thus after a match against $_, $& coincides with C. Similarly, C<$>I coincides with CIC<], $+[>IC<] - $-[>IC<]> if C<$-[>IC<]> is defined, and $+ coincides with C. One can use C<$#-> to find the last matched subgroup in the last successful match. Contrast with C<$#+>, the number of subgroups in the regular expression. Compare with C<@+>. This array holds the offsets of the beginnings of the last successful submatches in the currently active dynamic scope. C<$-[0]> is the offset into the string of the beginning of the entire match. The Ith element of this array holds the offset of the Ith submatch, so C<$+[1]> is the offset where $1 begins, C<$+[2]> the offset where $2 begins, and so on. You can use C<$#-> to determine how many subgroups were in the last successful match. Compare with the C<@+> variable. After a match against some variable $var: =over 5 =item C<$`> is the same as C =item C<$&> is the same as C =item C<$'> is the same as C =item C<$1> is the same as C =item C<$2> is the same as C =item C<$3> is the same as C =back =item format_name HANDLE EXPR =item $FORMAT_NAME =item $~ The name of the current report format for the currently selected output channel. Default is the name of the filehandle. (Mnemonic: brother to C<$^>.) =item format_top_name HANDLE EXPR =item $FORMAT_TOP_NAME =item $^ The name of the current top-of-page format for the currently selected output channel. Default is the name of the filehandle with _TOP appended. (Mnemonic: points to top of page.) =item format_line_break_characters HANDLE EXPR =item $FORMAT_LINE_BREAK_CHARACTERS =item $: The current set of characters after which a string may be broken to fill continuation fields (starting with ^) in a format. Default is S<" \n-">, to break on whitespace or hyphens. (Mnemonic: a "colon" in poetry is a part of a line.) =item format_formfeed HANDLE EXPR =item $FORMAT_FORMFEED =item $^L What formats output as a form feed. Default is \f. =item $ACCUMULATOR =item $^A The current value of the write() accumulator for format() lines. A format contains formline() calls that put their result into C<$^A>. After calling its format, write() prints out the contents of C<$^A> and empties. So you never really see the contents of C<$^A> unless you call formline() yourself and then look at it. See L and L. =item $CHILD_ERROR =item $? The status returned by the last pipe close, backtick (C<``>) command, successful call to wait() or waitpid(), or from the system() operator. This is just the 16-bit status word returned by the wait() system call (or else is made up to look like it). Thus, the exit value of the subprocess is really (C<<< $? >> 8 >>>), and C<$? & 127> gives which signal, if any, the process died from, and C<$? & 128> reports whether there was a core dump. (Mnemonic: similar to B and B.) Additionally, if the C variable is supported in C, its value is returned via $? if any C function fails. If you have installed a signal handler for C, the value of C<$?> will usually be wrong outside that handler. Inside an C subroutine C<$?> contains the value that is going to be given to C. You can modify C<$?> in an C subroutine to change the exit status of your program. For example: END { $? = 1 if $? == 255; # die would make it 255 } Under VMS, the pragma C makes C<$?> reflect the actual VMS exit status, instead of the default emulation of POSIX status. Also see L. =item $OS_ERROR =item $ERRNO =item $! If used numerically, yields the current value of the C C variable, with all the usual caveats. (This means that you shouldn't depend on the value of C<$!> to be anything in particular unless you've gotten a specific error return indicating a system error.) If used an a string, yields the corresponding system error string. You can assign a number to C<$!> to set I if, for instance, you want C<"$!"> to return the string for error I, or you want to set the exit value for the die() operator. (Mnemonic: What just went bang?) Also see L. =item $EXTENDED_OS_ERROR =item $^E Error information specific to the current operating system. At the moment, this differs from C<$!> under only VMS, OS/2, and Win32 (and for MacPerl). On all other platforms, C<$^E> is always just the same as C<$!>. Under VMS, C<$^E> provides the VMS status value from the last system error. This is more specific information about the last system error than that provided by C<$!>. This is particularly important when C<$!> is set to B. Under OS/2, C<$^E> is set to the error code of the last call to OS/2 API either via CRT, or directly from perl. Under Win32, C<$^E> always returns the last error information reported by the Win32 call C which describes the last error from within the Win32 API. Most Win32-specific code will report errors via C<$^E>. ANSI C and Unix-like calls set C and so most portable Perl code will report errors via C<$!>. Caveats mentioned in the description of C<$!> generally apply to C<$^E>, also. (Mnemonic: Extra error explanation.) Also see L. =item $EVAL_ERROR =item $@ The Perl syntax error message from the last eval() operator. If null, the last eval() parsed and executed correctly (although the operations you invoked may have failed in the normal fashion). (Mnemonic: Where was the syntax error "at"?) Warning messages are not collected in this variable. You can, however, set up a routine to process warnings by setting C<$SIG{__WARN__}> as described below. Also see L. =item $PROCESS_ID =item $PID =item $$ The process number of the Perl running this script. You should consider this variable read-only, although it will be altered across fork() calls. (Mnemonic: same as shells.) =item $REAL_USER_ID =item $UID =item $< The real uid of this process. (Mnemonic: it's the uid you came I, if you're running setuid.) =item $EFFECTIVE_USER_ID =item $EUID =item $> The effective uid of this process. Example: $< = $>; # set real to effective uid ($<,$>) = ($>,$<); # swap real and effective uid (Mnemonic: it's the uid you went I, if you're running setuid.) C<< $< >> and C<< $> >> can be swapped only on machines supporting setreuid(). =item $REAL_GROUP_ID =item $GID =item $( The real gid of this process. If you are on a machine that supports membership in multiple groups simultaneously, gives a space separated list of groups you are in. The first number is the one returned by getgid(), and the subsequent ones by getgroups(), one of which may be the same as the first number. However, a value assigned to C<$(> must be a single number used to set the real gid. So the value given by C<$(> should I be assigned back to C<$(> without being forced numeric, such as by adding zero. (Mnemonic: parentheses are used to I things. The real gid is the group you I, if you're running setgid.) =item $EFFECTIVE_GROUP_ID =item $EGID =item $) The effective gid of this process. If you are on a machine that supports membership in multiple groups simultaneously, gives a space separated list of groups you are in. The first number is the one returned by getegid(), and the subsequent ones by getgroups(), one of which may be the same as the first number. Similarly, a value assigned to C<$)> must also be a space-separated list of numbers. The first number sets the effective gid, and the rest (if any) are passed to setgroups(). To get the effect of an empty list for setgroups(), just repeat the new effective gid; that is, to force an effective gid of 5 and an effectively empty setgroups() list, say C< $) = "5 5" >. (Mnemonic: parentheses are used to I things. The effective gid is the group that's I for you, if you're running setgid.) C<< $< >>, C<< $> >>, C<$(> and C<$)> can be set only on machines that support the corresponding I routine. C<$(> and C<$)> can be swapped only on machines supporting setregid(). =item $PROGRAM_NAME =item $0 Contains the name of the program being executed. On some operating systems assigning to C<$0> modifies the argument area that the B program sees. This is more useful as a way of indicating the current program state than it is for hiding the program you're running. (Mnemonic: same as B and B.) Note for BSD users: setting C<$0> does not completely remove "perl" from the ps(1) output. For example, setting C<$0> to C<"foobar"> will result in C<"perl: foobar (perl)">. This is an operating system feature. =item $[ The index of the first element in an array, and of the first character in a substring. Default is 0, but you could theoretically set it to 1 to make Perl behave more like B (or Fortran) when subscripting and when evaluating the index() and substr() functions. (Mnemonic: [ begins subscripts.) As of release 5 of Perl, assignment to C<$[> is treated as a compiler directive, and cannot influence the behavior of any other file. Its use is highly discouraged. =item $] The version + patchlevel / 1000 of the Perl interpreter. This variable can be used to determine whether the Perl interpreter executing a script is in the right range of versions. (Mnemonic: Is this version of perl in the right bracket?) Example: warn "No checksumming!\n" if $] < 3.019; See also the documentation of C and C for a convenient way to fail if the running Perl interpreter is too old. The use of this variable is deprecated. The floating point representation can sometimes lead to inaccurate numeric comparisons. See C<$^V> for a more modern representation of the Perl version that allows accurate string comparisons. =item $COMPILING =item $^C The current value of the flag associated with the B<-c> switch. Mainly of use with B<-MO=...> to allow code to alter its behavior when being compiled, such as for example to AUTOLOAD at compile time rather than normal, deferred loading. See L. Setting C<$^C = 1> is similar to calling C. =item $DEBUGGING =item $^D The current value of the debugging flags. (Mnemonic: value of B<-D> switch.) =item $SYSTEM_FD_MAX =item $^F The maximum system file descriptor, ordinarily 2. System file descriptors are passed to exec()ed processes, while higher file descriptors are not. Also, during an open(), system file descriptors are preserved even if the open() fails. (Ordinary file descriptors are closed before the open() is attempted.) The close-on-exec status of a file descriptor will be decided according to the value of C<$^F> when the corresponding file, pipe, or socket was opened, not the time of the exec(). =item $^H WARNING: This variable is strictly for internal use only. Its availability, behavior, and contents are subject to change without notice. This variable contains compile-time hints for the Perl interpreter. At the end of compilation of a BLOCK the value of this variable is restored to the value when the interpreter started to compile the BLOCK. When perl begins to parse any block construct that provides a lexical scope (e.g., eval body, required file, subroutine body, loop body, or conditional block), the existing value of $^H is saved, but its value is left unchanged. When the compilation of the block is completed, it regains the saved value. Between the points where its value is saved and restored, code that executes within BEGIN blocks is free to change the value of $^H. This behavior provides the semantic of lexical scoping, and is used in, for instance, the C pragma. The contents should be an integer; different bits of it are used for different pragmatic flags. Here's an example: sub add_100 { $^H |= 0x100 } sub foo { BEGIN { add_100() } bar->baz($boon); } Consider what happens during execution of the BEGIN block. At this point the BEGIN block has already been compiled, but the body of foo() is still being compiled. The new value of $^H will therefore be visible only while the body of foo() is being compiled. Substitution of the above BEGIN block with: BEGIN { require strict; strict->import('vars') } demonstrates how C is implemented. Here's a conditional version of the same lexical pragma: BEGIN { require strict; strict->import('vars') if $condition } =item %^H WARNING: This variable is strictly for internal use only. Its availability, behavior, and contents are subject to change without notice. The %^H hash provides the same scoping semantic as $^H. This makes it useful for implementation of lexically scoped pragmas. =item $INPLACE_EDIT =item $^I The current value of the inplace-edit extension. Use C to disable inplace editing. (Mnemonic: value of B<-i> switch.) =item $^M By default, running out of memory is an untrappable, fatal error. However, if suitably built, Perl can use the contents of C<$^M> as an emergency memory pool after die()ing. Suppose that your Perl were compiled with -DPERL_EMERGENCY_SBRK and used Perl's malloc. Then $^M = 'a' x (1 << 16); would allocate a 64K buffer for use in an emergency. See the F file in the Perl distribution for information on how to enable this option. To discourage casual use of this advanced feature, there is no L long name for this variable. =item $OSNAME =item $^O The name of the operating system under which this copy of Perl was built, as determined during the configuration process. The value is identical to C<$Config{'osname'}>. See also L and the B<-V> command-line switch documented in L. =item $PERLDB =item $^P The internal variable for debugging support. The meanings of the various bits are subject to change, but currently indicate: =over 6 =item 0x01 Debug subroutine enter/exit. =item 0x02 Line-by-line debugging. =item 0x04 Switch off optimizations. =item 0x08 Preserve more data for future interactive inspections. =item 0x10 Keep info about source lines on which a subroutine is defined. =item 0x20 Start with single-step on. =item 0x40 Use subroutine address instead of name when reporting. =item 0x80 Report C as well. =item 0x100 Provide informative "file" names for evals based on the place they were compiled. =item 0x200 Provide informative names to anonymous subroutines based on the place they were compiled. =back Some bits may be relevant at compile-time only, some at run-time only. This is a new mechanism and the details may change. =item $LAST_REGEXP_CODE_RESULT =item $^R The result of evaluation of the last successful C<(?{ code })> regular expression assertion (see L). May be written to. =item $EXCEPTIONS_BEING_CAUGHT =item $^S Current state of the interpreter. Undefined if parsing of the current module/eval is not finished (may happen in $SIG{__DIE__} and $SIG{__WARN__} handlers). True if inside an eval(), otherwise false. =item $BASETIME =item $^T The time at which the program began running, in seconds since the epoch (beginning of 1970). The values returned by the B<-M>, B<-A>, and B<-C> filetests are based on this value. =item $PERL_VERSION =item $^V The revision, version, and subversion of the Perl interpreter, represented as a string composed of characters with those ordinals. Thus in Perl v5.6.0 it equals C and will return true for C<$^V eq v5.6.0>. Note that the characters in this string value can potentially be in Unicode range. This can be used to determine whether the Perl interpreter executing a script is in the right range of versions. (Mnemonic: use ^V for Version Control.) Example: warn "No \"our\" declarations!\n" if $^V and $^V lt v5.6.0; See the documentation of C and C for a convenient way to fail if the running Perl interpreter is too old. See also C<$]> for an older representation of the Perl version. =item $WARNING =item $^W The current value of the warning switch, initially true if B<-w> was used, false otherwise, but directly modifiable. (Mnemonic: related to the B<-w> switch.) See also L. =item ${^WARNING_BITS} The current set of warning checks enabled by the C pragma. See the documentation of C for more details. =item ${^WIDE_SYSTEM_CALLS} Global flag that enables system calls made by Perl to use wide character APIs native to the system, if available. This is currently only implemented on the Windows platform. This can also be enabled from the command line using the C<-C> switch. The initial value is typically C<0> for compatibility with Perl versions earlier than 5.6, but may be automatically set to C<1> by Perl if the system provides a user-settable default (e.g., C<$ENV{LC_CTYPE}>). The C pragma always overrides the effect of this flag in the current lexical scope. See L. =item $EXECUTABLE_NAME =item $^X The name that the Perl binary itself was executed as, from C's C. This may not be a full pathname, nor even necessarily in your path. =item $ARGV contains the name of the current file when reading from <>. =item @ARGV The array @ARGV contains the command-line arguments intended for the script. C<$#ARGV> is generally the number of arguments minus one, because C<$ARGV[0]> is the first argument, I the program's command name itself. See C<$0> for the command name. =item @INC The array @INC contains the list of places that the C, C, or C constructs look for their library files. It initially consists of the arguments to any B<-I> command-line switches, followed by the default Perl library, probably F, followed by ".", to represent the current directory. If you need to modify this at runtime, you should use the C pragma to get the machine-dependent library properly loaded also: use lib '/mypath/libdir/'; use SomeMod; =item @_ Within a subroutine the array @_ contains the parameters passed to that subroutine. See L. =item %INC The hash %INC contains entries for each filename included via the C, C, or C operators. The key is the filename you specified (with module names converted to pathnames), and the value is the location of the file found. The C operator uses this hash to determine whether a particular file has already been included. =item %ENV =item $ENV{expr} The hash %ENV contains your current environment. Setting a value in C changes the environment for any child processes you subsequently fork() off. =item %SIG =item $SIG{expr} The hash %SIG contains signal handlers for signals. For example: sub handler { # 1st argument is signal name my($sig) = @_; print "Caught a SIG$sig--shutting down\n"; close(LOG); exit(0); } $SIG{'INT'} = \&handler; $SIG{'QUIT'} = \&handler; ... $SIG{'INT'} = 'DEFAULT'; # restore default action $SIG{'QUIT'} = 'IGNORE'; # ignore SIGQUIT Using a value of C<'IGNORE'> usually has the effect of ignoring the signal, except for the C signal. See L for more about this special case. Here are some other examples: $SIG{"PIPE"} = "Plumber"; # assumes main::Plumber (not recommended) $SIG{"PIPE"} = \&Plumber; # just fine; assume current Plumber $SIG{"PIPE"} = *Plumber; # somewhat esoteric $SIG{"PIPE"} = Plumber(); # oops, what did Plumber() return?? Be sure not to use a bareword as the name of a signal handler, lest you inadvertently call it. If your system has the sigaction() function then signal handlers are installed using it. This means you get reliable signal handling. If your system has the SA_RESTART flag it is used when signals handlers are installed. This means that system calls for which restarting is supported continue rather than returning when a signal arrives. If you want your system calls to be interrupted by signal delivery then do something like this: use POSIX ':signal_h'; my $alarm = 0; sigaction SIGALRM, new POSIX::SigAction sub { $alarm = 1 } or die "Error setting SIGALRM handler: $!\n"; See L. Certain internal hooks can be also set using the %SIG hash. The routine indicated by C<$SIG{__WARN__}> is called when a warning message is about to be printed. The warning message is passed as the first argument. The presence of a __WARN__ hook causes the ordinary printing of warnings to STDERR to be suppressed. You can use this to save warnings in a variable, or turn warnings into fatal errors, like this: local $SIG{__WARN__} = sub { die $_[0] }; eval $proggie; The routine indicated by C<$SIG{__DIE__}> is called when a fatal exception is about to be thrown. The error message is passed as the first argument. When a __DIE__ hook routine returns, the exception processing continues as it would have in the absence of the hook, unless the hook routine itself exits via a C, a loop exit, or a die(). The C<__DIE__> handler is explicitly disabled during the call, so that you can die from a C<__DIE__> handler. Similarly for C<__WARN__>. Due to an implementation glitch, the C<$SIG{__DIE__}> hook is called even inside an eval(). Do not use this to rewrite a pending exception in C<$@>, or as a bizarre substitute for overriding CORE::GLOBAL::die(). This strange action at a distance may be fixed in a future release so that C<$SIG{__DIE__}> is only called if your program is about to exit, as was the original intent. Any other use is deprecated. C<__DIE__>/C<__WARN__> handlers are very special in one respect: they may be called to report (probable) errors found by the parser. In such a case the parser may be in inconsistent state, so any attempt to evaluate Perl code from such a handler will probably result in a segfault. This means that warnings or errors that result from parsing Perl should be used with extreme caution, like this: require Carp if defined $^S; Carp::confess("Something wrong") if defined &Carp::confess; die "Something wrong, but could not load Carp to give backtrace... To see backtrace try starting Perl with -MCarp switch"; Here the first line will load Carp I it is the parser who called the handler. The second line will print backtrace and die if Carp was available. The third line will be executed only if Carp was not available. See L, L, L, and L for additional information. =back =head2 Error Indicators The variables C<$@>, C<$!>, C<$^E>, and C<$?> contain information about different types of error conditions that may appear during execution of a Perl program. The variables are shown ordered by the "distance" between the subsystem which reported the error and the Perl process. They correspond to errors detected by the Perl interpreter, C library, operating system, or an external program, respectively. To illustrate the differences between these variables, consider the following Perl expression, which uses a single-quoted string: eval q{ open PIPE, "/cdrom/install |"; @res = ; close PIPE or die "bad pipe: $?, $!"; }; After execution of this statement all 4 variables may have been set. C<$@> is set if the string to be C-ed did not compile (this may happen if C or C were imported with bad prototypes), or if Perl code executed during evaluation die()d . In these cases the value of $@ is the compile error, or the argument to C (which will interpolate C<$!> and C<$?>!). (See also L, though.) When the eval() expression above is executed, open(), C<< >>, and C are translated to calls in the C run-time library and thence to the operating system kernel. C<$!> is set to the C library's C if one of these calls fails. Under a few operating systems, C<$^E> may contain a more verbose error indicator, such as in this case, "CDROM tray not closed." Systems that do not support extended error messages leave C<$^E> the same as C<$!>. Finally, C<$?> may be set to non-0 value if the external program F fails. The upper eight bits reflect specific error conditions encountered by the program (the program's exit() value). The lower eight bits reflect mode of failure, like signal death and core dump information See wait(2) for details. In contrast to C<$!> and C<$^E>, which are set only if error condition is detected, the variable C<$?> is set on each C or pipe C, overwriting the old value. This is more like C<$@>, which on every eval() is always set on failure and cleared on success. For more details, see the individual descriptions at C<$@>, C<$!>, C<$^E>, and C<$?>. =head2 Technical Note on the Syntax of Variable Names Variable names in Perl can have several formats. Usually, they must begin with a letter or underscore, in which case they can be arbitrarily long (up to an internal limit of 251 characters) and may contain letters, digits, underscores, or the special sequence C<::> or C<'>. In this case, the part before the last C<::> or C<'> is taken to be a I; see L. Perl variable names may also be a sequence of digits or a single punctuation or control character. These names are all reserved for special uses by Perl; for example, the all-digits names are used to hold data captured by backreferences after a regular expression match. Perl has a special syntax for the single-control-character names: It understands C<^X> (caret C) to mean the control-C character. For example, the notation C<$^W> (dollar-sign caret C) is the scalar variable whose name is the single character control-C. This is better than typing a literal control-C into your program. Finally, new in Perl 5.6, Perl variable names may be alphanumeric strings that begin with control characters (or better yet, a caret). These variables must be written in the form C<${^Foo}>; the braces are not optional. C<${^Foo}> denotes the scalar variable whose name is a control-C followed by two C's. These variables are reserved for future special uses by Perl, except for the ones that begin with C<^_> (control-underscore or caret-underscore). No control-character name that begins with C<^_> will acquire a special meaning in any future version of Perl; such names may therefore be used safely in programs. C<$^_> itself, however, I reserved. Perl identifiers that begin with digits, control characters, or punctuation characters are exempt from the effects of the C declaration and are always forced to be in package C
    . A few other names are also exempt: ENV STDIN INC STDOUT ARGV STDERR ARGVOUT SIG In particular, the new special C<${^_XYZ}> variables are always taken to be in package C
    , regardless of any C declarations presently in scope. =head1 BUGS Due to an unfortunate accident of Perl's implementation, C imposes a considerable performance penalty on all regular expression matches in a program, regardless of whether they occur in the scope of C. For that reason, saying C in libraries is strongly discouraged. See the Devel::SawAmpersand module documentation from CPAN (http://www.perl.com/CPAN/modules/by-module/Devel/) for more information. Having to even think about the C<$^S> variable in your exception handlers is simply wrong. C<$SIG{__DIE__}> as currently implemented invites grievous and difficult to track down errors. Avoid it and use an C or CORE::GLOBAL::die override instead. Pod-Simple-3.45/t/chunking.t0000644000175000017500000000201214243763554014030 0ustar khwkhwuse strict; use warnings; use Test::More tests => 9; #use Pod::Simple::Debug (2); BEGIN { require FindBin; unshift @INC, $FindBin::Bin . '/lib'; } use helpers; use Pod::Simple::DumpAsXML; use Pod::Simple::XMLOutStream; print "# Pod::Simple version $Pod::Simple::VERSION\n"; is( Pod::Simple::XMLOutStream->_out("=head1 =head1"), '=head1' ); is( Pod::Simple::XMLOutStream->_out("\n=head1 =head1"), '=head1' ); is( Pod::Simple::XMLOutStream->_out("\n=head1 =head1\n"), '=head1' ); is( Pod::Simple::XMLOutStream->_out("\n=head1 =head1\n\n"), '=head1' ); &is(e "\n=head1 =head1\n\n" , "\n=head1 =head1\n\n"); &is(e "\n=head1\n=head1\n\n", "\n=head1 =head1\n\n"); &is(e "\n=pod\n\nCha cha cha\n\n" , "\n=pod\n\nCha cha cha\n\n"); &is(e "\n=pod\n\nCha\tcha cha\n\n" , "\n=pod\n\nCha cha cha\n\n"); &is(e "\n=pod\n\nCha\ncha cha\n\n" , "\n=pod\n\nCha cha cha\n\n"); Pod-Simple-3.45/t/x_nixer.t0000644000175000017500000001105014243763554013700 0ustar khwkhwuse strict; use warnings; use Test::More tests => 9; my $d; #use Pod::Simple::Debug (\$d, 0); use Pod::Simple::XMLOutStream; use Pod::Simple::DumpAsXML; $Pod::Simple::XMLOutStream::ATTR_PAD = ' '; $Pod::Simple::XMLOutStream::SORT_ATTRS = 1; # for predictably testable output print "# A simple sanity test...\n"; is( Pod::Simple::XMLOutStream->_out("=pod\n\nZ<>FfE<111>o> I> B>baz>\n"), 'foo bar stuff thingbaz' ); print "# With lots of nesting, and Z's...\n"; is( Pod::Simple::XMLOutStream->_out("=pod\n\nZ<>FfE<111>o> I> B>baz>\n"), 'foo bar stuff thingbaz' ); #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ sub mergy {$_[0]->merge_text(1)} sub nixy {$_[0]->nix_X_codes(1)} sub nixy_mergy {$_[0]->merge_text(1); $_[0]->nix_X_codes(1);} #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ print "# With no F/X\n"; is( Pod::Simple::DumpAsXML->_out( "=pod\n\nZ<>FfE<111>o> I> B>baz>\n"), join "\n", '', ' ', ' ', ' ', ' foo', ' ', ' ', ' ', ' bar', ' ', ' ', ' ', ' ', ' stuff ', ' ', ' thing', ' ', ' baz', ' ', ' ', '', '', ); #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ print "# with just X-nixing...\n"; is( Pod::Simple::DumpAsXML->_out( \&nixy, "=pod\n\nZ<>FfE<111>o> I> B>baz>\n"), join "\n", '', ' ', ' ', ' ', ' foo', ' ', ' ', ' ', ' bar', ' ', ' ', ' ', ' ', ' stuff baz', ' ', ' ', '', '', ); #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ print "# With merging...\n"; is( Pod::Simple::DumpAsXML->_out( \&mergy, "=pod\n\nZ<>FfE<111>o> I> B>baz>\n"), join "\n", '', ' ', ' ', ' ', ' foo', ' ', ' ', ' ', ' bar', ' ', ' ', ' ', ' ', ' stuff ', ' ', ' thing', ' ', ' baz', ' ', ' ', '', '', ); #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ print "# With nixing and merging...\n"; #$d = 10; is( Pod::Simple::DumpAsXML->_out( \&nixy_mergy, "=pod\n\nZ<>FfE<111>o> I> B>baz>\n"), join "\n", '', ' ', ' ', ' ', ' foo', ' ', ' ', ' ', ' bar', ' ', ' ', ' ', ' ', ' stuff baz', ' ', ' ', '', '', ); #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # Now the scary bits... with L's! print "# A wee L<...> sanity test...\n"; is( Pod::Simple::XMLOutStream->_out(qq{=pod\n\nLet::Ping/Ping-E<112>ong>\n}), '"Ping-pong" in Net::Ping' ); print "# Now a wee L<...> with mergy...\n"; $d = 10; is( Pod::Simple::DumpAsXML->_out(\&mergy, qq{=pod\n\nLet::Ping/Ping-E<112>ong>\n}), join "\n", '', ' ', ' ', ' "Ping-pong" in Net::Ping', ' ', ' ', '', '' ); print "# Now a complex tree with L's, with nixy+mergy...\n"; is( Pod::Simple::DumpAsXML->_out( \&nixy_mergy, "=pod\n\nZ<>FfE<111>Let::Ping/Ping-E<112>ong>o> I> B>baz>\n"), join "\n", '', ' ', ' ', ' ', ' fo', ' ', ' "Ping-pong" in Net::Ping', ' ', ' o', ' ', ' ', ' ', ' bar', ' ', ' ', ' ', ' ', ' stuff baz', ' ', ' ', '', '', ); Pod-Simple-3.45/t/fcodes.t0000644000175000017500000001011614243763554013471 0ustar khwkhwuse strict; use warnings; use Test::More tests => 21; #use Pod::Simple::Debug (5); BEGIN { require FindBin; unshift @INC, $FindBin::Bin . '/lib'; } use helpers; use Pod::Simple::DumpAsXML; use Pod::Simple::XMLOutStream; print "# Pod::Simple version $Pod::Simple::VERSION\n"; print "# With weird leading whitespace...\n"; # With weird whitespace is( Pod::Simple::XMLOutStream->_out("=pod\n\nI\n"), 'foo' ); is( Pod::Simple::XMLOutStream->_out("=pod\n\nB< foo>\n"), ' foo' ); is( Pod::Simple::XMLOutStream->_out("=pod\n\nB<\tfoo>\n"), ' foo' ); is( Pod::Simple::XMLOutStream->_out("=pod\n\nB<\nfoo>\n"), ' foo' ); is( Pod::Simple::XMLOutStream->_out("=pod\n\nB\n"), 'foo' ); is( Pod::Simple::XMLOutStream->_out("=pod\n\nB\n"), 'foo ' ); is( Pod::Simple::XMLOutStream->_out("=pod\n\nB\n"), 'foo ' ); print "#\n# Tests for wedges outside of formatting codes...\n"; &is( Pod::Simple::XMLOutStream->_out("=pod\n\nX < 3 and N > 19\n"), Pod::Simple::XMLOutStream->_out("=pod\n\nX E 3 and N E 19\n") ); print "# A complex test with internal whitespace...\n"; is( Pod::Simple::XMLOutStream->_out("=pod\n\nIB< bar>CF< quux\t?>\n"), 'foo barbaz quux ?' ); print "# Without any nesting...\n"; is( Pod::Simple::XMLOutStream->_out("=pod\n\nFCIBX\n"), 'abcde' ); print "# Without any nesting, but with Z's...\n"; is( Pod::Simple::XMLOutStream->_out("=pod\n\nZ<>FCIBX\n"), 'abcde' ); print "# With lots of nesting, and Z's...\n"; is( Pod::Simple::XMLOutStream->_out("=pod\n\nZ<>Ffoo> I> B>baz>\n"), 'foo bar thingbaz' ); print "#\n# *** Now testing different numbers of wedges ***\n"; print "# Without any nesting...\n"; is( Pod::Simple::XMLOutStream->_out("=pod\n\nF<< a >>C<<< b >>>I<<<< c >>>>B<< d >>X<< e >>\n"), 'abcde' ); print "# Without any nesting, but with Z's, and odder whitespace...\n"; is( Pod::Simple::XMLOutStream->_out("=pod\n\nF<< aZ<> >>C<<< Z<>b >>>I<<<< c >>>>B<< d \t >>X<<\ne >>\n"), 'abcde' ); print "# With nesting and Z's, and odder whitespace...\n"; is( Pod::Simple::XMLOutStream->_out("=pod\n\nF<< aZ<> >>C<<< Z<>bZ<>B<< d \t >>X<<\ne >> >>>I<<<< c >>>>\n"), "abdec" ); print "# Regression https://rt.cpan.org/Ticket/Display.html?id=55602 (vs 12239)\n"; is( Pod::Simple::XMLOutStream->_out("=pod\n\nC<<< foo->bar >>>\n"), 'foo->bar' ); is( Pod::Simple::XMLOutStream->_out("=pod\n\nC<<< C >>>\n"), 'foo' ); is( Pod::Simple::XMLOutStream->_out("=pod\n\nC<<< C<> >>>\n"), '<foo>' ); is( Pod::Simple::XMLOutStream->_out("=pod\n\nC<<< CZ<><> >>>\n"), 'C<<foo>>' ); is( Pod::Simple::XMLOutStream->_out("=pod\n\nC<<< CE> >>>\n"), 'C<<foo>>' ); print "# Misc...\n"; is( Pod::Simple::XMLOutStream->_out( "=pod\n\nI like I with B and Stuff and N < 3 and X<< things >> hoohah\n" ."And I a happy time>.\n" ."And B>>.>\n" ) => "I like PIE with cream and Stuff and N < 3 and things hoohah " ."And pie is also a happy time. " ."And I like pie." ); Pod-Simple-3.45/t/ascii_order.pl0000644000175000017500000000150714243754137014662 0ustar khwkhw# Helper for some of the .t's in this directory sub native_to_uni($) { # Convert from platform character set to Unicode # (which is the same as ASCII) my $string = shift; return $string if ord("A") == 65 || $] lt 5.007_003; # Doesn't work on early EBCDIC Perls my $output = ""; for my $i (0 .. length($string) - 1) { $output .= chr(utf8::native_to_unicode(ord(substr($string, $i, 1)))); } # Preserve utf8ness of input onto the output, even if it didn't need to be # utf8 utf8::upgrade($output) if utf8::is_utf8($string); return $output; } sub ascii_order { # Sort helper. Causes the order to be the same as ASCII # no matter what the platform's character set is. return native_to_uni($a) cmp native_to_uni($b); } 1 Pod-Simple-3.45/t/perlfaq.pod0000644000175000017500000007513114243754134014201 0ustar khwkhw=head1 NAME perlfaq3 - Programming Tools ($Revision: 1.38 $, $Date: 1999/05/23 16:08:30 $) =head1 DESCRIPTION This section of the FAQ answers questions related to programmer tools and programming support. =head2 How do I do (anything)? Have you looked at CPAN (see L)? The chances are that someone has already written a module that can solve your problem. Have you read the appropriate man pages? Here's a brief index: Basics perldata, perlvar, perlsyn, perlop, perlsub Execution perlrun, perldebug Functions perlfunc Objects perlref, perlmod, perlobj, perltie Data Structures perlref, perllol, perldsc Modules perlmod, perlmodlib, perlsub Regexes perlre, perlfunc, perlop, perllocale Moving to perl5 perltrap, perl Linking w/C perlxstut, perlxs, perlcall, perlguts, perlembed Various http://www.perl.com/CPAN/doc/FMTEYEWTK/index.html (not a man-page but still useful) A crude table of contents for the Perl man page set is found in L. =head2 How can I use Perl interactively? The typical approach uses the Perl debugger, described in the perldebug(1) man page, on an ``empty'' program, like this: perl -de 42 Now just type in any legal Perl code, and it will be immediately evaluated. You can also examine the symbol table, get stack backtraces, check variable values, set breakpoints, and other operations typically found in symbolic debuggers. =head2 Is there a Perl shell? In general, no. The Shell.pm module (distributed with Perl) makes Perl try commands which aren't part of the Perl language as shell commands. perlsh from the source distribution is simplistic and uninteresting, but may still be what you want. =head2 How do I debug my Perl programs? Have you tried C or used C<-w>? They enable warnings to detect dubious practices. Have you tried C? It prevents you from using symbolic references, makes you predeclare any subroutines that you call as bare words, and (probably most importantly) forces you to predeclare your variables with C, C, or C. Did you check the return values of each and every system call? The operating system (and thus Perl) tells you whether they worked, and if not why. open(FH, "> /etc/cantwrite") or die "Couldn't write to /etc/cantwrite: $!\n"; Did you read L? It's full of gotchas for old and new Perl programmers and even has sections for those of you who are upgrading from languages like I and I. Have you tried the Perl debugger, described in L? You can step through your program and see what it's doing and thus work out why what it's doing isn't what it should be doing. =head2 How do I profile my Perl programs? You should get the Devel::DProf module from the standard distribution (or separately on CPAN) and also use Benchmark.pm from the standard distribution. The Benchmark module lets you time specific portions of your code, while Devel::DProf gives detailed breakdowns of where your code spends its time. Here's a sample use of Benchmark: use Benchmark; @junk = `cat /etc/motd`; $count = 10_000; timethese($count, { 'map' => sub { my @a = @junk; map { s/a/b/ } @a; return @a }, 'for' => sub { my @a = @junk; local $_; for (@a) { s/a/b/ }; return @a }, }); This is what it prints (on one machine--your results will be dependent on your hardware, operating system, and the load on your machine): Benchmark: timing 10000 iterations of for, map... for: 4 secs ( 3.97 usr 0.01 sys = 3.98 cpu) map: 6 secs ( 4.97 usr 0.00 sys = 4.97 cpu) Be aware that a good benchmark is very hard to write. It only tests the data you give it and proves little about the differing complexities of contrasting algorithms. =head2 How do I cross-reference my Perl programs? The B::Xref module, shipped with the new, alpha-release Perl compiler (not the general distribution prior to the 5.005 release), can be used to generate cross-reference reports for Perl programs. perl -MO=Xref[,OPTIONS] scriptname.plx =head2 Is there a pretty-printer (formatter) for Perl? There is no program that will reformat Perl as much as indent(1) does for C. The complex feedback between the scanner and the parser (this feedback is what confuses the vgrind and emacs programs) makes it challenging at best to write a stand-alone Perl parser. Of course, if you simply follow the guidelines in L, you shouldn't need to reformat. The habit of formatting your code as you write it will help prevent bugs. Your editor can and should help you with this. The perl-mode or newer cperl-mode for emacs can provide remarkable amounts of help with most (but not all) code, and even less programmable editors can provide significant assistance. Tom swears by the following settings in vi and its clones: set ai sw=4 map! ^O {^M}^[O^T Now put that in your F<.exrc> file (replacing the caret characters with control characters) and away you go. In insert mode, ^T is for indenting, ^D is for undenting, and ^O is for blockdenting-- as it were. If you haven't used the last one, you're missing a lot. A more complete example, with comments, can be found at http://www.perl.com/CPAN-local/authors/id/TOMC/scripts/toms.exrc.gz If you are used to using the I program for printing out nice code to a laser printer, you can take a stab at this using http://www.perl.com/CPAN/doc/misc/tips/working.vgrind.entry, but the results are not particularly satisfying for sophisticated code. The a2ps at http://www.infres.enst.fr/%7Edemaille/a2ps/ does lots of things related to generating nicely printed output of documents. =head2 Is there a ctags for Perl? There's a simple one at http://www.perl.com/CPAN/authors/id/TOMC/scripts/ptags.gz which may do the trick. And if not, it's easy to hack into what you want. =head2 Is there an IDE or Windows Perl Editor? Perl programs are just plain text, so any editor will do. If you're on Unix, you already have an IDE--Unix itself. The UNIX philosophy is the philosophy of several small tools that each do one thing and do it well. It's like a carpenter's toolbox. If you want a Windows IDE, check the following: =over 4 =item CodeMagicCD http://www.codemagiccd.com/ =item Komodo ActiveState's cross-platform, multi-language IDE has Perl support, including a regular expression debugger and remote debugging (http://www.ActiveState.com/Products/Komodo/index.html). (Visual Perl, a Visual Studio.NET plug-in is currently (early 2001) in beta (http://www.ActiveState.com/Products/VisualPerl/index.html)). =item The Object System (http://www.castlelink.co.uk/object_system/) is a Perl web applications development IDE. =item PerlBuilder (http://www.solutionsoft.com/perl.htm) is an integrated development environment for Windows that supports Perl development. =item Perl code magic (http://www.petes-place.com/codemagic.html). =item visiPerl+ http://helpconsulting.net/visiperl/, from Help Consulting. =back For editors: if you're on Unix you probably have vi or a vi clone already, and possibly an emacs too, so you may not need to download anything. In any emacs the cperl-mode (M-x cperl-mode) gives you perhaps the best available Perl editing mode in any editor. For Windows editors: you can download an Emacs =over 4 =item GNU Emacs http://www.gnu.org/software/emacs/windows/ntemacs.html =item MicroEMACS http://members.nbci.com/uemacs/ =item XEmacs http://www.xemacs.org/Download/index.html =back or a vi clone such as =over 4 =item Elvis ftp://ftp.cs.pdx.edu/pub/elvis/ http://www.fh-wedel.de/elvis/ =item Vile http://vile.cx/ =item Vim http://www.vim.org/ win32: http://www.cs.vu.nl/%7Etmgil/vi.html =back For vi lovers in general, Windows or elsewhere: http://www.thomer.com/thomer/vi/vi.html. nvi (http://www.bostic.com/vi/, available from CPAN in src/misc/) is yet another vi clone, unfortunately not available for Windows, but in UNIX platforms you might be interested in trying it out, firstly because strictly speaking it is not a vi clone, it is the real vi, or the new incarnation of it, and secondly because you can embed Perl inside it to use Perl as the scripting language. nvi is not alone in this, though: at least also vim and vile offer an embedded Perl. The following are Win32 multilanguage editor/IDESs that support Perl: =over 4 =item Codewright http://www.starbase.com/ =item MultiEdit http://www.MultiEdit.com/ =item SlickEdit http://www.slickedit.com/ =back There is also a toyedit Text widget based editor written in Perl that is distributed with the Tk module on CPAN. The ptkdb (http://world.std.com/~aep/ptkdb/) is a Perl/tk based debugger that acts as a development environment of sorts. Perl Composer (http://perlcomposer.sourceforge.net/vperl.html) is an IDE for Perl/Tk GUI creation. In addition to an editor/IDE you might be interested in a more powerful shell environment for Win32. Your options include =over 4 =item Bash from the Cygwin package (http://sources.redhat.com/cygwin/) =item Ksh from the MKS Toolkit (http://www.mks.com/), or the Bourne shell of the U/WIN environment (http://www.research.att.com/sw/tools/uwin/) =item Tcsh ftp://ftp.astron.com/pub/tcsh/, see also http://www.primate.wisc.edu/software/csh-tcsh-book/ =item Zsh ftp://ftp.blarg.net/users/amol/zsh/, see also http://www.zsh.org/ =back MKS and U/WIN are commercial (U/WIN is free for educational and research purposes), Cygwin is covered by the GNU Public License (but that shouldn't matter for Perl use). The Cygwin, MKS, and U/WIN all contain (in addition to the shells) a comprehensive set of standard UNIX toolkit utilities. If you're transferring text files between Unix and Windows using FTP be sure to transfer them in ASCII mode so the ends of lines are appropriately converted. On Mac OS the MacPerl Application comes with a simple 32k text editor that behaves like a rudimentary IDE. In contrast to the MacPerl Application the MPW Perl tool can make use of the MPW Shell itself as an editor (with no 32k limit). =over 4 =item BBEdit and BBEdit Lite are text editors for Mac OS that have a Perl sensitivity mode (http://web.barebones.com/). =item Alpha is an editor, written and extensible in Tcl, that nonetheless has built in support for several popular markup and programming languages including Perl and HTML (http://alpha.olm.net/). =back Pepper and Pe are programming language sensitive text editors for Mac OS X and BeOS respectively (http://www.hekkelman.com/). =head2 Where can I get Perl macros for vi? For a complete version of Tom Christiansen's vi configuration file, see http://www.perl.com/CPAN/authors/Tom_Christiansen/scripts/toms.exrc.gz , the standard benchmark file for vi emulators. The file runs best with nvi, the current version of vi out of Berkeley, which incidentally can be built with an embedded Perl interpreter--see http://www.perl.com/CPAN/src/misc. =head2 Where can I get perl-mode for emacs? Since Emacs version 19 patchlevel 22 or so, there have been both a perl-mode.el and support for the Perl debugger built in. These should come with the standard Emacs 19 distribution. In the Perl source directory, you'll find a directory called "emacs", which contains a cperl-mode that color-codes keywords, provides context-sensitive help, and other nifty things. Note that the perl-mode of emacs will have fits with C<"main'foo"> (single quote), and mess up the indentation and highlighting. You are probably using C<"main::foo"> in new Perl code anyway, so this shouldn't be an issue. =head2 How can I use curses with Perl? The Curses module from CPAN provides a dynamically loadable object module interface to a curses library. A small demo can be found at the directory http://www.perl.com/CPAN/authors/Tom_Christiansen/scripts/rep; this program repeats a command and updates the screen as needed, rendering B similar to B. =head2 How can I use X or Tk with Perl? Tk is a completely Perl-based, object-oriented interface to the Tk toolkit that doesn't force you to use Tcl just to get at Tk. Sx is an interface to the Athena Widget set. Both are available from CPAN. See the directory http://www.perl.com/CPAN/modules/by-category/08_User_Interfaces/ Invaluable for Perl/Tk programming are the Perl/Tk FAQ at http://w4.lns.cornell.edu/%7Epvhp/ptk/ptkTOC.html , the Perl/Tk Reference Guide available at http://www.perl.com/CPAN-local/authors/Stephen_O_Lidie/ , and the online manpages at http://www-users.cs.umn.edu/%7Eamundson/perl/perltk/toc.html . =head2 How can I generate simple menus without using CGI or Tk? The http://www.perl.com/CPAN/authors/id/SKUNZ/perlmenu.v4.0.tar.gz module, which is curses-based, can help with this. =head2 What is undump? See the next question on ``How can I make my Perl program run faster?'' =head2 How can I make my Perl program run faster? The best way to do this is to come up with a better algorithm. This can often make a dramatic difference. Jon Bentley's book ``Programming Pearls'' (that's not a misspelling!) has some good tips on optimization, too. Advice on benchmarking boils down to: benchmark and profile to make sure you're optimizing the right part, look for better algorithms instead of microtuning your code, and when all else fails consider just buying faster hardware. A different approach is to autoload seldom-used Perl code. See the AutoSplit and AutoLoader modules in the standard distribution for that. Or you could locate the bottleneck and think about writing just that part in C, the way we used to take bottlenecks in C code and write them in assembler. Similar to rewriting in C, modules that have critical sections can be written in C (for instance, the PDL module from CPAN). In some cases, it may be worth it to use the backend compiler to produce byte code (saving compilation time) or compile into C, which will certainly save compilation time and sometimes a small amount (but not much) execution time. See the question about compiling your Perl programs for more on the compiler--the wins aren't as obvious as you'd hope. If you're currently linking your perl executable to a shared I, you can often gain a 10-25% performance benefit by rebuilding it to link with a static libc.a instead. This will make a bigger perl executable, but your Perl programs (and programmers) may thank you for it. See the F file in the source distribution for more information. Unsubstantiated reports allege that Perl interpreters that use sfio outperform those that don't (for I/O intensive applications). To try this, see the F file in the source distribution, especially the ``Selecting File I/O mechanisms'' section. The undump program was an old attempt to speed up your Perl program by storing the already-compiled form to disk. This is no longer a viable option, as it only worked on a few architectures, and wasn't a good solution anyway. =head2 How can I make my Perl program take less memory? When it comes to time-space tradeoffs, Perl nearly always prefers to throw memory at a problem. Scalars in Perl use more memory than strings in C, arrays take more than that, and hashes use even more. While there's still a lot to be done, recent releases have been addressing these issues. For example, as of 5.004, duplicate hash keys are shared amongst all hashes using them, so require no reallocation. In some cases, using substr() or vec() to simulate arrays can be highly beneficial. For example, an array of a thousand booleans will take at least 20,000 bytes of space, but it can be turned into one 125-byte bit vector--a considerable memory savings. The standard Tie::SubstrHash module can also help for certain types of data structure. If you're working with specialist data structures (matrices, for instance) modules that implement these in C may use less memory than equivalent Perl modules. Another thing to try is learning whether your Perl was compiled with the system malloc or with Perl's builtin malloc. Whichever one it is, try using the other one and see whether this makes a difference. Information about malloc is in the F file in the source distribution. You can find out whether you are using perl's malloc by typing C. =head2 Is it unsafe to return a pointer to local data? No, Perl's garbage collection system takes care of this. sub makeone { my @a = ( 1 .. 10 ); return \@a; } for $i ( 1 .. 10 ) { push @many, makeone(); } print $many[4][5], "\n"; print "@many\n"; =head2 How can I free an array or hash so my program shrinks? You can't. On most operating systems, memory allocated to a program can never be returned to the system. That's why long-running programs sometimes re-exec themselves. Some operating systems (notably, FreeBSD and Linux) allegedly reclaim large chunks of memory that is no longer used, but it doesn't appear to happen with Perl (yet). The Mac appears to be the only platform that will reliably (albeit, slowly) return memory to the OS. We've had reports that on Linux (Redhat 5.1) on Intel, C will return memory to the system, while on Solaris 2.6 it won't. In general, try it yourself and see. However, judicious use of my() on your variables will help make sure that they go out of scope so that Perl can free up that space for use in other parts of your program. A global variable, of course, never goes out of scope, so you can't get its space automatically reclaimed, although undef()ing and/or delete()ing it will achieve the same effect. In general, memory allocation and de-allocation isn't something you can or should be worrying about much in Perl, but even this capability (preallocation of data types) is in the works. =head2 How can I make my CGI script more efficient? Beyond the normal measures described to make general Perl programs faster or smaller, a CGI program has additional issues. It may be run several times per second. Given that each time it runs it will need to be re-compiled and will often allocate a megabyte or more of system memory, this can be a killer. Compiling into C B because the process start-up overhead is where the bottleneck is. There are two popular ways to avoid this overhead. One solution involves running the Apache HTTP server (available from http://www.apache.org/) with either of the mod_perl or mod_fastcgi plugin modules. With mod_perl and the Apache::Registry module (distributed with mod_perl), httpd will run with an embedded Perl interpreter which pre-compiles your script and then executes it within the same address space without forking. The Apache extension also gives Perl access to the internal server API, so modules written in Perl can do just about anything a module written in C can. For more on mod_perl, see http://perl.apache.org/ With the FCGI module (from CPAN) and the mod_fastcgi module (available from http://www.fastcgi.com/) each of your Perl programs becomes a permanent CGI daemon process. Both of these solutions can have far-reaching effects on your system and on the way you write your CGI programs, so investigate them with care. See http://www.perl.com/CPAN/modules/by-category/15_World_Wide_Web_HTML_HTTP_CGI/ . A non-free, commercial product, ``The Velocity Engine for Perl'', (http://www.binevolve.com/ or http://www.binevolve.com/velocigen/ ) might also be worth looking at. It will allow you to increase the performance of your Perl programs, running programs up to 25 times faster than normal CGI Perl when running in persistent Perl mode or 4 to 5 times faster without any modification to your existing CGI programs. Fully functional evaluation copies are available from the web site. =head2 How can I hide the source for my Perl program? Delete it. :-) Seriously, there are a number of (mostly unsatisfactory) solutions with varying levels of ``security''. First of all, however, you I take away read permission, because the source code has to be readable in order to be compiled and interpreted. (That doesn't mean that a CGI script's source is readable by people on the web, though--only by people with access to the filesystem.) So you have to leave the permissions at the socially friendly 0755 level. Some people regard this as a security problem. If your program does insecure things and relies on people not knowing how to exploit those insecurities, it is not secure. It is often possible for someone to determine the insecure things and exploit them without viewing the source. Security through obscurity, the name for hiding your bugs instead of fixing them, is little security indeed. You can try using encryption via source filters (Filter::* from CPAN), but any decent programmer will be able to decrypt it. You can try using the byte code compiler and interpreter described below, but the curious might still be able to de-compile it. You can try using the native-code compiler described below, but crackers might be able to disassemble it. These pose varying degrees of difficulty to people wanting to get at your code, but none can definitively conceal it (true of every language, not just Perl). If you're concerned about people profiting from your code, then the bottom line is that nothing but a restrictive license will give you legal security. License your software and pepper it with threatening statements like ``This is unpublished proprietary software of XYZ Corp. Your access to it does not give you permission to use it blah blah blah.'' We are not lawyers, of course, so you should see a lawyer if you want to be sure your license's wording will stand up in court. =head2 How can I compile my Perl program into byte code or C? Malcolm Beattie has written a multifunction backend compiler, available from CPAN, that can do both these things. It is included in the perl5.005 release, but is still considered experimental. This means it's fun to play with if you're a programmer but not really for people looking for turn-key solutions. Merely compiling into C does not in and of itself guarantee that your code will run very much faster. That's because except for lucky cases where a lot of native type inferencing is possible, the normal Perl run-time system is still present and so your program will take just as long to run and be just as big. Most programs save little more than compilation time, leaving execution no more than 10-30% faster. A few rare programs actually benefit significantly (even running several times faster), but this takes some tweaking of your code. You'll probably be astonished to learn that the current version of the compiler generates a compiled form of your script whose executable is just as big as the original perl executable, and then some. That's because as currently written, all programs are prepared for a full eval() statement. You can tremendously reduce this cost by building a shared I library and linking against that. See the F podfile in the Perl source distribution for details. If you link your main perl binary with this, it will make it minuscule. For example, on one author's system, F is only 11k in size! In general, the compiler will do nothing to make a Perl program smaller, faster, more portable, or more secure. In fact, it can make your situation worse. The executable will be bigger, your VM system may take longer to load the whole thing, the binary is fragile and hard to fix, and compilation never stopped software piracy in the form of crackers, viruses, or bootleggers. The real advantage of the compiler is merely packaging, and once you see the size of what it makes (well, unless you use a shared I), you'll probably want a complete Perl install anyway. =head2 How can I compile Perl into Java? You can also integrate Java and Perl with the Perl Resource Kit from O'Reilly and Associates. See http://www.oreilly.com/catalog/prkunix/ . Perl 5.6 comes with Java Perl Lingo, or JPL. JPL, still in development, allows Perl code to be called from Java. See jpl/README in the Perl source tree. =head2 How can I get C<#!perl> to work on [MS-DOS,NT,...]? For OS/2 just use extproc perl -S -your_switches as the first line in C<*.cmd> file (C<-S> due to a bug in cmd.exe's `extproc' handling). For DOS one should first invent a corresponding batch file and codify it in C (see the F file in the source distribution for more information). The Win95/NT installation, when using the ActiveState port of Perl, will modify the Registry to associate the C<.pl> extension with the perl interpreter. If you install another port, perhaps even building your own Win95/NT Perl from the standard sources by using a Windows port of gcc (e.g., with cygwin or mingw32), then you'll have to modify the Registry yourself. In addition to associating C<.pl> with the interpreter, NT people can use: C to let them run the program C merely by typing C. Macintosh Perl programs will have the appropriate Creator and Type, so that double-clicking them will invoke the Perl application. I: Whatever you do, PLEASE don't get frustrated, and just throw the perl interpreter into your cgi-bin directory, in order to get your programs working for a web server. This is an EXTREMELY big security risk. Take the time to figure out how to do it correctly. =head2 Can I write useful Perl programs on the command line? Yes. Read L for more information. Some examples follow. (These assume standard Unix shell quoting rules.) # sum first and last fields perl -lane 'print $F[0] + $F[-1]' * # identify text files perl -le 'for(@ARGV) {print if -f && -T _}' * # remove (most) comments from C program perl -0777 -pe 's{/\*.*?\*/}{}gs' foo.c # make file a month younger than today, defeating reaper daemons perl -e '$X=24*60*60; utime(time(),time() + 30 * $X,@ARGV)' * # find first unused uid perl -le '$i++ while getpwuid($i); print $i' # display reasonable manpath echo $PATH | perl -nl -072 -e ' s![^/+]*$!man!&&-d&&!$s{$_}++&&push@m,$_;END{print"@m"}' OK, the last one was actually an Obfuscated Perl Contest entry. :-) =head2 Why don't Perl one-liners work on my DOS/Mac/VMS system? The problem is usually that the command interpreters on those systems have rather different ideas about quoting than the Unix shells under which the one-liners were created. On some systems, you may have to change single-quotes to double ones, which you must I do on Unix or Plan9 systems. You might also have to change a single % to a %%. For example: # Unix perl -e 'print "Hello world\n"' # DOS, etc. perl -e "print \"Hello world\n\"" # Mac print "Hello world\n" (then Run "Myscript" or Shift-Command-R) # VMS perl -e "print ""Hello world\n""" The problem is that none of these examples are reliable: they depend on the command interpreter. Under Unix, the first two often work. Under DOS, it's entirely possible that neither works. If 4DOS was the command shell, you'd probably have better luck like this: perl -e "print "Hello world\n"" Under the Mac, it depends which environment you are using. The MacPerl shell, or MPW, is much like Unix shells in its support for several quoting variants, except that it makes free use of the Mac's non-ASCII characters as control characters. Using qq(), q(), and qx(), instead of "double quotes", 'single quotes', and `backticks`, may make one-liners easier to write. There is no general solution to all of this. It is a mess, pure and simple. Sucks to be away from Unix, huh? :-) [Some of this answer was contributed by Kenneth Albanowski.] =head2 Where can I learn about CGI or Web programming in Perl? For modules, get the CGI or LWP modules from CPAN. For textbooks, see the two especially dedicated to web stuff in the question on books. For problems and questions related to the web, like ``Why do I get 500 Errors'' or ``Why doesn't it run from the browser right when it runs fine on the command line'', see these sources: WWW Security FAQ http://www.w3.org/Security/Faq/ Web FAQ http://www.boutell.com/faq/ CGI FAQ http://www.webthing.com/tutorials/cgifaq.html HTTP Spec http://www.w3.org/pub/WWW/Protocols/HTTP/ HTML Spec http://www.w3.org/TR/REC-html40/ http://www.w3.org/pub/WWW/MarkUp/ CGI Spec http://www.w3.org/CGI/ CGI Security FAQ http://www.go2net.com/people/paulp/cgi-security/safe-cgi.txt =head2 Where can I learn about object-oriented Perl programming? A good place to start is L, and you can use L, L, and L for reference. Perltoot didn't come out until the 5.004 release; you can get a copy (in pod, html, or postscript) from http://www.perl.com/CPAN/doc/FMTEYEWTK/ . =head2 Where can I learn about linking C with Perl? [h2xs, xsubpp] If you want to call C from Perl, start with L, moving on to L, L, and L. If you want to call Perl from C, then read L, L, and L. Don't forget that you can learn a lot from looking at how the authors of existing extension modules wrote their code and solved their problems. =head2 I've read perlembed, perlguts, etc., but I can't embed perl in my C program; what am I doing wrong? Download the ExtUtils::Embed kit from CPAN and run `make test'. If the tests pass, read the pods again and again and again. If they fail, see L and send a bug report with the output of C along with C. =head2 When I tried to run my script, I got this message. What does it mean? A complete list of Perl's error messages and warnings with explanatory text can be found in L. You can also use the splain program (distributed with Perl) to explain the error messages: perl program 2>diag.out splain [-v] [-p] diag.out or change your program to explain the messages for you: use diagnostics; or use diagnostics -verbose; =head2 What's MakeMaker? This module (part of the standard Perl distribution) is designed to write a Makefile for an extension module from a Makefile.PL. For more information, see L. =head1 AUTHOR AND COPYRIGHT Copyright (c) 1997-1999 Tom Christiansen and Nathan Torkington. All rights reserved. When included as an integrated part of the Standard Distribution of Perl or of its documentation (printed or otherwise), this works is covered under Perl's Artistic License. For separate distributions of all or part of this FAQ outside of that, see L. Irrespective of its distribution, all code examples here are in the public domain. You are permitted and encouraged to use this code and any derivatives thereof in your own programs for fun or for profit as you see fit. A simple comment in the code giving credit to the FAQ would be courteous but is not required. Pod-Simple-3.45/t/html01.t0000644000175000017500000000550014243763554013334 0ustar khwkhw# Testing HTML paragraphs use strict; use warnings; use Test::More tests => 15; #use Pod::Simple::Debug (10); use Pod::Simple::HTML; sub x { my $code = $_[1]; Pod::Simple::HTML->_out( sub{ $_[0]->bare_output(1); $code->($_[0]) if $code }, "=pod\n\n$_[0]", ) } is( x( q{ =pod This is a paragraph =cut }), qq{\n

    This is a paragraph

    \n}, "paragraph building" ); is( x(qq{=pod\n\nThis is a paragraph}), qq{\n

    This is a paragraph

    \n}, "paragraph building" ); is( x(qq{This is a paragraph}), qq{\n

    This is a paragraph

    \n}, "paragraph building" ); like(x( '=head1 This is a heading') => qr{\s*    \s*$}, "heading building" ); like(x('=head1 This is a heading', sub { $_[0]->html_h_level(2) }) => qr{\s*

    ]+>This\s+is\s+a\s+heading

    \s*$}, "heading building" ); like(x( '=head2 This is a heading too') => qr{\s*

    ]+>This\s+is\s+a\s+heading\s+too

    \s*$}, "heading building" ); like(x( '=head3 Also, this is a heading') => qr{\s*

    ]+>Also,\s+this\s+is\s+a\s+heading

    \s*$}, "heading building" ); like(x( '=head4 This, too, is a heading') => qr{\s*

    ]+>This,\s+too,\s+is\s+a\s+heading

    \s*$}, "heading building" ); like(x( '=head5 The number of the heading shall be five') => qr{\s*
    ]+>The\s+number\s+of\s+the\s+heading\s+shall\s+be\s+five
    \s*$}, "heading building" ); like(x( '=head6 The sixth a heading is the perfect heading') => qr{\s*
    ]+>The\s+sixth\s+a\s+heading\s+is\s+the\s+perfect\s+heading
    \s*$}, "heading building" ); like(x( '=head2 Yada Yada Operator X<...> X<... operator> X') => qr{name="Yada_Yada_Operator"}, "heading anchor name" ); is( x("=over 4\n\n=item one\n\n=item two\n\nHello\n\n=back\n"), q{
    one
    two

    Hello

    } ); my $html = q{ 
    #include <stdio.h>

int main(int argc,char *argv[]) {

        printf("Hellow World\n");
        return 0;

}
    }; is( x("=begin html\n\n$html\n\n=end html\n"), "$html\n\n" ); # Check subclass. SUBCLASS: { package My::Pod::HTML; use vars '@ISA', '$VERSION'; @ISA = ('Pod::Simple::HTML'); $VERSION = '0.01'; sub do_section { 'howdy' } } is( My::Pod::HTML->_out( sub{ $_[0]->bare_output(1) }, "=pod\n\n=over\n\n=item Foo\n\n=back\n", ), "\n
    \n
    Foo
    \n
    \n", ); { # Test that strip_verbatim_indent() works. github issue #i5 my $output; my $obj = Pod::Simple::HTML->new; $obj->strip_verbatim_indent(" "); $obj->output_string(\$output); $obj->parse_string_document("=pod\n\n First line\n 2nd line\n"); like($output, qr!
    First line\n2nd line
    !s); } Pod-Simple-3.45/t/items02.t0000644000175000017500000000223614243763554013515 0ustar khwkhw# Testing the =item directive use strict; use warnings; use Test::More tests => 2; BEGIN { require FindBin; unshift @INC, $FindBin::Bin . '/lib'; } use helpers; my $d; #use Pod::Simple::Debug (\$d,0); use Pod::Simple::DumpAsXML; use Pod::Simple::XMLOutStream; print "# Pod::Simple version $Pod::Simple::VERSION\n"; 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"; is( $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"), '5Stuff4Quux' ); is( $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"), '5.Stuff4.Quux' ); Pod-Simple-3.45/t/corpus2/0000755000175000017500000000000014430216375013427 5ustar khwkhwPod-Simple-3.45/t/corpus2/polish_implicit_utf8.txt0000644000175000017500000000277714243754135020346 0ustar khwkhw =head1 NAME WÅšRÓD NOCNEJ CISZY -- implicitly utf8 test document in Polish =head1 DESCRIPTION This is a test Pod document in UTF8. Its content is the lyrics to the Polish Christmas carol "WÅ›ród nocnej ciszy". WÅ›ród nocnej ciszy gÅ‚os siÄ™ rozchodzi: / WstaÅ„cie, pasterze, Bóg siÄ™ nam rodzi! / Czym prÄ™dzej siÄ™ wybierajcie, / Do Betlejem pospieszajcie / Przywitać Pana. Poszli, znaleźli DzieciÄ…tko w żłobie / Z wszystkimi znaki danymi sobie. / Jako Bogu cześć Mu dali, / A witajÄ…c zawoÅ‚ali / Z wielkiej radoÅ›ci: Ach, witaj Zbawco z dawno żądany, / Wiele tysiÄ™cy lat wyglÄ…dany / Na Ciebie króle, prorocy / Czekali, a TyÅ› tej nocy / Nam siÄ™ objawiÅ‚. I my czekamy na Ciebie, Pana, / A skoro przyjdziesz na gÅ‚os kapÅ‚ana, / Padniemy na twarz przed TobÄ…, / WierzÄ…c, żeÅ› jest pod osÅ‚onÄ… / Chleba i wina. =head2 As Verbatim And now as verbatim text: WÅ›ród nocnej ciszy gÅ‚os siÄ™ rozchodzi: WstaÅ„cie, pasterze, Bóg siÄ™ nam rodzi! Czym prÄ™dzej siÄ™ wybierajcie, Do Betlejem pospieszajcie Przywitać Pana. Poszli, znaleźli DzieciÄ…tko w żłobie Z wszystkimi znaki danymi sobie. Jako Bogu cześć Mu dali, A witajÄ…c zawoÅ‚ali Z wielkiej radoÅ›ci: Ach, witaj Zbawco z dawno żądany, Wiele tysiÄ™cy lat wyglÄ…dany Na Ciebie króle, prorocy Czekali, a TyÅ› tej nocy Nam siÄ™ objawiÅ‚. I my czekamy na Ciebie, Pana, A skoro przyjdziesz na gÅ‚os kapÅ‚ana, Padniemy na twarz przed TobÄ…, WierzÄ…c, żeÅ› jest pod osÅ‚onÄ… Chleba i wina. [end] =cut Pod-Simple-3.45/t/corpus2/polish_utf8_bom.txt0000644000175000017500000000300214243754135017267 0ustar khwkhw =head1 NAME WÅšRÓD NOCNEJ CISZY -- implicitly utf8 test document in Polish =head1 DESCRIPTION This is a test Pod document in UTF8. Its content is the lyrics to the Polish Christmas carol "WÅ›ród nocnej ciszy". WÅ›ród nocnej ciszy gÅ‚os siÄ™ rozchodzi: / WstaÅ„cie, pasterze, Bóg siÄ™ nam rodzi! / Czym prÄ™dzej siÄ™ wybierajcie, / Do Betlejem pospieszajcie / Przywitać Pana. Poszli, znaleźli DzieciÄ…tko w żłobie / Z wszystkimi znaki danymi sobie. / Jako Bogu cześć Mu dali, / A witajÄ…c zawoÅ‚ali / Z wielkiej radoÅ›ci: Ach, witaj Zbawco z dawno żądany, / Wiele tysiÄ™cy lat wyglÄ…dany / Na Ciebie króle, prorocy / Czekali, a TyÅ› tej nocy / Nam siÄ™ objawiÅ‚. I my czekamy na Ciebie, Pana, / A skoro przyjdziesz na gÅ‚os kapÅ‚ana, / Padniemy na twarz przed TobÄ…, / WierzÄ…c, żeÅ› jest pod osÅ‚onÄ… / Chleba i wina. =head2 As Verbatim And now as verbatim text: WÅ›ród nocnej ciszy gÅ‚os siÄ™ rozchodzi: WstaÅ„cie, pasterze, Bóg siÄ™ nam rodzi! Czym prÄ™dzej siÄ™ wybierajcie, Do Betlejem pospieszajcie Przywitać Pana. Poszli, znaleźli DzieciÄ…tko w żłobie Z wszystkimi znaki danymi sobie. Jako Bogu cześć Mu dali, A witajÄ…c zawoÅ‚ali Z wielkiej radoÅ›ci: Ach, witaj Zbawco z dawno żądany, Wiele tysiÄ™cy lat wyglÄ…dany Na Ciebie króle, prorocy Czekali, a TyÅ› tej nocy Nam siÄ™ objawiÅ‚. I my czekamy na Ciebie, Pana, A skoro przyjdziesz na gÅ‚os kapÅ‚ana, Padniemy na twarz przed TobÄ…, WierzÄ…c, żeÅ› jest pod osÅ‚onÄ… Chleba i wina. [end] =cut Pod-Simple-3.45/t/corpus2/README0000644000175000017500000000024414243754135014312 0ustar khwkhwThis is a corpus of data that hasn't been implemented yet. It's included for future reference, and will be moved to the main corpus directory as it is implemented. Pod-Simple-3.45/t/corpus2/polish_utf8_bom2.xml0000644000175000017500000000560214243754135017342 0ustar khwkhw NAME WÅšRÓD NOCNEJ CISZY -- implicitly utf8 test document in Polish DESCRIPTION This is a test Pod document in UTF8. Its content is the lyrics to the Polish Christmas carol "WÅ›ród nocnej ciszy". WÅ›ród nocnej ciszy gÅ‚os siÄ™ rozchodzi: / WstaÅ„cie, pasterze, Bóg siÄ™ nam rodzi! / Czym prÄ™dzej siÄ™ wybierajcie, / Do Betlejem pospieszajcie / Przywitać Pana. Poszli, znaleźli DzieciÄ tko w żłobie / Z wszystkimi znaki danymi sobie. / Jako Bogu cześć Mu dali, / A witajÄ c zawoÅ‚ali / Z wielkiej radoÅ›ci: Ach, witaj Zbawco z dawno Å¼Ä dany, / Wiele tysiÄ™cy lat wyglÄ dany / Na Ciebie króle, prorocy / Czekali, a TyÅ› tej nocy / Nam siÄ™ objawiÅ‚. I my czekamy na Ciebie, Pana, / A skoro przyjdziesz na gÅ‚os kapÅ‚ana, / Padniemy na twarz przed TobÄ , / WierzÄ c, żeÅ› jest pod osÅ‚onÄ / Chleba i wina. As Verbatim And now as verbatim text: WÅ›ród nocnej ciszy gÅ‚os siÄ™ rozchodzi: WstaÅ„cie, pasterze, Bóg siÄ™ nam rodzi! Czym prÄ™dzej siÄ™ wybierajcie, Do Betlejem pospieszajcie Przywitać Pana. Poszli, znaleźli DzieciÄ…tko w żłobie Z wszystkimi znaki danymi sobie. Jako Bogu cześć Mu dali, A witajÄ…c zawoÅ‚ali Z wielkiej radoÅ›ci: Ach, witaj Zbawco z dawno żądany, Wiele tysiÄ™cy lat wyglÄ…dany Na Ciebie króle, prorocy Czekali, a TyÅ› tej nocy Nam siÄ™ objawiÅ‚. I my czekamy na Ciebie, Pana, A skoro przyjdziesz na gÅ‚os kapÅ‚ana, Padniemy na twarz przed TobÄ…, WierzÄ…c, żeÅ› jest pod osÅ‚onÄ… Chleba i wina. [end] Pod-Simple-3.45/t/corpus2/fiqhakbar_iso6.txt0000644000175000017500000000337114243754135017067 0ustar khwkhw =encoding iso-8859-6 =head1 NAME åÊæ Çäáâç ÇäÇãÈÑ -- test document: "al-Fiqh al-Akbar" as ISO-8859-6 =head1 DESCRIPTION This document is Abu Hanifah's "al-Fiqh al-Akbar" as ISO-8859-6, presented as an item-number list: åÊæ Çäáâç ÇäÇãÈÑ ÇäåæÓèÈ Çäé ÇÈê ÍæêáÉ ÇäæÙåÇæ Èæ ËÇÈÊ =over =item 1 äÇ æãáÑ ÃÍÏÇ ÈÐæÈ èäÇ ææáê ÃÍÏÇ åæ ÇäÇêåÇæ . =item 2 ÅæÇ æÃåÑ ÈÇäåÙÑèá èææçê Ùæ ÇäåæãÑ . =item 3 èÇÙäå Ãæ åÇ ÃÕÇÈã äå êãæ äêÎ×Æã ¬ èåÇ ÃÎ×Ãã äå êãæ äêÕêÈã . =item 4 äÇ æÊÈÑà åæ ÃÍÏ åæ ÃÕÍÇÈ ÑÓèä Çääç Õäé Çääç Ùäêç èÓäå èäÇ êÊèÇäé ÃÍÏ Ïèæ ÃÍÏ . =item 5 ÅæÇ æÑÏ ÃåÑ ÙËåÇæ èÙäê Çäé Çääç èçè ÙÇäå ÇäÓÑ èÇäÎáêÇÊ . =item 6 Çäáâç áê ÇäÏêæ ÃáÖä åæ Çäáâç áê ÇäÙäå . =item 7 èÇÎÊäÇá ÇäÇåÉ ÑÍåÉ . =item 8 åæ Âåæ ÈÌåêÙ åÇ êÄåÑ Èç ÇäÇ Ãæç âÇä äÇ ÃÙÑá åèÓé èÙêÓé ÙäêçåÇ ÇäÓäÇå Ãåæ ÇäåÑÓäêæ Ãå åæ ÚêÑ ÇäåÑÓäêæ áÅæç êãáÑ . =item 9 åæ âÇä äÇ ÃÙÑá Çääç Ãáê ÇäÓåÇÁ Ãå áê ÇäÇÑÖ áâÏ ãáÑ . =item 10 åæ âÇä äÇ ÃÙÑá ÙÐÇÈ ÇäâÈÑ áçè åæ Çä×ÈâÉ ÇäÌçåêÉ èÇäçÇäãêÉ . =back And now run together as a paragraph: äÇ æãáÑ ÃÍÏÇ ÈÐæÈ èäÇ ææáê ÃÍÏÇ åæ ÇäÇêåÇæ . ÅæÇ æÃåÑ ÈÇäåÙÑèá èææçê Ùæ ÇäåæãÑ . èÇÙäå Ãæ åÇ ÃÕÇÈã äå êãæ äêÎ×Æã ¬ èåÇ ÃÎ×Ãã äå êãæ äêÕêÈã . äÇ æÊÈÑà åæ ÃÍÏ åæ ÃÕÍÇÈ ÑÓèä Çääç Õäé Çääç Ùäêç èÓäå èäÇ êÊèÇäé ÃÍÏ Ïèæ ÃÍÏ . ÅæÇ æÑÏ ÃåÑ ÙËåÇæ èÙäê Çäé Çääç èçè ÙÇäå ÇäÓÑ èÇäÎáêÇÊ . Çäáâç áê ÇäÏêæ ÃáÖä åæ Çäáâç áê ÇäÙäå . èÇÎÊäÇá ÇäÇåÉ ÑÍåÉ . åæ Âåæ ÈÌåêÙ åÇ êÄåÑ Èç ÇäÇ Ãæç âÇä äÇ ÃÙÑá åèÓé èÙêÓé ÙäêçåÇ ÇäÓäÇå Ãåæ ÇäåÑÓäêæ Ãå åæ ÚêÑ ÇäåÑÓäêæ áÅæç êãáÑ . åæ âÇä äÇ ÃÙÑá Çääç Ãáê ÇäÓåÇÁ Ãå áê ÇäÇÑÖ áâÏ ãáÑ . åæ âÇä äÇ ÃÙÑá ÙÐÇÈ ÇäâÈÑ áçè åæ Çä×ÈâÉ ÇäÌçåêÉ èÇäçÇäãêÉ . And now the first three as a verbatim section: äÇ æãáÑ ÃÍÏÇ ÈÐæÈ èäÇ ææáê ÃÍÏÇ åæ ÇäÇêåÇæ . ÅæÇ æÃåÑ ÈÇäåÙÑèá èææçê Ùæ ÇäåæãÑ . èÇÙäå Ãæ åÇ ÃÕÇÈã äå êãæ äêÎ×Æã ¬ èåÇ ÃÎ×Ãã äå êãæ äêÕêÈã . [end] =cut Pod-Simple-3.45/t/corpus2/polish_utf8_bom2.txt0000644000175000017500000000300214243754135017351 0ustar khwkhw=head1 NAME WÅšRÓD NOCNEJ CISZY -- implicitly utf8 test document in Polish =head1 DESCRIPTION This is a test Pod document in UTF8. Its content is the lyrics to the Polish Christmas carol "WÅ›ród nocnej ciszy". WÅ›ród nocnej ciszy gÅ‚os siÄ™ rozchodzi: / WstaÅ„cie, pasterze, Bóg siÄ™ nam rodzi! / Czym prÄ™dzej siÄ™ wybierajcie, / Do Betlejem pospieszajcie / Przywitać Pana. Poszli, znaleźli DzieciÄ…tko w żłobie / Z wszystkimi znaki danymi sobie. / Jako Bogu cześć Mu dali, / A witajÄ…c zawoÅ‚ali / Z wielkiej radoÅ›ci: Ach, witaj Zbawco z dawno żądany, / Wiele tysiÄ™cy lat wyglÄ…dany / Na Ciebie króle, prorocy / Czekali, a TyÅ› tej nocy / Nam siÄ™ objawiÅ‚. I my czekamy na Ciebie, Pana, / A skoro przyjdziesz na gÅ‚os kapÅ‚ana, / Padniemy na twarz przed TobÄ…, / WierzÄ…c, żeÅ› jest pod osÅ‚onÄ… / Chleba i wina. =head2 As Verbatim And now as verbatim text: WÅ›ród nocnej ciszy gÅ‚os siÄ™ rozchodzi: WstaÅ„cie, pasterze, Bóg siÄ™ nam rodzi! Czym prÄ™dzej siÄ™ wybierajcie, Do Betlejem pospieszajcie Przywitać Pana. Poszli, znaleźli DzieciÄ…tko w żłobie Z wszystkimi znaki danymi sobie. Jako Bogu cześć Mu dali, A witajÄ…c zawoÅ‚ali Z wielkiej radoÅ›ci: Ach, witaj Zbawco z dawno żądany, Wiele tysiÄ™cy lat wyglÄ…dany Na Ciebie króle, prorocy Czekali, a TyÅ› tej nocy Nam siÄ™ objawiÅ‚. I my czekamy na Ciebie, Pana, A skoro przyjdziesz na gÅ‚os kapÅ‚ana, Padniemy na twarz przed TobÄ…, WierzÄ…c, żeÅ› jest pod osÅ‚onÄ… Chleba i wina. [end] =cut Pod-Simple-3.45/t/corpus2/polish_utf8_bom.xml0000644000175000017500000000560214243754135017260 0ustar khwkhw NAME WÅšRÓD NOCNEJ CISZY -- implicitly utf8 test document in Polish DESCRIPTION This is a test Pod document in UTF8. Its content is the lyrics to the Polish Christmas carol "WÅ›ród nocnej ciszy". WÅ›ród nocnej ciszy gÅ‚os siÄ™ rozchodzi: / WstaÅ„cie, pasterze, Bóg siÄ™ nam rodzi! / Czym prÄ™dzej siÄ™ wybierajcie, / Do Betlejem pospieszajcie / Przywitać Pana. Poszli, znaleźli DzieciÄ tko w żłobie / Z wszystkimi znaki danymi sobie. / Jako Bogu cześć Mu dali, / A witajÄ c zawoÅ‚ali / Z wielkiej radoÅ›ci: Ach, witaj Zbawco z dawno Å¼Ä dany, / Wiele tysiÄ™cy lat wyglÄ dany / Na Ciebie króle, prorocy / Czekali, a TyÅ› tej nocy / Nam siÄ™ objawiÅ‚. I my czekamy na Ciebie, Pana, / A skoro przyjdziesz na gÅ‚os kapÅ‚ana, / Padniemy na twarz przed TobÄ , / WierzÄ c, żeÅ› jest pod osÅ‚onÄ / Chleba i wina. As Verbatim And now as verbatim text: WÅ›ród nocnej ciszy gÅ‚os siÄ™ rozchodzi: WstaÅ„cie, pasterze, Bóg siÄ™ nam rodzi! Czym prÄ™dzej siÄ™ wybierajcie, Do Betlejem pospieszajcie Przywitać Pana. Poszli, znaleźli DzieciÄ…tko w żłobie Z wszystkimi znaki danymi sobie. Jako Bogu cześć Mu dali, A witajÄ…c zawoÅ‚ali Z wielkiej radoÅ›ci: Ach, witaj Zbawco z dawno żądany, Wiele tysiÄ™cy lat wyglÄ…dany Na Ciebie króle, prorocy Czekali, a TyÅ› tej nocy Nam siÄ™ objawiÅ‚. I my czekamy na Ciebie, Pana, A skoro przyjdziesz na gÅ‚os kapÅ‚ana, Padniemy na twarz przed TobÄ…, WierzÄ…c, żeÅ› jest pod osÅ‚onÄ… Chleba i wina. [end] Pod-Simple-3.45/t/corpus2/fiqhakbar_iso6.xml0000644000175000017500000002251114243754135017045 0ustar khwkhw NAME متن الفقه الاكبر -- test document: "al-Fiqh al-Akbar" as ISO-8859-6 DESCRIPTION This document is Abu Hanifah's "al-Fiqh al-Akbar" as ISO-8859-6, presented as an item-number list: متن الفقه الاكبر المنسوب الى ابي حنيفة النعمان بن ثابت لا نكفر أحدا بذنب ولا ننفي أحدا من الايمان . إنا نأمر بالمعروف وننهي عن المنكر . واعلم أن ما أصابك لم يكن ليخطئك ، وما أخطأك لم يكن ليصيبك . لا نتبرأ من أحد من أصحاب رسول الله صلى الله عليه وسلم ولا يتوالى أحد دون أحد . إنا نرد أمر عثمان وعلي الى الله وهو عالم السر والخفيات . الفقه في الدين أفضل من الفقه في العلم . واختلاف الامة رحمة . من آمن بجميع ما يؤمر به الا أنه قال لا أعرف موسى وعيسى عليهما السلام أمن المرسلين أم من غير المرسلين فإنه يكفر . من قال لا أعرف الله أفي السماء أم في الارض فقد كفر . من قال لا أعرف عذاب القبر فهو من الطبقة الجهمية والهالكية . And now run together as a paragraph: لا نكفر أحدا بذنب ولا ننفي أحدا من الايمان . إنا نأمر بالمعروف وننهي عن المنكر . واعلم أن ما أصابك لم يكن ليخطئك ، وما أخطأك لم يكن ليصيبك . لا نتبرأ من أحد من أصحاب رسول الله صلى الله عليه وسلم ولا يتوالى أحد دون أحد . إنا نرد أمر عثمان وعلي الى الله وهو عالم السر والخفيات . الفقه في الدين أفضل من الفقه في العلم . واختلاف الامة رحمة . من آمن بجميع ما يؤمر به الا أنه قال لا أعرف موسى وعيسى عليهما السلام أمن المرسلين أم من غير المرسلين فإنه يكفر . من قال لا أعرف الله أفي السماء أم في الارض فقد كفر . من قال لا أعرف عذاب القبر فهو من الطبقة الجهمية والهالكية . And now the first three as a verbatim section: لا نكفر أحدا بذنب ولا ننفي أحدا من الايمان . إنا نأمر بالمعروف وننهي عن المنكر . واعلم أن ما أصابك لم يكن ليخطئك ، وما أخطأك لم يكن ليصيبك . [end] Pod-Simple-3.45/t/corpus2/polish_utf16le_bom.txt0000644000175000017500000000576214243754135017706 0ustar khwkhwÿþ =head1 NAME WZRÓD NOCNEJ CISZY -- implicitly utf8 test document in Polish =head1 DESCRIPTION This is a test Pod document in UTF8. Its content is the lyrics to the Polish Christmas carol "W[ród nocnej ciszy". W[ród nocnej ciszy gBos si rozchodzi: / WstaDcie, pasterze, Bóg si nam rodzi! / Czym prdzej si wybierajcie, / Do Betlejem pospieszajcie / Przywita Pana. Poszli, znalezli Dziecitko w |Bobie / Z wszystkimi znaki danymi sobie. / Jako Bogu cze[ Mu dali, / A witajc zawoBali / Z wielkiej rado[ci: Ach, witaj Zbawco z dawno |dany, / Wiele tysicy lat wygldany / Na Ciebie króle, prorocy / Czekali, a Ty[ tej nocy / Nam si objawiB. I my czekamy na Ciebie, Pana, / A skoro przyjdziesz na gBos kapBana, / Padniemy na twarz przed Tob, / Wierzc, |e[ jest pod osBon / Chleba i wina. =head2 As Verbatim And now as verbatim text: W[ród nocnej ciszy gBos si rozchodzi: WstaDcie, pasterze, Bóg si nam rodzi! Czym prdzej si wybierajcie, Do Betlejem pospieszajcie Przywita Pana. Poszli, znalezli Dziecitko w |Bobie Z wszystkimi znaki danymi sobie. Jako Bogu cze[ Mu dali, A witajc zawoBali Z wielkiej rado[ci: Ach, witaj Zbawco z dawno |dany, Wiele tysicy lat wygldany Na Ciebie króle, prorocy Czekali, a Ty[ tej nocy Nam si objawiB. I my czekamy na Ciebie, Pana, A skoro przyjdziesz na gBos kapBana, Padniemy na twarz przed Tob, Wierzc, |e[ jest pod osBon Chleba i wina. [end] =cut Pod-Simple-3.45/t/corpus2/polish_utf16be_bom.txt0000644000175000017500000000576214243754135017674 0ustar khwkhwþÿ =head1 NAME WZRÓD NOCNEJ CISZY -- implicitly utf8 test document in Polish =head1 DESCRIPTION This is a test Pod document in UTF8. Its content is the lyrics to the Polish Christmas carol "W[ród nocnej ciszy". W[ród nocnej ciszy gBos si rozchodzi: / WstaDcie, pasterze, Bóg si nam rodzi! / Czym prdzej si wybierajcie, / Do Betlejem pospieszajcie / Przywita Pana. Poszli, znalezli Dziecitko w |Bobie / Z wszystkimi znaki danymi sobie. / Jako Bogu cze[ Mu dali, / A witajc zawoBali / Z wielkiej rado[ci: Ach, witaj Zbawco z dawno |dany, / Wiele tysicy lat wygldany / Na Ciebie króle, prorocy / Czekali, a Ty[ tej nocy / Nam si objawiB. I my czekamy na Ciebie, Pana, / A skoro przyjdziesz na gBos kapBana, / Padniemy na twarz przed Tob, / Wierzc, |e[ jest pod osBon / Chleba i wina. =head2 As Verbatim And now as verbatim text: W[ród nocnej ciszy gBos si rozchodzi: WstaDcie, pasterze, Bóg si nam rodzi! Czym prdzej si wybierajcie, Do Betlejem pospieszajcie Przywita Pana. Poszli, znalezli Dziecitko w |Bobie Z wszystkimi znaki danymi sobie. Jako Bogu cze[ Mu dali, A witajc zawoBali Z wielkiej rado[ci: Ach, witaj Zbawco z dawno |dany, Wiele tysicy lat wygldany Na Ciebie króle, prorocy Czekali, a Ty[ tej nocy Nam si objawiB. I my czekamy na Ciebie, Pana, A skoro przyjdziesz na gBos kapBana, Padniemy na twarz przed Tob, Wierzc, |e[ jest pod osBon Chleba i wina. [end] =cut Pod-Simple-3.45/t/strpvbtm.t0000644000175000017500000001274514362364651014116 0ustar khwkhw# t/strip_verbatim_indent.t.t - check verbatim indent stripping feature use strict; use warnings; use Test::More tests => 107; use_ok('Pod::Simple::XHTML') or exit; use_ok('Pod::Simple::XMLOutStream') or exit; isa_ok my $parser = Pod::Simple::XHTML->new, 'Pod::Simple::XHTML'; ok $parser->strip_verbatim_indent(' '), 'Should be able to set striper to " "'; ok $parser->strip_verbatim_indent(' '), 'Should be able to set striper to " "'; ok $parser->strip_verbatim_indent("t"), 'Should be able to set striper to "\\t"'; ok $parser->strip_verbatim_indent(sub { ' ' }), 'Should be able to set striper to coderef'; for my $spec ( [ "\n=pod\n\n foo bar baz\n", undef, qq{ foo bar baz}, "
     foo bar baz
    \n\n", 'undefined indent' ], [ "\n=pod\n\n foo bar baz\n", ' ', qq{foo bar baz}, "
    foo bar baz
    \n\n", 'single space indent' ], [ "\n=pod\n\n foo bar baz\n", ' ', qq{ foo bar baz}, "
     foo bar baz
    \n\n", 'too large indent' ], [ "\n=pod\n\n foo bar baz\n", ' ', qq{foo bar baz}, "
    foo bar baz
    \n\n", 'double space indent' ], [ "\n=pod\n\n foo bar baz\n", sub { ' ' }, qq{foo bar baz}, "
    foo bar baz
    \n\n", 'code ref stripper' ], [ "\n=pod\n\n foo bar\n\n baz blez\n", ' ', qq{foo bar\n\nbaz blez}, "
    foo bar\n\nbaz blez
    \n\n", 'single space indent and empty line' ], [ "\n=pod\n\n foo bar\n\n baz blez\n", sub { ' ' }, qq{foo bar\n\nbaz blez}, "
    foo bar\n\nbaz blez
    \n\n", 'code ref indent and empty line' ], [ "\n=pod\n\n foo bar\n\n baz blez\n", sub { (my $s = shift->[0]) =~ s/\S.*//; $s }, qq{foo bar\n\nbaz blez}, "
    foo bar\n\nbaz blez
    \n\n", 'heuristic code ref indent' ], [ "\n=pod\n\n foo bar\n baz blez\n", sub { s/^\s+// for @{ $_[0] } }, qq{foo bar\nbaz blez}, "
    foo bar\nbaz blez
    \n\n", 'militant code ref' ], [ "\n=pod\n\n foo (bar\n baz blez\n", sub { (my $i = $_[0]->[0]) =~ s/S.*//; $i }, qq{\n baz blez}, "
    \n   baz blez
    \n\n", 'code ref and paren' ], ) { my ($pod, $indent, $xml, $xhtml, $desc) = @$spec; # Test XML output. ok my $p = Pod::Simple::XMLOutStream->new, "Construct XML parser to test $desc"; $p->hide_line_numbers(1); my $output = ''; $p->output_string( \$output ); is $indent, $p->strip_verbatim_indent($indent), 'Set stripper for XML to ' . (defined $indent ? qq{"$indent"} : 'undef'); ok $p->parse_string_document( $pod ), "Parse POD to XML for $desc"; is $output, $xml, "Should have expected XML output for $desc"; # Test XHTML output. ok $p = Pod::Simple::XHTML->new, "Construct XHMTL parser to test $desc"; $p->html_header(''); $p->html_footer(''); $output = ''; $p->output_string( \$output ); is $indent, $p->strip_verbatim_indent($indent), 'Set stripper for XHTML to ' . (defined $indent ? qq{"$indent"} : 'undef'); ok $p->parse_string_document( $pod ), "Parse POD to XHTML for $desc"; is $output, $xhtml, "Should have expected XHTML output for $desc"; } for my $spec ( [ "\n=pod\n\n\t\tfoo bar baz\n", 0, "
    \t\tfoo bar baz
    \n\n", 'preserve tabs' ], [ "\n=pod\n\n\t\tfoo bar baz\n", undef, "
                    foo bar baz
    \n\n", 'preserve tabs' ], [ "\n=pod\n\n\t\tfoo bar baz\n", -1, "
                    foo bar baz
    \n\n", 'preserve tabs' ], [ "\n=pod\n\n\t\tfoo bar baz\n", 1, "
      foo bar baz
    \n\n", 'tabs are xlate to one space each' ], [ "\n=pod\n\n\tfoo\tbaar\tbaz\n", 4, "
        foo baar    baz
    \n\n", 'tabs are xlate to four spaces each, with correct tabstops for inner tabs' ], ) { my ($pod, $tabs, $xhtml, $desc) = @$spec; # Test XHTML output. ok my $p = Pod::Simple::XHTML->new, "Construct XHMTL parser to test $desc"; $p->html_header(''); $p->html_footer(''); my $output = ''; $p->output_string( \$output ); is $tabs, $p->expand_verbatim_tabs($tabs), 'Set tab for XHTML to ' . (defined $tabs ? qq{"$tabs"} : 'undef'); ok $p->parse_string_document( $pod ), "Parse POD to XHTML for $desc"; is $output, $xhtml, "Should have expected XHTML output for $desc"; } Pod-Simple-3.45/t/tiedfh.t0000644000175000017500000000204414243763554013472 0ustar khwkhw# Testing tied output filehandle use strict; use warnings; use Test::More tests => 6; use Pod::Simple::TiedOutFH; print "# Sanity test of Perl and Pod::Simple::TiedOutFH\n"; { my $x = 'abc'; my $out = Pod::Simple::TiedOutFH->handle_on($x); print $out "Puppies\n"; print $out "rrrrr"; print $out "uffuff!"; is $x, "abcPuppies\nrrrrruffuff!"; undef $out; is $x, "abcPuppies\nrrrrruffuff!"; } # Now test that we can have two different strings. { my $x1 = 'abc'; my $x2 = 'xyz'; my $out1 = Pod::Simple::TiedOutFH->handle_on($x1); my $out2 = Pod::Simple::TiedOutFH->handle_on($x2); print $out1 "Puppies\n"; print $out2 "Kitties\n"; print $out2 "mmmmm"; print $out1 "rrrrr"; print $out2 "iaooowwlllllllrrr!\n"; print $out1 "uffuff!"; is $x1, "abcPuppies\nrrrrruffuff!", "out1 test"; is $x2, "xyzKitties\nmmmmmiaooowwlllllllrrr!\n", "out2 test"; undef $out1; undef $out2; is $x1, "abcPuppies\nrrrrruffuff!", "out1 test"; is $x2, "xyzKitties\nmmmmmiaooowwlllllllrrr!\n", "out2 test"; } Pod-Simple-3.45/t/xhtml01.t0000644000175000017500000004007714243763540013527 0ustar khwkhw# t/xhtml01.t - check basic output from Pod::Simple::XHTML use strict; use warnings; use Test::More tests => 64; use_ok('Pod::Simple::XHTML') or exit; my $parser = Pod::Simple::XHTML->new (); isa_ok ($parser, 'Pod::Simple::XHTML'); my $results; my $PERLDOC = "https://metacpan.org/pod"; my $MANURL = "http://man.he.net/man"; initialize($parser, $results); $parser->parse_string_document( "=head1 Poit!" ); is($results, qq{

    Poit!

    \n\n}, "head1 level output"); initialize($parser, $results); $parser->parse_string_document( "=head2 Yada Yada Operator X<...> X<... operator> X" ); is($results, qq{

    Yada Yada Operator

    \n\n}, "head ID with X<>"); initialize($parser, $results); $parser->parse_string_document( "=head2 Platforms with no supporting programmers:"); is($results, qq{

    Platforms with no supporting programmers:

    \n\n}, "head ID ending in colon"); initialize($parser, $results); $parser->html_h_level(2); $parser->parse_string_document( "=head1 Poit!" ); is($results, qq{

    Poit!

    \n\n}, "head1 level output h_level 2"); initialize($parser, $results); $parser->parse_string_document( "=head2 I think so Brain." ); is($results, qq{

    I think so Brain.

    \n\n}, "head2 level output"); initialize($parser, $results); $parser->parse_string_document( "=head3 I say, Brain..." ); is($results, qq{

    I say, Brain...

    \n\n}, "head3 level output"); initialize($parser, $results); $parser->parse_string_document( "=head4 Zort & Zog!" ); is($results, qq{

    Zort & Zog!

    \n\n}, "head4 level output"); initialize($parser, $results); $parser->parse_string_document( "=head5 I think so Brain, but..." ); is($results, qq{
    I think so Brain, but...
    \n\n}, "head5 level output"); initialize($parser, $results); $parser->parse_string_document( "=head6 Narf!" ); is($results, qq{
    Narf!
    \n\n}, "head6 level output"); sub x { my $code = $_[1]; Pod::Simple::XHTML->_out( sub { $code->($_[0]) if $code }, "=pod\n\n$_[0]", ) } like( x("=head1 Header\n\n=for html
    RAW!
    \n\nDone."), qr/.+<\/h1>\s+
    RAW!<\/span><\/div>\s+.*/sm, "heading building" ) or exit; initialize($parser, $results); $parser->parse_string_document(<<'EOPOD'); =pod Gee, Brain, what do you want to do tonight? EOPOD is($results, <<'EOHTML', "simple paragraph");

    Gee, Brain, what do you want to do tonight?

    EOHTML initialize($parser, $results); $parser->parse_string_document(<<'EOPOD'); =pod B: Now, Pinky, if by any chance you are captured during this mission, remember you are Gunther Heindriksen from Appenzell. You moved to Grindelwald to drive the cog train to Murren. Can you repeat that? P: Mmmm, no, Brain, dont think I can. EOPOD is($results, <<'EOHTML', "multiple paragraphs");

    B: Now, Pinky, if by any chance you are captured during this mission, remember you are Gunther Heindriksen from Appenzell. You moved to Grindelwald to drive the cog train to Murren. Can you repeat that?

    P: Mmmm, no, Brain, dont think I can.

    EOHTML initialize($parser, $results); $parser->parse_string_document(<<'EOPOD'); =over =item * P: Gee, Brain, what do you want to do tonight? =item * B: The same thing we do every night, Pinky. Try to take over the world! =back EOPOD is($results, <<'EOHTML', "simple bulleted list");

    • P: Gee, Brain, what do you want to do tonight?

    • B: The same thing we do every night, Pinky. Try to take over the world!

    EOHTML initialize($parser, $results); $parser->parse_string_document(<<'EOPOD'); =over =item * P: Gee, Brain, what do you want to do tonight? =item * B: The same thing we do every night, Pinky. Try to take over the world! =over =item * Take over world =item * Do laundry =back =back EOPOD is($results, <<'EOHTML', "nested bulleted list");

    • P: Gee, Brain, what do you want to do tonight?

    • B: The same thing we do every night, Pinky. Try to take over the world!

      • Take over world

      • Do laundry

    EOHTML initialize($parser, $results); $parser->parse_string_document(<<'EOPOD'); =over =item 1 P: Gee, Brain, what do you want to do tonight? =item 2 B: The same thing we do every night, Pinky. Try to take over the world! =back EOPOD is($results, <<'EOHTML', "numbered list");

    1. P: Gee, Brain, what do you want to do tonight?

    2. B: The same thing we do every night, Pinky. Try to take over the world!

    EOHTML initialize($parser, $results); $parser->parse_string_document(<<'EOPOD'); =over =item 1 P: Gee, Brain, what do you want to do tonight? =item 2 B: The same thing we do every night, Pinky. Try to take over the world! =over =item 1 Take over world =item 2 Do laundry =back =back EOPOD is($results, <<'EOHTML', "nested numbered list");

    1. P: Gee, Brain, what do you want to do tonight?

    2. B: The same thing we do every night, Pinky. Try to take over the world!

      1. Take over world

      2. Do laundry

    EOHTML initialize($parser, $results); $parser->parse_string_document(<<'EOPOD'); =over =item Pinky Gee, Brain, what do you want to do tonight? =item Brain The same thing we do every night, Pinky. Try to take over the world! =back EOPOD is($results, <<'EOHTML', "list with text headings");
    Pinky

    Gee, Brain, what do you want to do tonight?

    Brain

    The same thing we do every night, Pinky. Try to take over the world!

    EOHTML initialize($parser, $results); $parser->parse_string_document(<<'EOPOD'); =over =item * Pinky Gee, Brain, what do you want to do tonight? =item * Brain The same thing we do every night, Pinky. Try to take over the world! =back EOPOD is($results, <<'EOHTML', "list with bullet and text headings");

    • Pinky

      Gee, Brain, what do you want to do tonight?

    • Brain

      The same thing we do every night, Pinky. Try to take over the world!

    EOHTML initialize($parser, $results); $parser->parse_string_document(<<'EOPOD'); =over =item * Brain =item * Pinky =back EOPOD is($results, <<'EOHTML', "bulleted author list");

    • Brain <brain@binkyandthebrain.com>

    • Pinky <pinky@binkyandthebrain.com>

    EOHTML initialize($parser, $results); $parser->parse_string_document(<<'EOPOD'); =over =item Pinky =over =item World Domination =back =item Brain =back EOPOD is($results, <<'EOHTML', 'nested lists');
    Pinky
    World Domination
    Brain
    EOHTML initialize($parser, $results); $parser->parse_string_document(<<'EOPOD'); =over =item Pinky On the list: =over =item World Domination Fight the good fight =item Go to Europe (Steve Martin joke) =back =item Brain Not so much =back EOPOD is($results, <<'EOHTML', 'multiparagraph nested lists');
    Pinky

    On the list:

    World Domination

    Fight the good fight

    Go to Europe

    (Steve Martin joke)

    Brain

    Not so much

    EOHTML initialize($parser, $results); $parser->parse_string_document(<<'EOPOD'); =pod 1 + 1 = 2; 2 + 2 = 4; EOPOD is($results, <<'EOHTML', "code block"); 
      1 + 1 = 2;
  2 + 2 = 4;
    EOHTML initialize($parser, $results); $parser->parse_string_document(<<'EOPOD'); =pod A plain paragraph with a C. C<< This code is B to Eme>! >> EOPOD is($results, <<"EOHTML", "code entity in a paragraph");

    A plain paragraph with a functionname.

    This code is important to <me>!

    EOHTML initialize($parser, $results); $parser->html_header("\n"); $parser->html_footer("\n"); $parser->parse_string_document(<<'EOPOD'); =pod A plain paragraph with body tags turned on. EOPOD is($results, <<"EOHTML", "adding html body tags");

    A plain paragraph with body tags turned on.

    EOHTML initialize($parser, $results); $parser->html_css('style.css'); $parser->html_header(undef); $parser->html_footer(undef); $parser->parse_string_document(<<'EOPOD'); =pod A plain paragraph with body tags and css tags turned on. EOPOD like($results, qr//, "adding html body tags and css tags"); initialize($parser, $results); $parser->parse_string_document(<<'EOPOD'); =pod A plain paragraph with S. EOPOD is($results, <<"EOHTML", "Non breaking text in a paragraph");

    A plain paragraph with non breaking text.

    EOHTML initialize($parser, $results); $parser->parse_string_document(<<'EOPOD'); =pod A plain paragraph with a L. EOPOD is($results, <<"EOHTML", "Link entity in a paragraph");

    A plain paragraph with a Newlines.

    EOHTML initialize($parser, $results); $parser->parse_string_document(<<'EOPOD'); =pod A plain paragraph with a L. EOPOD is($results, <<"EOHTML", "Link entity in a paragraph");

    A plain paragraph with a "Newlines" in perlport.

    EOHTML initialize($parser, $results); $parser->parse_string_document(<<'EOPOD'); =pod A plain paragraph with a L. EOPOD is($results, <<"EOHTML", "A link in a paragraph");

    A plain paragraph with a Boo.

    EOHTML initialize($parser, $results); $parser->parse_string_document(<<'EOPOD'); =pod A plain paragraph with a L. EOPOD is($results, <<"EOHTML", "A link in a paragraph");

    A plain paragraph with a http://link.included.here.

    EOHTML initialize($parser, $results); $parser->parse_string_document(<<'EOPOD'); =pod A plain paragraph with a L. EOPOD is($results, <<"EOHTML", "A link in a paragraph");

    A plain paragraph with a http://link.included.here?o=1&p=2.

    EOHTML initialize($parser, $results); $parser->parse_string_document(<<'EOPOD'); =pod A plain paragraph with B. EOPOD is($results, <<"EOHTML", "Bold text in a paragraph");

    A plain paragraph with bold text.

    EOHTML initialize($parser, $results); $parser->parse_string_document(<<'EOPOD'); =pod A plain paragraph with I. EOPOD is($results, <<"EOHTML", "Italic text in a paragraph");

    A plain paragraph with italic text.

    EOHTML initialize($parser, $results); $parser->parse_string_document(<<'EOPOD'); =pod A plain paragraph with a F. EOPOD is($results, <<"EOHTML", "File name in a paragraph");

    A plain paragraph with a filename.

    EOHTML # It's not important that 's (apostrophes) be encoded for XHTML output. initialize($parser, $results); $parser->parse_string_document(<<'EOPOD'); =pod # this header is very important & dont you forget it my $text = "File is: " . ; EOPOD is($results, <<"EOHTML", "Verbatim text with encodable entities"); 
      # this header is very important & dont you forget it
  my \$text = "File is: " . <FILE>;
    EOHTML initialize($parser, $results); $parser->parse_string_document(<<'EOPOD'); =pod A text paragraph using E and E special POD entities. EOPOD is($results, <<"EOHTML", "Text with decodable entities");

    A text paragraph using / and | special POD entities.

    EOHTML initialize($parser, $results); $parser->parse_string_document(<<'EOPOD'); =pod A text paragraph using numeric POD entities: E<60>, E<62>. EOPOD is($results, <<"EOHTML", "Text with numeric entities");

    A text paragraph using numeric POD entities: <, >.

    EOHTML my $html = q{ 
    #include <stdio.h>

int main(int argc,char *argv[]) {

        printf("Hellow World\n");
        return 0;

}
    }; initialize($parser, $results); $parser->parse_string_document("=begin html\n\n$html\n\n=end html\n"); is($results, "$html\n\n", "Text with =begin html"); SKIP: for my $use_html_entities (0, 1) { if ($use_html_entities and not $Pod::Simple::XHTML::HAS_HTML_ENTITIES) { skip("HTML::Entities not installed", 3); } local $Pod::Simple::XHTML::HAS_HTML_ENTITIES = $use_html_entities; initialize($parser, $results); $parser->codes_in_verbatim(1); $parser->parse_string_document(<<'EOPOD'); =pod # this header is very important & dont you forget it B || Blank!;> my $text = "File is: " . ; EOPOD is($results, <<"EOHTML", "Verbatim text with markup and embedded formatting"); 
      # this header is very important & dont you forget it
  my \$file = <FILE> || Blank!;
  my \$text = "File is: " . <FILE>;
    EOHTML # Specify characters to encode. initialize($parser, $results); $parser->html_encode_chars('><"&T'); $parser->parse_string_document(<<'EOPOD'); =pod This is Anna's "Answer" to the Question. =cut EOPOD my $T = $use_html_entities ? ord('T') : sprintf ("x%X", ord('T')); is($results, <<"EOHTML", 'HTML Entities should be only for specified characters');

    &#$T;his is Anna's "Answer" to the <q>Question</q>.

    EOHTML # Keep =encoding out of content. initialize($parser, $results); $parser->parse_string_document("=encoding ascii\n\n=head1 NAME\n"); is($results, <<"EOHTML", 'Encoding should not be in content')

    NAME

    EOHTML } ok $parser = Pod::Simple::XHTML->new, 'Construct a new parser'; $results = ''; $parser->output_string( \$results ); # Send the resulting output to a string ok $parser->parse_string_document( "=head1 Poit!" ), 'Parse with headers'; like $results, qr{\Q}, 'Should have proper http-equiv meta tag'; ok $parser = Pod::Simple::XHTML->new, 'Construct a new parser again'; ok $parser->html_charset('UTF-8'), 'Set the html charset to UTF-8'; $results = ''; $parser->output_string( \$results ); # Send the resulting output to a string ok $parser->parse_string_document( "=head1 Poit!" ), 'Parse with headers'; like $results, qr{\Q}, 'Should have http-equiv meta tag with UTF-8'; # Test the link generation methods. is $parser->resolve_pod_page_link('Net::Ping', 'INSTALL'), "$PERLDOC/Net::Ping#INSTALL", 'POD link with fragment'; is $parser->resolve_pod_page_link('perlpodspec'), "$PERLDOC/perlpodspec", 'Simple POD link'; is $parser->resolve_pod_page_link(undef, 'SYNOPSIS'), '#SYNOPSIS', 'Simple fragment link'; is $parser->resolve_pod_page_link(undef, 'this that'), '#this-that', 'Fragment link with space'; is $parser->resolve_pod_page_link('perlpod', 'this that'), "$PERLDOC/perlpod#this-that", 'POD link with fragment with space'; is $parser->resolve_man_page_link('crontab(5)', 'EXAMPLE CRON FILE'), "${MANURL}5/crontab", 'Man link with fragment'; is $parser->resolve_man_page_link('crontab(5)'), "${MANURL}5/crontab", 'Man link without fragment'; is $parser->resolve_man_page_link('crontab'), "${MANURL}1/crontab", 'Man link without section'; # Make sure that batch_mode_page_object_init() works. ok $parser->batch_mode_page_object_init(0, 0, 0, 0, 6), 'Call batch_mode_page_object_init()'; ok $parser->batch_mode, 'We should be in batch mode'; is $parser->batch_mode_current_level, 6, 'The level should have been set'; ###################################### sub initialize { $_[0] = Pod::Simple::XHTML->new (); $_[0]->html_header(""); $_[0]->html_footer(""); $_[0]->output_string( \$results ); # Send the resulting output to a string $_[1] = ''; return; } Pod-Simple-3.45/t/perlcyg.pod0000644000175000017500000004770314243754135014221 0ustar khwkhwIf you read this file _as_is_, just ignore the funny characters you see. It is written in the POD format (see pod/perlpod.pod) which is specially designed to be readable as is. =head1 NAME README.cygwin - Perl for Cygwin =head1 SYNOPSIS This document will help you configure, make, test and install Perl on Cygwin. This document also describes features of Cygwin that will affect how Perl behaves at runtime. B There are pre-built Perl packages available for Cygwin and a version of Perl is provided on the Cygwin CD. If you do not need to customize the configuration, consider using one of these packages: http://cygutils.netpedia.net/ =head1 PREREQUISITES =head2 Cygwin = GNU+Cygnus+Windows (Don't leave UNIX without it) The Cygwin tools are ports of the popular GNU development tools for Win32 platforms. They run thanks to the Cygwin library which provides the UNIX system calls and environment these programs expect. More information about this project can be found at: http://www.cygwin.com/ A recent net or commercial release of Cygwin is required. At the time this document was last updated, Cygwin 1.1.5 was current. B At this point, minimal effort has been made to provide compatibility with old (beta) Cygwin releases. The focus has been to provide a high quality release and not worry about working around old bugs. If you wish to use Perl with Cygwin B20.1 or earlier, consider using perl5.005_03, which is available in source and binary form at C. If there is significant demand, a patch kit can be developed to port back to earlier Cygwin versions. =head2 Cygwin Configuration While building Perl some changes may be necessary to your Cygwin setup so that Perl builds cleanly. These changes are B required for normal Perl usage. B The binaries that are built will run on all Win32 versions. They do not depend on your host system (Win9x/WinME, WinNT/Win2K) or your Cygwin configuration (I, I, binary/text mounts). The only dependencies come from hard-coded pathnames like C. However, your host system and Cygwin configuration will affect Perl's runtime behavior (see L). =over 4 =item * C Set the C environment variable so that Configure finds the Cygwin versions of programs. Any Windows directories should be removed or moved to the end of your C. =item * I If you do not have I (which is part of the I package), Configure will B prompt you to install I pages. =item * Permissions On WinNT with either the I or I C settings, directory and file permissions may not be set correctly. Since the build process creates directories and files, to be safe you may want to run a `C' on the entire Perl source tree. Also, it is a well known WinNT "feature" that files created by a login that is a member of the I group will be owned by the I group. Depending on your umask, you may find that you can not write to files that you just created (because you are no longer the owner). When using the I C setting, this is not an issue because it "corrects" the ownership to what you would expect on a UNIX system. =back =head1 CONFIGURE The default options gathered by Configure with the assistance of F will build a Perl that supports dynamic loading (which requires a shared F). This will run Configure and keep a record: ./Configure 2>&1 | tee log.configure If you are willing to accept all the defaults run Configure with B<-de>. However, several useful customizations are available. =head2 Strip Binaries It is possible to strip the EXEs and DLLs created by the build process. The resulting binaries will be significantly smaller. If you want the binaries to be stripped, you can either add a B<-s> option when Configure prompts you, Any additional ld flags (NOT including libraries)? [none] -s Any special flags to pass to gcc to use dynamic linking? [none] -s Any special flags to pass to ld2 to create a dynamically loaded library? [none] -s or you can edit F and uncomment the relevant variables near the end of the file. =head2 Optional Libraries Several Perl functions and modules depend on the existence of some optional libraries. Configure will find them if they are installed in one of the directories listed as being used for library searches. Pre-built packages for most of these are available at C. =over 4 =item * C<-lcrypt> The crypt package distributed with Cygwin is a Linux compatible 56-bit DES crypt port by Corinna Vinschen. Alternatively, the crypt libraries in GNU libc have been ported to Cygwin. The DES based Ultra Fast Crypt port was done by Alexey Truhan: ftp://ftp.franken.de/pub/win32/develop/gnuwin32/cygwin/porters/Okhapkin_Sergey/cw32crypt-dist-0.tgz NOTE: There are various export restrictions on DES implementations, see the glibc README for more details. The MD5 port was done by Andy Piper: ftp://ftp.franken.de/pub/win32/develop/gnuwin32/cygwin/porters/Okhapkin_Sergey/libcrypt.tgz =item * C<-lgdbm> (C) GDBM is available for Cygwin. GDBM's ndbm/dbm compatibility feature also makes C and C possible (although they add little extra value). NOTE: The ndbm/dbm emulations only completely work on NTFS partitions. =item * C<-ldb> (C) BerkeleyDB is available for Cygwin. Some details can be found in F. NOTE: The BerkeleyDB library only completely works on NTFS partitions. =item * C<-lcygipc> (C) A port of SysV IPC is available for Cygwin. NOTE: This has B been extensively tested. In particular, C is undefined because it fails a Configure test and on Win9x the I functions seem to hang. It also creates a compile time dependency because F includes F<> and F<> (which will be required in the future when compiling CPAN modules). =back =head2 Configure-time Options The F document describes several Configure-time options. Some of these will work with Cygwin, others are not yet possible. Also, some of these are experimental. You can either select an option when Configure prompts you or you can define (undefine) symbols on the command line. =over 4 =item * C<-Uusedl> Undefining this symbol forces Perl to be compiled statically. =item * C<-Uusemymalloc> By default Perl uses the malloc() included with the Perl source. If you want to force Perl to build with the system malloc() undefine this symbol. =item * C<-Dusemultiplicity> Multiplicity is required when embedding Perl in a C program and using more than one interpreter instance. This works with the Cygwin port. =item * C<-Duseperlio> The PerlIO abstraction works with the Cygwin port. =item * C<-Duse64bitint> I supports 64-bit integers. However, several additional long long functions are necessary to use them within Perl (I<{strtol,strtoul}l>). These are B yet available with Cygwin. =item * C<-Duselongdouble> I supports long doubles (12 bytes). However, several additional long double math functions are necessary to use them within Perl (I<{atan2,cos,exp,floor,fmod,frexp,isnan,log,modf,pow,sin,sqrt}l,strtold>). These are B yet available with Cygwin. =item * C<-Dusethreads> POSIX threads are B yet implemented in Cygwin. =item * C<-Duselargefiles> Although Win32 supports large files, Cygwin currently uses 32-bit integers for internal size and position calculations. =back =head2 Suspicious Warnings You may see some messages during Configure that seem suspicious. =over 4 =item * I I is needed to build dynamic libraries, but it does not exist when dlsym() checking occurs (it is not created until `C' runs). You will see the following message: Checking whether your dlsym() needs a leading underscore ... ld2: not found I can't compile and run the test program. I'm guessing that dlsym doesn't need a leading underscore. Since the guess is correct, this is not a problem. =item * Win9x and C Win9x does not correctly report C with a non-blocking read on a closed pipe. You will see the following messages: But it also returns -1 to signal EOF, so be careful! WARNING: you can't distinguish between EOF and no data! *** WHOA THERE!!! *** The recommended value for $d_eofnblk on this machine was "define"! Keep the recommended value? [y] At least for consistency with WinNT, you should keep the recommended value. =item * Compiler/Preprocessor defines The following error occurs because of the Cygwin C<#define> of C<_LONG_DOUBLE>: Guessing which symbols your C compiler and preprocessor define... try.c:: parse error This failure does not seem to cause any problems. =back =head1 MAKE Simply run I and wait: make 2>&1 | tee log.make =head2 Warnings Warnings like these are normal: warning: overriding commands for target warning: ignoring old commands for target dllwrap: no export definition file provided dllwrap: creating one, but that may not be what you want =head2 ld2 During `C', I will be created and installed in your $installbin directory (where you said to put public executables). It does not wait until the `C' process to install the I script, this is because the remainder of the `C' refers to I without fully specifying its path and does this from multiple subdirectories. The assumption is that $installbin is in your current C. If this is not the case `C' will fail at some point. If this happens, just manually copy I from the source directory to somewhere in your C. =head1 TEST There are two steps to running the test suite: make test 2>&1 | tee log.make-test cd t;./perl harness 2>&1 | tee ../log.harness The same tests are run both times, but more information is provided when running as `C<./perl harness>'. Test results vary depending on your host system and your Cygwin configuration. If a test can pass in some Cygwin setup, it is always attempted and explainable test failures are documented. It is possible for Perl to pass all the tests, but it is more likely that some tests will fail for one of the reasons listed below. =head2 File Permissions UNIX file permissions are based on sets of mode bits for {read,write,execute} for each {user,group,other}. By default Cygwin only tracks the Win32 read-only attribute represented as the UNIX file user write bit (files are always readable, files are executable if they have a F<.{com,bat,exe}> extension or begin with C<#!>, directories are always readable and executable). On WinNT with the I C setting, the additional mode bits are stored as extended file attributes. On WinNT with the I C setting, permissions use the standard WinNT security descriptors and access control lists. Without one of these options, these tests will fail: Failed Test List of failed ------------------------------------ io/fs.t 5, 7, 9-10 lib/anydbm.t 2 lib/db-btree.t 20 lib/db-hash.t 16 lib/db-recno.t 18 lib/gdbm.t 2 lib/ndbm.t 2 lib/odbm.t 2 lib/sdbm.t 2 op/stat.t 9, 20 (.tmp not an executable extension) =head2 Hard Links FAT partitions do not support hard links (whereas NTFS does), in which case Cygwin implements link() by copying the file. On remote (network) drives Cygwin's stat() always sets C to 1, so the link count for remote directories and files is not available. In either case, these tests will fail: Failed Test List of failed ------------------------------------ io/fs.t 4 op/stat.t 3 =head2 Filetime Granularity On FAT partitions the filetime granularity is 2 seconds. The following test will fail: Failed Test List of failed ------------------------------------ io/fs.t 18 =head2 Tainting Checks When Perl is running in taint mode, C<$ENV{PATH}> is considered tainted and not used, so DLLs not in the default system directories will not be found. While the tests are running you will see warnings popup from the system with messages like: Win9x Error Starting Program A required .DLL file, CYGWIN1.DLL, was not found WinNT perl.exe - Unable to Locate DLL The dynamic link library cygwin1.dll could not be found in the specified path ... Just click OK and ignore them. When running `C', 2 popups occur. During `C<./perl harness>', 4 popups occur. Also, these tests will fail: Failed Test List of failed ------------------------------------ op/taint.t 1, 3, 31, 37 Alternatively, you can copy F into the directory where the tests run: cp /bin/cygwin1.dll t or one of the Windows system directories (although, this is B recommended). =head2 /etc/group Cygwin does not require F, in which case the F test will be skipped. The check performed by F expects to see entries that use the members field, otherwise this test will fail: Failed Test List of failed ------------------------------------ op/grent.t 1 =head2 Script Portability Cygwin does an outstanding job of providing UNIX-like semantics on top of Win32 systems. However, in addition to the items noted above, there are some differences that you should know about. This is a very brief guide to portability, more information can be found in the Cygwin documentation. =over 4 =item * Pathnames Cygwin pathnames can be separated by forward (F) or backward (F<\>) slashes. They may also begin with drive letters (F) or Universal Naming Codes (F). DOS device names (F, F, F, F, F, F) are invalid as base filenames. However, they can be used in extensions (e.g., F). Names may contain all printable characters except these: : * ? " < > | File names are case insensitive, but case preserving. A pathname that contains a backslash or drive letter is a Win32 pathname (and not subject to the translations applied to POSIX style pathnames). =item * Text/Binary When a file is opened it is in either text or binary mode. In text mode a file is subject to CR/LF/Ctrl-Z translations. With Cygwin, the default mode for an open() is determined by the mode of the mount that underlies the file. Perl provides a binmode() function to set binary mode on files that otherwise would be treated as text. sysopen() with the C flag sets text mode on files that otherwise would be treated as binary: sysopen(FOO, "bar", O_WRONLY|O_CREAT|O_TEXT) lseek(), tell() and sysseek() only work with files opened in binary mode. The text/binary issue is covered at length in the Cygwin documentation. =item * F<.exe> The Cygwin stat(), lstat() and readlink() functions make the F<.exe> extension transparent by looking for F when you ask for F (unless a F also exists). Cygwin does not require a F<.exe> extension, but I adds it automatically when building a program. However, when accessing an executable as a normal file (e.g., I in a makefile) the F<.exe> is not transparent. The I included with Cygwin automatically appends a F<.exe> when necessary. =item * chown() On WinNT chown() can change a file's user and group IDs. On Win9x chown() is a no-op, although this is appropriate since there is no security model. =item * Miscellaneous File locking using the C command to fcntl() is a stub that returns C. Win9x can not rename() an open file (although WinNT can). The Cygwin chroot() implementation has holes (it can not restrict file access by native Win32 programs). =back =head1 INSTALL This will install Perl, including I pages. make install | tee log.make-install NOTE: If C is redirected `C' will B prompt you to install I into F. You may need to be I to run `C'. If you are not, you must have write access to the directories in question. Information on installing the Perl documentation in HTML format can be found in the F document. =head1 MANIFEST These are the files in the Perl release that contain references to Cygwin. These very brief notes attempt to explain the reason for all conditional code. Hopefully, keeping this up to date will allow the Cygwin port to be kept as clean as possible. =over 4 =item Documentation INSTALL README.cygwin README.win32 MANIFEST Changes Changes5.005 Changes5.004 Changes5.6 pod/perl.pod pod/perlport.pod pod/perlfaq3.pod pod/perldelta.pod pod/perl5004delta.pod pod/perl56delta.pod pod/perlhist.pod pod/perlmodlib.pod pod/buildtoc.PL pod/perltoc.pod =item Build, Configure, Make, Install cygwin/Makefile.SHs cygwin/ld2.in cygwin/perlld.in ext/IPC/SysV/hints/cygwin.pl ext/NDBM_File/hints/cygwin.pl ext/ODBM_File/hints/cygwin.pl hints/cygwin.sh Configure - help finding hints from uname, shared libperl required for dynamic loading Makefile.SH - linklibperl Porting/patchls - cygwin in port list installman - man pages with :: translated to . installperl - install dll/ld2/perlld, install to pods makedepend.SH - uwinfix =item Tests t/io/tell.t - binmode t/lib/b.t - ignore Cwd from os_extras t/lib/glob-basic.t - Win32 directory list access differs from read mode t/op/magic.t - $^X/symlink WORKAROUND, s/.exe// t/op/stat.t - no /dev, skip Win32 ftCreationTime quirk (cache manager sometimes preserves ctime of file previously created and deleted), no -u (setuid) =item Compiled Perl Source EXTERN.h - __declspec(dllimport) XSUB.h - __declspec(dllexport) cygwin/cygwin.c - os_extras (getcwd, spawn) perl.c - os_extras perl.h - binmode doio.c - win9x can not rename a file when it is open pp_sys.c - do not define h_errno, pp_system with spawn util.c - use setenv =item Compiled Module Source ext/POSIX/POSIX.xs - tzname defined externally ext/SDBM_File/sdbm/pair.c - EXTCONST needs to be redefined from EXTERN.h ext/SDBM_File/sdbm/sdbm.c - binary open =item Perl Modules/Scripts lib/Cwd.pm - hook to internal Cwd::cwd lib/ExtUtils/MakeMaker.pm - require MM_Cygwin.pm lib/ExtUtils/MM_Cygwin.pm - canonpath, cflags, manifypods, perl_archive lib/File/Find.pm - on remote drives stat() always sets st_nlink to 1 lib/File/Spec/Unix.pm - preserve //unc lib/File/Temp.pm - no directory sticky bit lib/perl5db.pl - use stdin not /dev/tty utils/perldoc.PL - version comment =back =head1 BUGS When I starts, it warns about overriding commands for F. `C' does not remove library F<.def> or F<.exe.stackdump> files. The I script contains references to the source directory. You should change these to $installbin after `C'. Support for swapping real and effective user and group IDs is incomplete. On WinNT Cygwin provides setuid(), seteuid(), setgid() and setegid(). However, additional Cygwin calls for manipulating WinNT access tokens and security contexts are required. When building DLLs, `C' is used to export global symbols. It might be better to generate an explicit F<.def> file (see F). Also, DLLs can now be build with `C'. =head1 AUTHORS Charles Wilson , Eric Fifer , alexander smishlajev , Steven Morlock , Sebastien Barre , Teun Burgers . =head1 HISTORY Last updated: 9 November 2000 Pod-Simple-3.45/t/search20.t0000644000175000017500000000472714243763554013650 0ustar khwkhwuse strict; use warnings; use Pod::Simple::Search; use Test::More tests => 9; print "# ", __FILE__, ": Testing the scanning of several (well, two) docroots...\n"; my $x = Pod::Simple::Search->new; die "Couldn't make an object!?" unless ok defined $x; $x->inc(0); $x->callback(sub { print "# ", join(" ", map "{$_}", @_), "\n"; return; }); use File::Spec; use Cwd (); use File::Basename (); my $t_dir = File::Basename::dirname(Cwd::abs_path(__FILE__)); my $here1 = File::Spec->catdir($t_dir, 'testlib1'); my $here2 = File::Spec->catdir($t_dir, 'testlib2'); print "# OK, found the test corpora\n# as $here1\n# and $here2\n"; print $x->_state_as_string; #$x->verbose(12); use Pod::Simple; *pretty = \&Pod::Simple::BlackBox::pretty; print "# OK, starting run...\n# [[\n"; my($name2where, $where2name) = $x->survey($here1, $here2); print "# ]]\n#OK, run done.\n"; my $p = pretty( $where2name, $name2where )."\n"; $p =~ s/, +/,\n/g; $p =~ s/^/# /mg; print $p; require File::Spec->catfile($t_dir, 'ascii_order.pl'); SKIP: { skip '-- case may or may not be preserved', 2 if $^O eq 'VMS'; { my $names = join "|", sort ascii_order values %$where2name; is $names, "Blorm|Suzzle|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Vliff|perlflif|perlthng|perlzoned|perlzuk|squaa|squaa::Glunk|squaa::Vliff|squaa::Wowo|zikzik"; } { my $names = join "|", sort ascii_order keys %$name2where; is $names, "Blorm|Suzzle|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Vliff|perlflif|perlthng|perlzoned|perlzuk|squaa|squaa::Glunk|squaa::Vliff|squaa::Wowo|zikzik"; } } like( ($name2where->{'squaa'} || 'huh???'), qr/squaa\.pm$/); is grep( m/squaa\.pm/, keys %$where2name ), 1; ###### Now with recurse(0) $x->recurse(0); print "# OK, starting run without recurse...\n# [[\n"; ($name2where, $where2name) = $x->survey($here1, $here2); print "# ]]\n#OK, run without recurse done.\n"; $p = pretty( $where2name, $name2where )."\n"; $p =~ s/, +/,\n/g; $p =~ s/^/# /mg; print $p; SKIP: { skip '-- case may or may not be preserved', 2 if $^O eq 'VMS'; { my $names = join "|", sort ascii_order values %$where2name; is $names, "Blorm|Suzzle|squaa|zikzik"; } { my $names = join "|", sort ascii_order keys %$name2where; is $names, "Blorm|Suzzle|squaa|zikzik"; } } like( ($name2where->{'squaa'} || 'huh???'), qr/squaa\.pm$/); is grep( m/squaa\.pm/, keys %$where2name ), 1; Pod-Simple-3.45/t/begin.t0000644000175000017500000005377014243763554013327 0ustar khwkhwuse strict; use warnings; use Test::More tests => 60; my $d; #use Pod::Simple::Debug (\$d, 0); use Pod::Simple::DumpAsXML; use Pod::Simple::XMLOutStream; print "# Pod::Simple version $Pod::Simple::VERSION\n"; BEGIN { require FindBin; unshift @INC, $FindBin::Bin . '/lib'; } use helpers; my $x = 'Pod::Simple::XMLOutStream'; $Pod::Simple::XMLOutStream::ATTR_PAD = ' '; $Pod::Simple::XMLOutStream::SORT_ATTRS = 1; # for predictably testable output sub moj {$_[0]->accept_target('mojojojo')} sub mojtext {$_[0]->accept_target_as_text('mojojojo')} sub any {$_[0]->accept_target_as_text('*')} #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ print "# Testing non-matching complaint...\n"; { my $out; like( ($out = $x->_out( "=pod\n\nI like pie.\n\n=begin mojojojo\n\nStuff\n\n=end blorp\n\nYup.\n")), qr/POD ERRORS/ ) or print "# Didn't contain POD ERRORS:\n# $out\n"; like( ($out = $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin :mojojojo\n\nStuff\n\n=end :blorp\n\nYup.\n")), qr/POD ERRORS/ ) or print "# Didn't contain POD ERRORS:\n# $out\n"; like( ($out = $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin :mojojojo\n\n=begin :zaz\n\nStuff\n\n=end :blorp\n\nYup.\n")), qr/POD ERRORS/ ) or print "# Didn't contain POD ERRORS:\n# $out\n"; } #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ print "# Testing some trivial cases of non-acceptance...\n"; is( $x->_out( "=pod\n\nI like pie.\n\n=begin mojojojo\n\nStuff\n\n=end mojojojo\n\nYup.\n"), 'I like pie.Yup.' ); is( $x->_out( "=pod\n\nI like pie.\n\n=begin mojojojo\n\n\nStuff\n\n=end mojojojo\n\nYup.\n"), 'I like pie.Yup.' ); is( $x->_out( "=pod\n\nI like pie.\n\n=begin :mojojojo\n\n\nStuff\n\n=end :mojojojo\n\nYup.\n"), 'I like pie.Yup.' ); is( $x->_out( "=pod\n\nI like pie.\n\n=begin mojojojo\n\n Stuff\n\n=end mojojojo\n\nYup.\n"), 'I like pie.Yup.' ); is( $x->_out( "=pod\n\nI like pie.\n\n=begin mojojojo\n\n\n Stuff\n\n=end mojojojo\n\nYup.\n"), 'I like pie.Yup.' ); is( $x->_out( "=pod\n\nI like pie.\n\n=begin :mojojojo\n\n\n Stuff\n\n=end :mojojojo\n\nYup.\n"), 'I like pie.Yup.' ); is( $x->_out( "=pod\n\nI like pie.\n\n=begin mojojojo\n\nI\n\n=end mojojojo\n\nYup.\n"), 'I like pie.Yup.' ); is( $x->_out( "=pod\n\nI like pie.\n\n=begin mojojojo\n\n\nI\n\n=end mojojojo\n\nYup.\n"), 'I like pie.Yup.' ); is( $x->_out( "=pod\n\nI like pie.\n\n=begin :mojojojo\n\n\nI\n\n=end :mojojojo\n\nYup.\n"), 'I like pie.Yup.' ); is( $x->_out( "=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk\n\nStuff\n\n=end psketti,mojojojo,crunk\n\nYup.\n"), 'I like pie.Yup.' ); is( $x->_out( "=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk\n\n\nStuff\n\n=end psketti,mojojojo,crunk\n\nYup.\n"), 'I like pie.Yup.' ); is( $x->_out( "=pod\n\nI like pie.\n\n=begin :psketti,mojojojo,crunk\n\n\nStuff\n\n=end :psketti,mojojojo,crunk\n\nYup.\n"), 'I like pie.Yup.' ); is( $x->_out( "=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk\n\n Stuff\n\n=end psketti,mojojojo,crunk\n\nYup.\n"), 'I like pie.Yup.' ); is( $x->_out( "=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk\n\n\n Stuff\n\n=end psketti,mojojojo,crunk\n\nYup.\n"), 'I like pie.Yup.' ); is( $x->_out( "=pod\n\nI like pie.\n\n=begin :psketti,mojojojo,crunk\n\n\n Stuff\n\n=end :psketti,mojojojo,crunk\n\nYup.\n"), 'I like pie.Yup.' ); is( $x->_out( "=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk\n\nI\n\n=end psketti,mojojojo,crunk\n\nYup.\n"), 'I like pie.Yup.' ); is( $x->_out( "=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk\n\n\nI\n\n=end psketti,mojojojo,crunk\n\nYup.\n"), 'I like pie.Yup.' ); is( $x->_out( "=pod\n\nI like pie.\n\n=begin :psketti,mojojojo,crunk\n\n\nI\n\n=end :psketti,mojojojo,crunk\n\nYup.\n"), 'I like pie.Yup.' ); #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ print "# Testing matching because of negated non-acceptance...\n"; #$d = 5; is( $x->_out( "=pod\n\nI like pie.\n\n=begin !crunk\n\nstuff\n\n=end !crunk\n\nYup.\n"), 'I like pie.stuffYup.' ); is( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin !crunk\n\nstuff\n\n=end !crunk\n\nYup.\n"), 'I like pie.stuffYup.' ); is( $x->_out( "=pod\n\nI like pie.\n\n=begin !mojojojo\n\nstuff\n\n=end !mojojojo\n\nYup.\n"), 'I like pie.stuffYup.' ); is( $x->_out( "=pod\n\nI like pie.\n\n=begin !mojojojo\n\nI\n\n=end !mojojojo\n\nYup.\n"), 'I like pie.I<stuff>Yup.' ); is( $x->_out( "=pod\n\nI like pie.\n\n=begin !:mojojojo\n\nI\n\n=end !:mojojojo\n\nYup.\n"), 'I like pie.stuffYup.' ); is( $x->_out( "=pod\n\nI like pie.\n\n=begin :!mojojojo \n\nI\n\n=end :!mojojojo \t \n\nYup.\n"), 'I like pie.stuffYup.' ); is( $x->_out( "=pod\n\nI like pie.\n\n=begin !crunk,zaz\n\nstuff\n\n=end !crunk,zaz\n\nYup.\n"), 'I like pie.stuffYup.' ); is( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin !crunk\n\nstuff\n\n=end !crunk\n\nYup.\n"), 'I like pie.stuffYup.' ); is( $x->_out( \&mojtext, "=pod\n\nI like pie.\n\n=begin !crunk\n\nstuff\n\n=end !crunk\n\nYup.\n"), 'I like pie.stuffYup.' ); is( $x->_out( \&any, "=pod\n\nI like pie.\n\n=begin !crunk\n\nstuff\n\n=end !crunk\n\nYup.\n"), 'I like pie.stuffYup.' ); is( $x->_out( "=pod\n\nI like pie.\n\n=begin !mojojojo\n\nstuff\n\n=end !mojojojo\n\nYup.\n"), 'I like pie.stuffYup.' ); is( $x->_out( "=pod\n\nI like pie.\n\n=begin !mojojojo\n\nI\n\n\n=end !mojojojo\n\nYup.\n"), 'I like pie.I<stuff>Yup.' ); is( $x->_out( "=pod\n\nI like pie.\n\n=begin !psketti,mojojojo,crunk\n\n\nI\n\n=end !psketti,mojojojo,crunk\n\nYup.\n"), 'I like pie.I<stuff>Yup.' ); is( $x->_out( "=pod\n\nI like pie.\n\n=begin !:psketti,mojojojo,crunk\n\nI\n\n=end !:psketti,mojojojo,crunk\n\nYup.\n"), 'I like pie.stuffYup.' ); #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ print "# Testing accept_target + simple ...\n"; is( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin mojojojo\n\nI\n\n=end mojojojo \n\nYup.\n"), 'I like pie.I<stuff>Yup.' ); is( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk\n\nI\n\n=end psketti,mojojojo,crunk \n\nYup.\n"), 'I like pie.I<stuff>Yup.' ); print "# Testing accept_target_as_text + simple ...\n"; is( $x->_out( \&mojtext, "=pod\n\nI like pie.\n\n=begin mojojojo\n\nI\n\n=end mojojojo \n\nYup.\n"), 'I like pie.stuffYup.' ); is( $x->_out( \&mojtext, "=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk\n\nI\n\n=end psketti,mojojojo,crunk \n\nYup.\n"), 'I like pie.stuffYup.' ); print "# Testing accept_target + two simples ...\n"; #$d = 10; is( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin mojojojo\n\nI\n\nHm, B!\n\n=end mojojojo\n\n\nYup.\n"), 'I like pie.I<stuff>Hm, B<things>!Yup.' ); is( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk\n\nI\n\nHm, B!\n\n=end psketti,mojojojo,crunk\n\nYup.\n"), 'I like pie.I<stuff>Hm, B<things>!Yup.' ); is( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin :mojojojo\n\nI\n\nHm, B!\n\n=end :mojojojo\n\nYup.\n"), 'I like pie.stuffHm, things!Yup.' ); is( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin :psketti,mojojojo,crunk\n\nI\n\nHm, B!\n\n=end :psketti,mojojojo,crunk\n\nYup.\n"), 'I like pie.stuffHm, things!Yup.' ); print "# Testing accept_target_as_text + two simples ...\n"; is( $x->_out( \&mojtext, "=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk\n\nI\n\nHm, B!\n\n=end psketti,mojojojo,crunk\n\nYup.\n"), 'I like pie.stuffHm, things!Yup.' ); is( $x->_out( \&mojtext, "=pod\n\nI like pie.\n\n=begin :psketti,mojojojo,crunk\n\nI\n\nHm, B!\n\n=end :psketti,mojojojo,crunk\n\nYup.\n"), 'I like pie.stuffHm, things!Yup.' ); print "# Testing accept_target + two simples, latter with leading whitespace ...\n"; #$d = 10; is( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin mojojojo\n\nI\n\n Hm, B!\nTrala.\n\n=end mojojojo\n\n\nYup.\n"), qq{I like pie.I<stuff> Hm, B<things>!\nTrala.\nYup.} ); is( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk\n\nI\n\n Hm, B!\nTrala.\n\n=end psketti,mojojojo,crunk\n\nYup.\n"), qq{I like pie.I<stuff> Hm, B<things>!\nTrala.\nYup.} ); is( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin mojojojo\n\nI\n\n Hm, B!\nTrala.\n\n\n=end mojojojo\n\n\nYup.\n"), qq{I like pie.I<stuff> Hm, B<things>!\nTrala.\n\nYup.} ); is( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk\n\nI\n\n Hm, B!\nTrala.\n\n\n=end psketti,mojojojo,crunk\n\nYup.\n"), qq{I like pie.I<stuff> Hm, B<things>!\nTrala.\n\nYup.} ); print "# Testing :-target and accept_target + two simples, latter with leading whitespace ...\n"; is( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin :mojojojo\n\nI\nTrala!\n\n Hm, B!\nTrala.\n\n=end :mojojojo\n\nYup.\n"), qq{I like pie.stuff Trala! Hm, B<things>!\nTrala.Yup.} ); is( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin :psketti,mojojojo,crunk\n\nI\nTrala!\n\n Hm, B!\nTrala.\n\n=end :psketti,mojojojo,crunk\n\nYup.\n"), qq{I like pie.stuff Trala! Hm, B<things>!\nTrala.Yup.} ); print "# now with accept_target_as_text\n"; is( $x->_out( \&mojtext, "=pod\n\nI like pie.\n\n=begin mojojojo\n\nI\nTrala!\n\n Hm, B!\nTrala.\n\n=end mojojojo\n\nYup.\n"), qq{I like pie.stuff Trala! Hm, B<things>!\nTrala.Yup.} ); is( $x->_out( \&mojtext, join "\n\n" => "=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk", "I\nTrala!", " Hm, B!\nTrala.", "=end psketti,mojojojo,crunk", "Yup.\n" ), qq{I like pie.}. qq{}. qq{stuff Trala!}. qq{ Hm, B<things>!\nTrala.}. qq{Yup.} ); print "# Now with five paragraphs (p,v,v,p,p) and accept_target_as_text\n"; is( $x->_out( \&mojtext, join "\n\n" => "=pod\n\nI like pie.\n\n=begin psketti,mojojojo,crunk", "I\nTrala!", " Hm, B!\nTrala.", " Oh, F<< dodads >>!\nHurf.", "Boing C\n Blorg!", "Woohah Ssquim!", "=end psketti,mojojojo,crunk", "Yup.\n" ), qq{I like pie.}. qq{}. qq{stuff Trala!}. qq{ Hm, B<things>!\nTrala.\n\n}. qq{ Oh, F<< dodads >>!\nHurf.}. qq{Boing spr- oink Blorg!}. qq{Woohah thwack woohahsquim!}. qq{Yup.} ); print "#\n# Now nested begin...end regions...\n"; sub mojprok { shift->accept_targets(qw{mojojojo prok}) } is( $x->_out( \&mojprok, join "\n\n" => "=pod\n\nI like pie.", "=begin :psketti,mojojojo,crunk", "I\nTrala!", " Hm, B!\nTrala.", " Oh, F<< dodads >>!\nHurf.", "Boing C\n Blorg!", "=begin :prok", "Woohah Ssquim!", "=end :prok", "ZubZ<>aaz.", "=end :psketti,mojojojo,crunk", "Yup.\n" ), qq{I like pie.}. qq{}. qq{stuff Trala!}. qq{ Hm, B<things>!\nTrala.\n\n}. qq{ Oh, F<< dodads >>!\nHurf.}. qq{Boing spr- oink Blorg!}. qq{}. qq{Woohah thwack woohahsquim!}. qq{}. qq{Zubaaz.}. qq{}. qq{Yup.} ); print "# a little more complex this time...\n"; is( $x->_out( \&mojprok, join "\n\n" => "=pod\n\nI like pie.", "=begin :psketti,mojojojo,crunk", "I\nTrala!", " Hm, B!\nTrala.", " Oh, F<< dodads >>!\nHurf.", "Boing C\n Blorg!", "=begin :prok", " Blorp, B!\nTrala.", " Khh, F<< dodads >>!\nHurf.", "Woohah Ssquim!", "=end :prok", "ZubZ<>aaz.", "=end :psketti,mojojojo,crunk", "Yup.\n" ), qq{I like pie.}. qq{}. qq{stuff Trala!}. qq{ Hm, B<things>!\nTrala.\n\n}. qq{ Oh, F<< dodads >>!\nHurf.}. qq{Boing spr- oink Blorg!}. qq{}. qq{ Blorp, B<things>!\nTrala.\n\n}. qq{ Khh, F<< dodads >>!\nHurf.}. qq{Woohah thwack woohahsquim!}. qq{}. qq{Zubaaz.}. qq{}. qq{Yup.} ); $d = 10; print "# Now with nesting where inner region is non-resolving...\n"; is( $x->_out( \&mojprok, join "\n\n" => "=pod\n\nI like pie.", "=begin :psketti,mojojojo,crunk", "I\nTrala!", " Hm, B!\nTrala.", " Oh, F<< dodads >>!\nHurf.", "Boing C\n Blorg!", "=begin prok", " Blorp, B!\nTrala.", " Khh, F<< dodads >>!\nHurf.", "Woohah Ssquim!", "=end prok", "ZubZ<>aaz.", "=end :psketti,mojojojo,crunk", "Yup.\n" ), qq{I like pie.}. qq{}. qq{stuff Trala!}. qq{ Hm, B<things>!\nTrala.\n\n}. qq{ Oh, F<< dodads >>!\nHurf.}. qq{Boing spr- oink Blorg!}. qq{}. qq{ Blorp, B<things>!\nTrala.\n\n}. qq{ Khh, F<< dodads >>!\nHurf.\n}. qq{Woohah S<thwack\nwoohah>squim!}. qq{}. qq{Zubaaz.}. qq{}. qq{Yup.} ); print "# Now a begin...end with a non-resolving for inside\n"; is( $x->_out( \&mojprok, join "\n\n" => "=pod\n\nI like pie.", "=begin :psketti,mojojojo,crunk", "I\nTrala!", " Hm, B!\nTrala.", " Oh, F<< dodads >>!\nHurf.", "Boing C\n Blorg!", "=for prok" . " Blorp, B!\nTrala.\n Khh, F<< dodads >>!\nHurf.", "ZubZ<>aaz.", "=end :psketti,mojojojo,crunk", "Yup.\n" ), qq{I like pie.}. qq{}. qq{stuff Trala!}. qq{ Hm, B<things>!\nTrala.\n\n}. qq{ Oh, F<< dodads >>!\nHurf.}. qq{Boing spr- oink Blorg!}. qq{}. qq{Blorp, B<things>!\nTrala.\n}. qq{ Khh, F<< dodads >>!\nHurf.}. qq{}. qq{Zubaaz.}. qq{}. qq{Yup.} ); print "# Now a begin...end with a resolving for inside\n"; is( $x->_out( \&mojprok, join "\n\n" => "=pod\n\nI like pie.", "=begin :psketti,mojojojo,crunk", "I\nTrala!", " Hm, B!\nTrala.", " Oh, F<< dodads >>!\nHurf.", "Boing C\n Blorg!", "=for :prok" . " Blorp, B!\nTrala.\n Khh, F<< dodads >>!\nHurf.", "ZubZ<>aaz.", "=end :psketti,mojojojo,crunk", "Yup.\n" ), qq{I like pie.}. qq{}. qq{stuff Trala!}. qq{ Hm, B<things>!\nTrala.\n\n}. qq{ Oh, F<< dodads >>!\nHurf.}. qq{Boing spr- oink Blorg!}. qq{}. qq{Blorp, things! Trala. Khh, }. qq{dodads! Hurf.}. qq{}. qq{Zubaaz.}. qq{}. qq{Yup.} ); #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ print "# Testing matching of begin block titles\n"; is( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=begin mojojojo Title\n\nstuff\n\n=end mojojojo \n\nYup.\n"), 'I like pie.stuffYup.' ); Pod-Simple-3.45/t/perlvaro.txt0000644000175000017500000011422214243754135014432 0ustar khwkhwNAME perlvar - Perl predefined variables DESCRIPTION Predefined Names The following names have special meaning to Perl. Most punctuation names have reasonable mnemonics, or analogs in the shells. Nevertheless, if you wish to use long variable names, you need only say use English; at the top of your program. This will alias all the short names to the long names in the current package. Some even have medium names, generally borrowed from awk. If you don't mind the performance hit, variables that depend on the currently selected filehandle may instead be set by calling an appropriate object method on the IO::Handle object. (Summary lines below for this contain the word HANDLE.) First you must say use IO::Handle; after which you may use either method HANDLE EXPR or more safely, HANDLE->method(EXPR) Each method returns the old value of the IO::Handle attribute. The methods each take an optional EXPR, which if supplied specifies the new value for the IO::Handle attribute in question. If not supplied, most methods do nothing to the current value--except for autoflush(), which will assume a 1 for you, just to be different. Because loading in the IO::Handle class is an expensive operation, you should learn how to use the regular built-in variables. A few of these variables are considered "read-only". This means that if you try to assign to this variable, either directly or indirectly through a reference, you'll raise a run-time exception. The following list is ordered by scalar variables first, then the arrays, then the hashes. $ARG $_ The default input and pattern-searching space. The following pairs are equivalent: while (<>) {...} # equivalent only in while! while (defined($_ = <>)) {...} /^Subject:/ $_ =~ /^Subject:/ tr/a-z/A-Z/ $_ =~ tr/a-z/A-Z/ chomp chomp($_) Here are the places where Perl will assume $_ even if you don't use it: Various unary functions, including functions like ord() and int(), as well as the all file tests (-f, -d) except for -t, which defaults to STDIN. Various list functions like print() and unlink(). The pattern matching operations m//, s///, and tr/// when used without an =~ operator. The default iterator variable in a foreach loop if no other variable is supplied. The implicit iterator variable in the grep() and map() functions. The default place to put an input record when a operation's result is tested by itself as the sole criterion of a while test. Outside a while test, this will not happen. (Mnemonic: underline is understood in certain operations.) $ Contains the subpattern from the corresponding set of capturing parentheses from the last pattern match, not counting patterns matched in nested blocks that have been exited already. (Mnemonic: like \digits.) These variables are all read-only and dynamically scoped to the current BLOCK. $MATCH $& The string matched by the last successful pattern match (not counting any matches hidden within a BLOCK or eval() enclosed by the current BLOCK). (Mnemonic: like & in some editors.) This variable is read-only and dynamically scoped to the current BLOCK. The use of this variable anywhere in a program imposes a considerable performance penalty on all regular expression matches. See BUGS. $PREMATCH $` The string preceding whatever was matched by the last successful pattern match (not counting any matches hidden within a BLOCK or eval enclosed by the current BLOCK). (Mnemonic: ` often precedes a quoted string.) This variable is read-only. The use of this variable anywhere in a program imposes a considerable performance penalty on all regular expression matches. See BUGS. $POSTMATCH $' The string following whatever was matched by the last successful pattern match (not counting any matches hidden within a BLOCK or eval() enclosed by the current BLOCK). (Mnemonic: ' often follows a quoted string.) Example: $_ = 'abcdefghi'; /def/; print "$`:$&:$'\n"; # prints abc:def:ghi This variable is read-only and dynamically scoped to the current BLOCK. The use of this variable anywhere in a program imposes a considerable performance penalty on all regular expression matches. See BUGS. $LAST_PAREN_MATCH $+ The last bracket matched by the last search pattern. This is useful if you don't know which one of a set of alternative patterns matched. For example: /Version: (.*)|Revision: (.*)/ && ($rev = $+); (Mnemonic: be positive and forward looking.) This variable is read-only and dynamically scoped to the current BLOCK. @LAST_MATCH_END @+ This array holds the offsets of the ends of the last successful submatches in the currently active dynamic scope. $+[0] is the offset into the string of the end of the entire match. This is the same value as what the pos function returns when called on the variable that was matched against. The nth element of this array holds the offset of the nth submatch, so $+[1] is the offset past where $1 ends, $+[2] the offset past where $2 ends, and so on. You can use $#+ to determine how many subgroups were in the last successful match. See the examples given for the @- variable. $MULTILINE_MATCHING $* Set to a non-zero integer value to do multi-line matching within a string, 0 (or undefined) to tell Perl that it can assume that strings contain a single line, for the purpose of optimizing pattern matches. Pattern matches on strings containing multiple newlines can produce confusing results when $* is 0 or undefined. Default is undefined. (Mnemonic: * matches multiple things.) This variable influences the interpretation of only ^ and $. A literal newline can be searched for even when $* == 0. Use of $* is deprecated in modern Perl, supplanted by the /s and /m modifiers on pattern matching. Assigning a non-numerical value to $* triggers a warning (and makes $* act if $* == 0), while assigning a numerical value to $* makes that an implicit int is applied on the value. input_line_number HANDLE EXPR $INPUT_LINE_NUMBER $NR $. The current input record number for the last file handle from which you just read() (or called a seek or tell on). The value may be different from the actual physical line number in the file, depending on what notion of "line" is in effect--see $/ on how to change that. An explicit close on a filehandle resets the line number. Because <> never does an explicit close, line numbers increase across ARGV files (but see examples in "eof" in perlfunc). Consider this variable read-only: setting it does not reposition the seek pointer; you'll have to do that on your own. Localizing $. has the effect of also localizing Perl's notion of "the last read filehandle". (Mnemonic: many programs use "." to mean the current line number.) input_record_separator HANDLE EXPR $INPUT_RECORD_SEPARATOR $RS $/ The input record separator, newline by default. This influences Perl's idea of what a "line" is. Works like awk's RS variable, including treating empty lines as a terminator if set to the null string. (An empty line cannot contain any spaces or tabs.) You may set it to a multi-character string to match a multi-character terminator, or to undef to read through the end of file. Setting it to "\n\n" means something slightly different than setting to "", if the file contains consecutive empty lines. Setting to "" will treat two or more consecutive empty lines as a single empty line. Setting to "\n\n" will blindly assume that the next input character belongs to the next paragraph, even if it's a newline. (Mnemonic: / delimits line boundaries when quoting poetry.) undef $/; # enable "slurp" mode $_ = ; # whole file now here s/\n[ \t]+/ /g; Remember: the value of $/ is a string, not a regex. awk has to be better for something. :-) Setting $/ to a reference to an integer, scalar containing an integer, or scalar that's convertible to an integer will attempt to read records instead of lines, with the maximum record size being the referenced integer. So this: $/ = \32768; # or \"32768", or \$var_containing_32768 open(FILE, $myfile); $_ = ; will read a record of no more than 32768 bytes from FILE. If you're not reading from a record-oriented file (or your OS doesn't have record-oriented files), then you'll likely get a full chunk of data with every read. If a record is larger than the record size you've set, you'll get the record back in pieces. On VMS, record reads are done with the equivalent of sysread, so it's best not to mix record and non-record reads on the same file. (This is unlikely to be a problem, because any file you'd want to read in record mode is probably unusable in line mode.) Non-VMS systems do normal I/O, so it's safe to mix record and non-record reads of a file. See also "Newlines" in perlport. Also see $.. autoflush HANDLE EXPR $OUTPUT_AUTOFLUSH $| If set to nonzero, forces a flush right away and after every write or print on the currently selected output channel. Default is 0 (regardless of whether the channel is really buffered by the system or not; $| tells you only whether you've asked Perl explicitly to flush after each write). STDOUT will typically be line buffered if output is to the terminal and block buffered otherwise. Setting this variable is useful primarily when you are outputting to a pipe or socket, such as when you are running a Perl program under rsh and want to see the output as it's happening. This has no effect on input buffering. See "getc" in perlfunc for that. (Mnemonic: when you want your pipes to be piping hot.) output_field_separator HANDLE EXPR $OUTPUT_FIELD_SEPARATOR $OFS $, The output field separator for the print operator. Ordinarily the print operator simply prints out its arguments without further adornment. To get behavior more like awk, set this variable as you would set awk's OFS variable to specify what is printed between fields. (Mnemonic: what is printed when there is a "," in your print statement.) output_record_separator HANDLE EXPR $OUTPUT_RECORD_SEPARATOR $ORS $\ The output record separator for the print operator. Ordinarily the print operator simply prints out its arguments as is, with no trailing newline or other end-of-record string added. To get behavior more like awk, set this variable as you would set awk's ORS variable to specify what is printed at the end of the print. (Mnemonic: you set $\ instead of adding "\n" at the end of the print. Also, it's just like $/, but it's what you get "back" from Perl.) $LIST_SEPARATOR $" This is like $, except that it applies to array and slice values interpolated into a double-quoted string (or similar interpreted string). Default is a space. (Mnemonic: obvious, I think.) $SUBSCRIPT_SEPARATOR $SUBSEP $; The subscript separator for multidimensional array emulation. If you refer to a hash element as $foo{$a,$b,$c} it really means $foo{join($;, $a, $b, $c)} But don't put @foo{$a,$b,$c} # a slice--note the @ which means ($foo{$a},$foo{$b},$foo{$c}) Default is "\034", the same as SUBSEP in awk. If your keys contain binary data there might not be any safe value for $;. (Mnemonic: comma (the syntactic subscript separator) is a semi-semicolon. Yeah, I know, it's pretty lame, but $, is already taken for something more important.) Consider using "real" multidimensional arrays as described in perllol. $OFMT $# The output format for printed numbers. This variable is a half-hearted attempt to emulate awk's OFMT variable. There are times, however, when awk and Perl have differing notions of what counts as numeric. The initial value is "%.ng", where n is the value of the macro DBL_DIG from your system's float.h. This is different from awk's default OFMT setting of "%.6g", so you need to set $# explicitly to get awk's value. (Mnemonic: # is the number sign.) Use of $# is deprecated. format_page_number HANDLE EXPR $FORMAT_PAGE_NUMBER $% The current page number of the currently selected output channel. Used with formats. (Mnemonic: % is page number in nroff.) format_lines_per_page HANDLE EXPR $FORMAT_LINES_PER_PAGE $= The current page length (printable lines) of the currently selected output channel. Default is 60. Used with formats. (Mnemonic: = has horizontal lines.) format_lines_left HANDLE EXPR $FORMAT_LINES_LEFT $- The number of lines left on the page of the currently selected output channel. Used with formats. (Mnemonic: lines_on_page - lines_printed.) @LAST_MATCH_START @- $-[0] is the offset of the start of the last successful match. $-[n] is the offset of the start of the substring matched by n-th subpattern, or undef if the subpattern did not match. Thus after a match against $_, $& coincides with substr $_, $-[0], $+[0] - $-[0]. Similarly, $n coincides with substr $_, $-[n], $+[n] - $-[n] if $-[n] is defined, and $+ coincides with substr $_, $-[$#-], $+[$#-]. One can use $#- to find the last matched subgroup in the last successful match. Contrast with $#+, the number of subgroups in the regular expression. Compare with @+. This array holds the offsets of the beginnings of the last successful submatches in the currently active dynamic scope. $-[0] is the offset into the string of the beginning of the entire match. The nth element of this array holds the offset of the nth submatch, so $+[1] is the offset where $1 begins, $+[2] the offset where $2 begins, and so on. You can use $#- to determine how many subgroups were in the last successful match. Compare with the @+ variable. After a match against some variable $var: $` is the same as substr($var, 0, $-[0]) $& is the same as substr($var, $-[0], $+[0] - $-[0]) $' is the same as substr($var, $+[0]) $1 is the same as substr($var, $-[1], $+[1] - $-[1]) $2 is the same as substr($var, $-[2], $+[2] - $-[2]) $3 is the same as substr $var, $-[3], $+[3] - $-[3]) format_name HANDLE EXPR $FORMAT_NAME $~ The name of the current report format for the currently selected output channel. Default is the name of the filehandle. (Mnemonic: brother to $^.) format_top_name HANDLE EXPR $FORMAT_TOP_NAME $^ The name of the current top-of-page format for the currently selected output channel. Default is the name of the filehandle with _TOP appended. (Mnemonic: points to top of page.) format_line_break_characters HANDLE EXPR $FORMAT_LINE_BREAK_CHARACTERS $: The current set of characters after which a string may be broken to fill continuation fields (starting with ^) in a format. Default is " \n-", to break on whitespace or hyphens. (Mnemonic: a "colon" in poetry is a part of a line.) format_formfeed HANDLE EXPR $FORMAT_FORMFEED $^L What formats output as a form feed. Default is \f. $ACCUMULATOR $^A The current value of the write() accumulator for format() lines. A format contains formline() calls that put their result into $^A. After calling its format, write() prints out the contents of $^A and empties. So you never really see the contents of $^A unless you call formline() yourself and then look at it. See perlform and "formline()" in perlfunc. $CHILD_ERROR $? The status returned by the last pipe close, backtick (``) command, successful call to wait() or waitpid(), or from the system() operator. This is just the 16-bit status word returned by the wait() system call (or else is made up to look like it). Thus, the exit value of the subprocess is really ($? >> 8), and $? & 127 gives which signal, if any, the process died from, and $? & 128 reports whether there was a core dump. (Mnemonic: similar to sh and ksh.) Additionally, if the h_errno variable is supported in C, its value is returned via $? if any gethost*() function fails. If you have installed a signal handler for SIGCHLD, the value of $? will usually be wrong outside that handler. Inside an END subroutine $? contains the value that is going to be given to exit(). You can modify $? in an END subroutine to change the exit status of your program. For example: END { $? = 1 if $? == 255; # die would make it 255 } Under VMS, the pragma use vmsish 'status' makes $? reflect the actual VMS exit status, instead of the default emulation of POSIX status. Also see "Error Indicators". $OS_ERROR $ERRNO $! If used numerically, yields the current value of the C errno variable, with all the usual caveats. (This means that you shouldn't depend on the value of $! to be anything in particular unless you've gotten a specific error return indicating a system error.) If used an a string, yields the corresponding system error string. You can assign a number to $! to set errno if, for instance, you want "$!" to return the string for error n, or you want to set the exit value for the die() operator. (Mnemonic: What just went bang?) Also see "Error Indicators". $EXTENDED_OS_ERROR $^E Error information specific to the current operating system. At the moment, this differs from $! under only VMS, OS/2, and Win32 (and for MacPerl). On all other platforms, $^E is always just the same as $!. Under VMS, $^E provides the VMS status value from the last system error. This is more specific information about the last system error than that provided by $!. This is particularly important when $! is set to EVMSERR. Under OS/2, $^E is set to the error code of the last call to OS/2 API either via CRT, or directly from perl. Under Win32, $^E always returns the last error information reported by the Win32 call GetLastError() which describes the last error from within the Win32 API. Most Win32-specific code will report errors via $^E. ANSI C and Unix-like calls set errno and so most portable Perl code will report errors via $!. Caveats mentioned in the description of $! generally apply to $^E, also. (Mnemonic: Extra error explanation.) Also see "Error Indicators". $EVAL_ERROR $@ The Perl syntax error message from the last eval() operator. If null, the last eval() parsed and executed correctly (although the operations you invoked may have failed in the normal fashion). (Mnemonic: Where was the syntax error "at"?) Warning messages are not collected in this variable. You can, however, set up a routine to process warnings by setting $SIG{__WARN__} as described below. Also see "Error Indicators". $PROCESS_ID $PID $$ The process number of the Perl running this script. You should consider this variable read-only, although it will be altered across fork() calls. (Mnemonic: same as shells.) $REAL_USER_ID $UID $< The real uid of this process. (Mnemonic: it's the uid you came from, if you're running setuid.) $EFFECTIVE_USER_ID $EUID $> The effective uid of this process. Example: $< = $>; # set real to effective uid ($<,$>) = ($>,$<); # swap real and effective uid (Mnemonic: it's the uid you went to, if you're running setuid.) $< and $> can be swapped only on machines supporting setreuid(). $REAL_GROUP_ID $GID $( The real gid of this process. If you are on a machine that supports membership in multiple groups simultaneously, gives a space separated list of groups you are in. The first number is the one returned by getgid(), and the subsequent ones by getgroups(), one of which may be the same as the first number. However, a value assigned to $( must be a single number used to set the real gid. So the value given by $( should not be assigned back to $( without being forced numeric, such as by adding zero. (Mnemonic: parentheses are used to group things. The real gid is the group you left, if you're running setgid.) $EFFECTIVE_GROUP_ID $EGID $) The effective gid of this process. If you are on a machine that supports membership in multiple groups simultaneously, gives a space separated list of groups you are in. The first number is the one returned by getegid(), and the subsequent ones by getgroups(), one of which may be the same as the first number. Similarly, a value assigned to $) must also be a space-separated list of numbers. The first number sets the effective gid, and the rest (if any) are passed to setgroups(). To get the effect of an empty list for setgroups(), just repeat the new effective gid; that is, to force an effective gid of 5 and an effectively empty setgroups() list, say $) = "5 5" . (Mnemonic: parentheses are used to group things. The effective gid is the group that's right for you, if you're running setgid.) $<, $>, $( and $) can be set only on machines that support the corresponding set[re][ug]id() routine. $( and $) can be swapped only on machines supporting setregid(). $PROGRAM_NAME $0 Contains the name of the program being executed. On some operating systems assigning to $0 modifies the argument area that the ps program sees. This is more useful as a way of indicating the current program state than it is for hiding the program you're running. (Mnemonic: same as sh and ksh.) Note for BSD users: setting $0 does not completely remove "perl" from the ps(1) output. For example, setting $0 to "foobar" will result in "perl: foobar (perl)". This is an operating system feature. $[ The index of the first element in an array, and of the first character in a substring. Default is 0, but you could theoretically set it to 1 to make Perl behave more like awk (or Fortran) when subscripting and when evaluating the index() and substr() functions. (Mnemonic: [ begins subscripts.) As of release 5 of Perl, assignment to $[ is treated as a compiler directive, and cannot influence the behavior of any other file. Its use is highly discouraged. $] The version + patchlevel / 1000 of the Perl interpreter. This variable can be used to determine whether the Perl interpreter executing a script is in the right range of versions. (Mnemonic: Is this version of perl in the right bracket?) Example: warn "No checksumming!\n" if $] < 3.019; See also the documentation of use VERSION and require VERSION for a convenient way to fail if the running Perl interpreter is too old. The use of this variable is deprecated. The floating point representation can sometimes lead to inaccurate numeric comparisons. See $^V for a more modern representation of the Perl version that allows accurate string comparisons. $COMPILING $^C The current value of the flag associated with the -c switch. Mainly of use with -MO=... to allow code to alter its behavior when being compiled, such as for example to AUTOLOAD at compile time rather than normal, deferred loading. See perlcc. Setting $^C = 1 is similar to calling B::minus_c. $DEBUGGING $^D The current value of the debugging flags. (Mnemonic: value of -D switch.) $SYSTEM_FD_MAX $^F The maximum system file descriptor, ordinarily 2. System file descriptors are passed to exec()ed processes, while higher file descriptors are not. Also, during an open(), system file descriptors are preserved even if the open() fails. (Ordinary file descriptors are closed before the open() is attempted.) The close-on-exec status of a file descriptor will be decided according to the value of $^F when the corresponding file, pipe, or socket was opened, not the time of the exec(). $^H WARNING: This variable is strictly for internal use only. Its availability, behavior, and contents are subject to change without notice. This variable contains compile-time hints for the Perl interpreter. At the end of compilation of a BLOCK the value of this variable is restored to the value when the interpreter started to compile the BLOCK. When perl begins to parse any block construct that provides a lexical scope (e.g., eval body, required file, subroutine body, loop body, or conditional block), the existing value of $^H is saved, but its value is left unchanged. When the compilation of the block is completed, it regains the saved value. Between the points where its value is saved and restored, code that executes within BEGIN blocks is free to change the value of $^H. This behavior provides the semantic of lexical scoping, and is used in, for instance, the use strict pragma. The contents should be an integer; different bits of it are used for different pragmatic flags. Here's an example: sub add_100 { $^H |= 0x100 } sub foo { BEGIN { add_100() } bar->baz($boon); } Consider what happens during execution of the BEGIN block. At this point the BEGIN block has already been compiled, but the body of foo() is still being compiled. The new value of $^H will therefore be visible only while the body of foo() is being compiled. Substitution of the above BEGIN block with: BEGIN { require strict; strict->import('vars') } demonstrates how use strict 'vars' is implemented. Here's a conditional version of the same lexical pragma: BEGIN { require strict; strict->import('vars') if $condition } %^H WARNING: This variable is strictly for internal use only. Its availability, behavior, and contents are subject to change without notice. The %^H hash provides the same scoping semantic as $^H. This makes it useful for implementation of lexically scoped pragmas. $INPLACE_EDIT $^I The current value of the inplace-edit extension. Use undef to disable inplace editing. (Mnemonic: value of -i switch.) $^M By default, running out of memory is an untrappable, fatal error. However, if suitably built, Perl can use the contents of $^M as an emergency memory pool after die()ing. Suppose that your Perl were compiled with -DPERL_EMERGENCY_SBRK and used Perl's malloc. Then $^M = 'a' x (1 << 16); would allocate a 64K buffer for use in an emergency. See the INSTALL file in the Perl distribution for information on how to enable this option. To discourage casual use of this advanced feature, there is no English long name for this variable. $OSNAME $^O The name of the operating system under which this copy of Perl was built, as determined during the configuration process. The value is identical to $Config{'osname'}. See also Config and the -V command-line switch documented in perlrun. $PERLDB $^P The internal variable for debugging support. The meanings of the various bits are subject to change, but currently indicate: 0x01 Debug subroutine enter/exit. 0x02 Line-by-line debugging. 0x04 Switch off optimizations. 0x08 Preserve more data for future interactive inspections. 0x10 Keep info about source lines on which a subroutine is defined. 0x20 Start with single-step on. 0x40 Use subroutine address instead of name when reporting. 0x80 Report goto &subroutine as well. 0x100 Provide informative "file" names for evals based on the place they were compiled. 0x200 Provide informative names to anonymous subroutines based on the place they were compiled. Some bits may be relevant at compile-time only, some at run-time only. This is a new mechanism and the details may change. $LAST_REGEXP_CODE_RESULT $^R The result of evaluation of the last successful (?{ code }) regular expression assertion (see perlre). May be written to. $EXCEPTIONS_BEING_CAUGHT $^S Current state of the interpreter. Undefined if parsing of the current module/eval is not finished (may happen in $SIG{__DIE__} and $SIG{__WARN__} handlers). True if inside an eval(), otherwise false. $BASETIME $^T The time at which the program began running, in seconds since the epoch (beginning of 1970). The values returned by the -M, -A, and -C filetests are based on this value. $PERL_VERSION $^V The revision, version, and subversion of the Perl interpreter, represented as a string composed of characters with those ordinals. Thus in Perl v5.6.0 it equals chr(5) . chr(6) . chr(0) and will return true for $^V eq v5.6.0. Note that the characters in this string value can potentially be in Unicode range. This can be used to determine whether the Perl interpreter executing a script is in the right range of versions. (Mnemonic: use ^V for Version Control.) Example: warn "No \"our\" declarations!\n" if $^V and $^V lt v5.6.0; See the documentation of use VERSION and require VERSION for a convenient way to fail if the running Perl interpreter is too old. See also $] for an older representation of the Perl version. $WARNING $^W The current value of the warning switch, initially true if -w was used, false otherwise, but directly modifiable. (Mnemonic: related to the -w switch.) See also warnings. ${^WARNING_BITS} The current set of warning checks enabled by the use warnings pragma. See the documentation of warnings for more details. ${^WIDE_SYSTEM_CALLS} Global flag that enables system calls made by Perl to use wide character APIs native to the system, if available. This is currently only implemented on the Windows platform. This can also be enabled from the command line using the -C switch. The initial value is typically 0 for compatibility with Perl versions earlier than 5.6, but may be automatically set to 1 by Perl if the system provides a user-settable default (e.g., $ENV{LC_CTYPE}). The bytes pragma always overrides the effect of this flag in the current lexical scope. See bytes. $EXECUTABLE_NAME $^X The name that the Perl binary itself was executed as, from C's argv[0]. This may not be a full pathname, nor even necessarily in your path. $ARGV contains the name of the current file when reading from <>. @ARGV The array @ARGV contains the command-line arguments intended for the script. $#ARGV is generally the number of arguments minus one, because $ARGV[0] is the first argument, not the program's command name itself. See $0 for the command name. @INC The array @INC contains the list of places that the do EXPR, require, or use constructs look for their library files. It initially consists of the arguments to any -I command-line switches, followed by the default Perl library, probably /usr/local/lib/perl, followed by ".", to represent the current directory. If you need to modify this at runtime, you should use the use lib pragma to get the machine-dependent library properly loaded also: use lib '/mypath/libdir/'; use SomeMod; @_ Within a subroutine the array @_ contains the parameters passed to that subroutine. See perlsub. %INC The hash %INC contains entries for each filename included via the do, require, or use operators. The key is the filename you specified (with module names converted to pathnames), and the value is the location of the file found. The require operator uses this hash to determine whether a particular file has already been included. %ENV $ENV{expr} The hash %ENV contains your current environment. Setting a value in ENV changes the environment for any child processes you subsequently fork() off. %SIG $SIG{expr} The hash %SIG contains signal handlers for signals. For example: sub handler { # 1st argument is signal name my($sig) = @_; print "Caught a SIG$sig--shutting down\n"; close(LOG); exit(0); } $SIG{'INT'} = \&handler; $SIG{'QUIT'} = \&handler; ... $SIG{'INT'} = 'DEFAULT'; # restore default action $SIG{'QUIT'} = 'IGNORE'; # ignore SIGQUIT Using a value of 'IGNORE' usually has the effect of ignoring the signal, except for the CHLD signal. See perlipc for more about this special case. Here are some other examples: $SIG{"PIPE"} = "Plumber"; # assumes main::Plumber (not recommended) $SIG{"PIPE"} = \&Plumber; # just fine; assume current Plumber $SIG{"PIPE"} = *Plumber; # somewhat esoteric $SIG{"PIPE"} = Plumber(); # oops, what did Plumber() return?? Be sure not to use a bareword as the name of a signal handler, lest you inadvertently call it. If your system has the sigaction() function then signal handlers are installed using it. This means you get reliable signal handling. If your system has the SA_RESTART flag it is used when signals handlers are installed. This means that system calls for which restarting is supported continue rather than returning when a signal arrives. If you want your system calls to be interrupted by signal delivery then do something like this: use POSIX ':signal_h'; my $alarm = 0; sigaction SIGALRM, new POSIX::SigAction sub { $alarm = 1 } or die "Error setting SIGALRM handler: $!\n"; See POSIX. Certain internal hooks can be also set using the %SIG hash. The routine indicated by $SIG{__WARN__} is called when a warning message is about to be printed. The warning message is passed as the first argument. The presence of a __WARN__ hook causes the ordinary printing of warnings to STDERR to be suppressed. You can use this to save warnings in a variable, or turn warnings into fatal errors, like this: local $SIG{__WARN__} = sub { die $_[0] }; eval $proggie; The routine indicated by $SIG{__DIE__} is called when a fatal exception is about to be thrown. The error message is passed as the first argument. When a __DIE__ hook routine returns, the exception processing continues as it would have in the absence of the hook, unless the hook routine itself exits via a goto, a loop exit, or a die(). The __DIE__ handler is explicitly disabled during the call, so that you can die from a __DIE__ handler. Similarly for __WARN__. Due to an implementation glitch, the $SIG{__DIE__} hook is called even inside an eval(). Do not use this to rewrite a pending exception in $@, or as a bizarre substitute for overriding CORE::GLOBAL::die(). This strange action at a distance may be fixed in a future release so that $SIG{__DIE__} is only called if your program is about to exit, as was the original intent. Any other use is deprecated. __DIE__/__WARN__ handlers are very special in one respect: they may be called to report (probable) errors found by the parser. In such a case the parser may be in inconsistent state, so any attempt to evaluate Perl code from such a handler will probably result in a segfault. This means that warnings or errors that result from parsing Perl should be used with extreme caution, like this: require Carp if defined $^S; Carp::confess("Something wrong") if defined &Carp::confess; die "Something wrong, but could not load Carp to give backtrace... To see backtrace try starting Perl with -MCarp switch"; Here the first line will load Carp unless it is the parser who called the handler. The second line will print backtrace and die if Carp was available. The third line will be executed only if Carp was not available. See "die" in perlfunc, "warn" in perlfunc, "eval" in perlfunc, and warnings for additional information. Error Indicators The variables $@, $!, $^E, and $? contain information about different types of error conditions that may appear during execution of a Perl program. The variables are shown ordered by the "distance" between the subsystem which reported the error and the Perl process. They correspond to errors detected by the Perl interpreter, C library, operating system, or an external program, respectively. To illustrate the differences between these variables, consider the following Perl expression, which uses a single-quoted string: eval q{ open PIPE, "/cdrom/install |"; @res = ; close PIPE or die "bad pipe: $?, $!"; }; After execution of this statement all 4 variables may have been set. $@ is set if the string to be eval-ed did not compile (this may happen if open or close were imported with bad prototypes), or if Perl code executed during evaluation die()d . In these cases the value of $@ is the compile error, or the argument to die (which will interpolate $! and $?!). (See also Fatal, though.) When the eval() expression above is executed, open(), , and close are translated to calls in the C run-time library and thence to the operating system kernel. $! is set to the C library's errno if one of these calls fails. Under a few operating systems, $^E may contain a more verbose error indicator, such as in this case, "CDROM tray not closed." Systems that do not support extended error messages leave $^E the same as $!. Finally, $? may be set to non-0 value if the external program /cdrom/install fails. The upper eight bits reflect specific error conditions encountered by the program (the program's exit() value). The lower eight bits reflect mode of failure, like signal death and core dump information See wait(2) for details. In contrast to $! and $^E, which are set only if error condition is detected, the variable $? is set on each wait or pipe close, overwriting the old value. This is more like $@, which on every eval() is always set on failure and cleared on success. For more details, see the individual descriptions at $@, $!, $^E, and $?. Technical Note on the Syntax of Variable Names Variable names in Perl can have several formats. Usually, they must begin with a letter or underscore, in which case they can be arbitrarily long (up to an internal limit of 251 characters) and may contain letters, digits, underscores, or the special sequence :: or '. In this case, the part before the last :: or ' is taken to be a package qualifier; see perlmod. Perl variable names may also be a sequence of digits or a single punctuation or control character. These names are all reserved for special uses by Perl; for example, the all-digits names are used to hold data captured by backreferences after a regular expression match. Perl has a special syntax for the single-control-character names: It understands ^X (caret X) to mean the control-X character. For example, the notation $^W (dollar-sign caret W) is the scalar variable whose name is the single character control-W. This is better than typing a literal control-W into your program. Finally, new in Perl 5.6, Perl variable names may be alphanumeric strings that begin with control characters (or better yet, a caret). These variables must be written in the form ${^Foo}; the braces are not optional. ${^Foo} denotes the scalar variable whose name is a control-F followed by two o's. These variables are reserved for future special uses by Perl, except for the ones that begin with ^_ (control-underscore or caret-underscore). No control-character name that begins with ^_ will acquire a special meaning in any future version of Perl; such names may therefore be used safely in programs. $^_ itself, however, is reserved. Perl identifiers that begin with digits, control characters, or punctuation characters are exempt from the effects of the package declaration and are always forced to be in package main. A few other names are also exempt: ENV STDIN INC STDOUT ARGV STDERR ARGVOUT SIG In particular, the new special ${^_XYZ} variables are always taken to be in package main, regardless of any package declarations presently in scope. BUGS Due to an unfortunate accident of Perl's implementation, use English imposes a considerable performance penalty on all regular expression matches in a program, regardless of whether they occur in the scope of use English. For that reason, saying use English in libraries is strongly discouraged. See the Devel::SawAmpersand module documentation from CPAN (http://www.perl.com/CPAN/modules/by-module/Devel/) for more information. Having to even think about the $^S variable in your exception handlers is simply wrong. $SIG{__DIE__} as currently implemented invites grievous and difficult to track down errors. Avoid it and use an END{} or CORE::GLOBAL::die override instead. Pod-Simple-3.45/t/junk1o.txt0000644000175000017500000000047614243754137014016 0ustar khwkhwpie is nice E POD ERRORS Hey! The above document had some coding errors, which are explained below: Around line 2: =cut found outside a pod block. Skipping to next block. Around line 4: Unknown directive: =head9 Around line 6: Unterminated B<...> sequence Around line 8: Unknown E content in E Pod-Simple-3.45/t/JustPod01.t0000644000175000017500000001272614243763540013763 0ustar khwkhw# t/JustPod01.t - check basics of Pod::Simple::JustPod use strict; use warnings; use Test::More tests => 2; use utf8; use_ok('Pod::Simple::JustPod') or exit; my $parser = Pod::Simple::JustPod->new(); my $input; while ( ) { $input .= $_ } my $output; $parser->output_string( \$output ); $parser->parse_string_document( $input ); # Strip off text before =pod in the input $input =~ s/^.*(=pod.*)$/$1/mgs; my $msg = "got expected output"; if ($output eq $input) { pass($msg); } elsif ($ENV{PERL_TEST_DIFF}) { fail($msg); require File::Temp; my $orig_file = File::Temp->new(); local $/ = "\n"; chomp $input; print $orig_file $input, "\n"; close $orig_file || die "Can't close orig_file: $!"; chomp $output; my $parsed_file = File::Temp->new(); print $parsed_file $output, "\n"; close $parsed_file || die "Can't close parsed_file"; my $diff = File::Temp->new(); system("$ENV{PERL_TEST_DIFF} $orig_file $parsed_file > $diff"); open my $fh, "<", $diff || die "Can't open $diff"; my @diffs = <$fh>; diag(@diffs); } else { eval { require Text::Diff; }; if ($@) { is($output, $input, $msg); diag("Set environment variable PERL_TEST_DIFF=diff_tool or install" . " Text::Diff to see just the differences."); } else { fail($msg); diag Text::Diff::diff(\$input, \$output, { STYLE => 'Unified' }); } } __DATA__ package utf8::all; use strict; use warnings; use 5.010; # state # ABSTRACT: turn on Unicode - all of it our $VERSION = '0.010'; # VERSION use Import::Into; use parent qw(Encode charnames utf8 open warnings feature); sub import { my $target = caller; 'utf8'->import::into($target); 'open'->import::into($target, qw{:encoding(UTF-8) :std}); 'charnames'->import::into($target, qw{:full :short}); 'warnings'->import::into($target, qw{FATAL utf8}); 'feature'->import::into($target, qw{unicode_strings}) if $^V >= v5.11.0; 'feature'->import::into($target, qw{unicode_eval fc}) if $^V >= v5.16.0; { no strict qw(refs); ## no critic (TestingAndDebugging::ProhibitNoStrict) *{$target . '::readdir'} = \&_utf8_readdir; } # utf8 in @ARGV state $have_encoded_argv = 0; _encode_argv() unless $have_encoded_argv++; $^H{'utf8::all'} = 1; return; } sub _encode_argv { $_ = Encode::decode('UTF-8', $_) for @ARGV; return; } sub _utf8_readdir(*) { ## no critic (Subroutines::ProhibitSubroutinePrototypes) my $handle = shift; if (wantarray) { my @all_files = CORE::readdir($handle); $_ = Encode::decode('UTF-8', $_) for @all_files; return @all_files; } else { my $next_file = CORE::readdir($handle); $next_file = Encode::decode('UTF-8', $next_file); return $next_file; } } 1; __END__ =pod =encoding utf-8 =head1 NAME utf8::all - turn on Unicode - all of it =head1 VERSION version 0.010 =head1 SYNOPSIS use utf8::all; # Turn on UTF-8. All of it. open my $in, '<', 'contains-utf8'; # UTF-8 already turned on here print length 'føø bÄr'; # 7 UTF-8 characters my $utf8_arg = shift @ARGV; # @ARGV is UTF-8 too! =head1 DESCRIPTION L allows you to write your Perl encoded in UTF-8. That means UTF-8 strings, variable names, and regular expressions. C goes further, and makes C<@ARGV> encoded in UTF-8, and filehandles are opened with UTF-8 encoding turned on by default (including STDIN, STDOUT, STDERR), and charnames are imported so C<\N{...}> sequences can be used to compile Unicode characters based on names. If you I want UTF-8 for a particular filehandle, you'll have to set C. The pragma is lexically-scoped, so you can do the following if you had some reason to: { use utf8::all; open my $out, '>', 'outfile'; my $utf8_str = 'føø bÄr'; print length $utf8_str, "\n"; # 7 print $out $utf8_str; # out as utf8 } open my $in, '<', 'outfile'; # in as raw my $text = do { local $/; <$in>}; print length $text, "\n"; # 10, not 7! =head1 INTERACTION WITH AUTODIE If you use L, which is a great idea, you need to use at least version B<2.12>, released on L. Otherwise, autodie obliterates the IO layers set by the L pragma. See L and L. =head1 AVAILABILITY The project homepage is L. The latest version of this module is available from the Comprehensive Perl Archive Network (CPAN). Visit L to find a CPAN site near you, or see L. =head1 SOURCE The development version is on github at L and may be cloned from L =head1 BUGS AND LIMITATIONS You can make new bug reports, and view existing ones, through the web interface at L. =head1 AUTHORS =over 4 =item * Michael Schwern =item * Mike Doherty =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2009 by Michael Schwern . This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Pod-Simple-3.45/t/fornot.t0000644000175000017500000001217414243763554013543 0ustar khwkhwuse strict; use warnings; use Test::More tests => 19; #use Pod::Simple::Debug (5); BEGIN { require FindBin; unshift @INC, $FindBin::Bin . '/lib'; } use helpers; use Pod::Simple::DumpAsXML; use Pod::Simple::XMLOutStream; print "# Pod::Simple version $Pod::Simple::VERSION\n"; my $x = 'Pod::Simple::XMLOutStream'; $Pod::Simple::XMLOutStream::ATTR_PAD = ' '; $Pod::Simple::XMLOutStream::SORT_ATTRS = 1; # for predictably testable output sub moj {shift->accept_target( 'mojojojo')} sub mojtext {shift->accept_target_as_text('mojojojo')} sub any {shift->accept_target( '*' )} #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ is( $x->_out( "=pod\n\nI like pie.\n\n=for mojojojo stuff\n\n=for !mojojojo bzarcho\n\nYup.\n"), 'I like pie.bzarchoYup.' ); is( $x->_out( "=pod\n\nI like pie.\n\n=for psketti,mojojojo,crunk stuff\n\n=for !psketti,mojojojo,crunk bzarcho\n\nYup.\n"), 'I like pie.bzarchoYup.' ); is( $x->_out( "=pod\n\nI like pie.\n\n=for :mojojojo stuff\n\n=for :!mojojojo bzarcho\n\nYup.\n"), 'I like pie.bzarchoYup.' ); is( $x->_out( "=pod\n\nI like pie.\n\n=for :psketti,mojojojo,crunk stuff\n\n=for :!psketti,mojojojo,crunk bzarcho\n\nYup.\n"), 'I like pie.bzarchoYup.' ); is( $x->_out( "=pod\n\nI like pie.\n\n=for :mojojojo stuff\n\n=for :!mojojojo I\n\nYup.\n"), 'I like pie.bzarchoYup.' ); is( $x->_out( "=pod\n\nI like pie.\n\n=for :psketti,mojojojo,crunk stuff\n\n=for :!psketti,mojojojo,crunk I\n\nYup.\n"), 'I like pie.bzarchoYup.' ); print "# ( Now just swapping '!' and ':' )\n"; is( $x->_out( "=pod\n\nI like pie.\n\n=for :mojojojo stuff\n\n=for !:mojojojo bzarcho\n\nYup.\n"), 'I like pie.bzarchoYup.' ); is( $x->_out( "=pod\n\nI like pie.\n\n=for :psketti,mojojojo,crunk stuff\n\n=for !:psketti,mojojojo,crunk bzarcho\n\nYup.\n"), 'I like pie.bzarchoYup.' ); print "# Testing accept_target ...\n"; is( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=for !mojojojo I\n\nYup.\n"), 'I like pie.Yup.' ); is( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=for !psketti,mojojojo,crunk I\n\nYup.\n"), 'I like pie.Yup.' ); is( $x->_out( \&moj, "=pod\n\nI like pie.\n\n=for :!mojojojo I\n\nYup.\n"), 'I like pie.Yup.' ); print "# Testing accept_target_as_text ...\n"; is( $x->_out( \&mojtext, "=pod\n\nI like pie.\n\n=for !mojojojo I\n\nYup.\n"), 'I like pie.Yup.' ); is( $x->_out( \&mojtext, "=pod\n\nI like pie.\n\n=for !psketti,mojojojo,crunk I\n\nYup.\n"), 'I like pie.Yup.' ); is( $x->_out( \&mojtext, "=pod\n\nI like pie.\n\n=for :!mojojojo I\n\nYup.\n"), 'I like pie.Yup.' ); print "# Testing accept_target(*) ...\n"; is( $x->_out( \&any, "=pod\n\nI like pie.\n\n=for !mojojojo I\n\nYup.\n"), 'I like pie.I<stuff>Yup.' ); is( $x->_out( \&any, "=pod\n\nI like pie.\n\n=for !mojojojo I\n\nYup.\n"), 'I like pie.I<stuff>Yup.' ); is( $x->_out( \&any, "=pod\n\nI like pie.\n\n=for !psketti,mojojojo,crunk I\n\nYup.\n"), 'I like pie.I<stuff>Yup.' ); is( $x->_out( \&any, "=pod\n\nI like pie.\n\n=for !:mojojojo I\n\nYup.\n"), 'I like pie.stuffYup.' ); is( $x->_out( \&any, "=pod\n\nI like pie.\n\n=for !:psketti,mojojojo,crunk I\n\nYup.\n"), 'I like pie.stuffYup.' ); Pod-Simple-3.45/t/itemstar.t0000644000175000017500000000303714243763554014062 0ustar khwkhwuse strict; use warnings; use Test::More tests => 4; BEGIN { require FindBin; unshift @INC, $FindBin::Bin . '/lib'; require helpers; helpers->import; } #my $d; #use Pod::Simple::Debug (3); use Pod::Simple::DumpAsXML; use Pod::Simple::XMLOutStream; print "# Pod::Simple version $Pod::Simple::VERSION\n"; my $x = 'Pod::Simple::XMLOutStream'; print "##### Tests for '=item * Foo' tolerance via class $x\n"; $Pod::Simple::XMLOutStream::ATTR_PAD = ' '; $Pod::Simple::XMLOutStream::SORT_ATTRS = 1; # for predictably testable output print "#\n# Tests for simple =item *'s\n"; ok( $x->_out("\n=over\n\n=item * Stuff\n\n=item * Bar I!\n\n=back\n\n"), 'StuffBar baz!' ); ok( $x->_out("\n=over\n\n=item * Stuff\n\n=cut\n\nStuff\n\n=item *\n\nBar I!\n\n=back\n\n"), 'StuffBar baz!' ); ok( $x->_out("\n=over 10\n\n=item * Stuff\n\n=cut\n\nStuff\n\n=item *\n\nBar I!\n\n=back\n\n"), 'StuffBar baz!' ); ok( $x->_out("\n=over\n\n=item * Stuff I hoo!\n=cut\nStuff\n\n=item *\n\nBar I!\n\n=back"), 'Stuff things um hoo!Bar baz!' ); Pod-Simple-3.45/t/cbacks.t0000644000175000017500000000411314243763554013454 0ustar khwkhwuse strict; use warnings; use Test::More tests => 6; my $d; #use Pod::Simple::Debug (\$d, 0); use Pod::Simple::XMLOutStream; use Pod::Simple::DumpAsXML; use Pod::Simple::DumpAsText; my @from = ( 'Pod::Simple::XMLOutStream' => 'I LIKE PIE', 'Pod::Simple::DumpAsXML' => "\n \n I LIKE PIE\n \n\n", 'Pod::Simple::DumpAsText' => "++Document\n ++head1\n * \"I LIKE PIE\"\n --head1\n--Document\n", ); # Might as well test all the classes... while(@from) { my($x => $expected) = splice(@from, 0,2); my $more = ''; print "#Testing via class $x, version ", $x->VERSION(), "\n"; my $p = $x->new; my($got, $exp); is scalar($got = $x->_out( # Mutor: sub { $_[0]->code_handler(sub { $more .= $_[1] . ":" . $_[0] . "\n" } ); $_[0]->cut_handler( sub { $more .= "~" . $_[1] . ":" . $_[0]. "\n" } ); $_[0]->pod_handler( sub { $more .= "+" . $_[1] . ":" . $_[0]. "\n" } ); $_[0]->whiteline_handler( sub { $more .= "=" . $_[1] . ":" . $_[0]. "\n" } ); } => join "\n", " ", # space outside pod "\t# This is handy...", "=pod text", "\t", # tab inside pod "=cut more text", "\t", # tab outside pod "=pod", " \t ", # spaces and tabs inside pod "=head1 I LIKE PIE", " ", # space inside pod "=cut", "use Test::Harness;", "runtests(sort glob 't/*.t');", "", "", )) => scalar($exp = $expected); ; unless($got eq $exp) { print '# Got vs exp:\n# ', Pod::Simple::BlackBox::pretty($got), "\n# ",Pod::Simple::BlackBox::pretty($exp),"\n"; } is scalar($got = $more), scalar($exp = join "\n" => "1: ", "2:\t# This is handy...", "=4:\t", "+3:=pod text", "~5:=cut more text", "6:\t", "=8: \t ", "+7:=pod", "=10: ", "~11:=cut", "12:use Test::Harness;", "13:runtests(sort glob 't/*.t');", "14:", "", ); unless($got eq $exp) { print '# Got vs exp:\n# ', Pod::Simple::BlackBox::pretty($got), "\n# ",Pod::Simple::BlackBox::pretty($exp),"\n"; } } Pod-Simple-3.45/t/render.t0000644000175000017500000000601414243763554013507 0ustar khwkhwuse strict; use warnings; use Test::More tests => 25; use Pod::Simple::TextContent; use Pod::Simple::Text; BEGIN { *mytime = defined(&Win32::GetTickCount) ? sub () {Win32::GetTickCount() / 1000} : sub () {time()} } $Pod::Simple::Text::FREAKYMODE = 1; use Pod::Simple::TiedOutFH (); use File::Spec; use Cwd (); use File::Basename (); my $outfile = '10000'; foreach my $file ( "junk1.pod", "junk2.pod", "perlcyg.pod", "perlfaq.pod", "perlvar.pod", ) { my $full_file = File::Spec->catfile(File::Basename::dirname(Cwd::abs_path(__FILE__)), $file); unless(-e $full_file) { ok 0; print "# But $full_file doesn't exist!!\n"; next; } my @out; my $precooked = $full_file; $precooked =~ s<\.pod>s; unless(-e $precooked) { ok 0; print "# But $precooked doesn't exist!!\n"; exit 1; } print "#\n#\n#\n###################\n# $file\n"; foreach my $class ('Pod::Simple::TextContent', 'Pod::Simple::Text') { my $p = $class->new; push @out, ''; $p->output_string(\$out[-1]); my $t = mytime(); $p->parse_file($full_file); printf "# %s %s %sb, %.03fs\n", ref($p), $full_file, length($out[-1]), mytime() - $t ; ok 1; } print "# Reading $precooked...\n"; open(IN, $precooked) or die "Can't read-open $precooked: $!"; { local $/; push @out, ; } close(IN); print "# ", length($out[-1]), " bytes pulled in.\n"; for (@out) { s/\s+/ /g; s/^\s+//s; s/\s+$//s; } my $faily = 0; print "#\n#Now comparing 1 and 2...\n"; $faily += compare2($out[0], $out[1]); print "#\n#Now comparing 2 and 3...\n"; $faily += compare2($out[1], $out[2]); print "#\n#Now comparing 1 and 3...\n"; $faily += compare2($out[0], $out[2]); if($faily) { ++$outfile; my @outnames = map $outfile . $_ , qw(0 1); open(OUT2, ">$outnames[0].txt") || die "Can't write-open $outnames[0].txt: $!"; foreach my $out (@out) { push @outnames, $outnames[-1]; ++$outnames[-1] }; pop @outnames; printf "# Writing to %s.txt .. %s.txt\n", $outnames[0], $outnames[-1]; shift @outnames; binmode(OUT2); foreach my $out (@out) { my $outname = shift @outnames; open(OUT, ">$outname.txt") || die "Can't write-open $outname.txt: $!"; binmode(OUT); print OUT $out, "\n"; print OUT2 $out, "\n"; close(OUT); } close(OUT2); } } sub compare2 { my @out = @_; if($out[0] eq $out[1]) { ok 1; return 0; } elsif( do{ for ($out[0], $out[1]) { tr/ //d; }; $out[0] eq $out[1]; }){ print "# Differ only in whitespace.\n"; ok 1; return 0; } else { #ok $out[0], $out[1]; my $x = $out[0] ^ $out[1]; $x =~ m/^(\x00*)/s or die; my $at = length($1); print "# Difference at byte $at...\n"; if($at > 10) { $at -= 5; } { print "# ", substr($out[0],$at,20), "\n"; print "# ", substr($out[1],$at,20), "\n"; print "# ^..."; } ok 0; printf "# Unequal lengths %s and %s\n", length($out[0]), length($out[1]); return 1; } } Pod-Simple-3.45/t/emptylists.t0000644000175000017500000000241314243763554014444 0ustar khwkhwuse strict; use warnings; use Test::More tests => 3; use Pod::Simple::XMLOutStream; print "# Pod::Simple version $Pod::Simple::VERSION\n"; my $x = 'Pod::Simple::XMLOutStream'; $Pod::Simple::XMLOutStream::ATTR_PAD = ' '; $Pod::Simple::XMLOutStream::SORT_ATTRS = 1; # for predictably testable output sub on {shift->parse_empty_lists(1)} sub off {shift->parse_empty_lists(0)} my $pod = <_out($pod), '' ); print "# Testing explicit parse_empty_lists( FALSE ) ...\n"; is( $x->_out(\&off, $pod), '' ); print "# Testing parse_empty_lists( TRUE ) ...\n"; is( $x->_out(\&on, $pod), '' ); Pod-Simple-3.45/t/accept01.t0000644000175000017500000000501014243763554013623 0ustar khwkhw# Testing accept_codes use strict; use warnings; use Test::More tests => 11; #use Pod::Simple::Debug (6); use Pod::Simple::DumpAsXML; use Pod::Simple::XMLOutStream; print "# Pod::Simple version $Pod::Simple::VERSION\n"; BEGIN { require FindBin; unshift @INC, $FindBin::Bin . '/lib'; } use helpers; my $x = 'Pod::Simple::XMLOutStream'; sub accept_N { $_[0]->accept_codes('N') } print "# Some sanity tests...\n"; is( $x->_out( "=pod\n\nI like pie.\n"), # without acceptor 'I like pie.' ); is( $x->_out( \&accept_N, "=pod\n\nI like pie.\n"), 'I like pie.' ); is( $x->_out( "=pod\n\nB\n"), # without acceptor 'foo ' ); is( $x->_out( \&accept_N, "=pod\n\nB\n"), 'foo ' ); print "# Some real tests...\n"; is( $x->_out( \&accept_N, "=pod\n\nN\n"), 'foo ' ); is( $x->_out( \&accept_N, "=pod\n\nB>\n"), 'foo ' ); isnt( $x->_out( "=pod\n\nB>\n"), # without the mutor 'foo ' # make sure it DOESN'T pass thru the N<...> when not accepted ); is( $x->_out( \&accept_N, "=pod\n\nBNI>\n"), 'piezorchfoopling' ); print "# Tests of nonacceptance...\n"; sub starts_with { my($large, $small) = @_; print("# supahstring is undef\n"), return '' unless defined $large; print("# supahstring $large is smaller than target-starter $small\n"), return '' if length($large) < length($small); if( substr($large, 0, length($small)) eq $small ) { #print "# Supahstring $large\n# indeed starts with $small\n"; return 1; } else { print "# Supahstring $large\n# !starts w/ $small\n"; return ''; } } ok( starts_with( $x->_out( "=pod\n\nB>\n"), # without the mutor 'foo ' # make sure it DOESN'T pass thru the N<...>, when not accepted )); ok( starts_with( $x->_out( "=pod\n\nBNI>\n"), # !mutor 'piezorchfoopling' # make sure it DOESN'T pass thru the N<...>, when not accepted )); ok( starts_with( $x->_out( "=pod\n\nBN>I>\n"), # !mutor 'piezorchfoopling' # make sure it DOESN'T pass thru the N<...>, when not accepted )); Pod-Simple-3.45/t/search29.t0000644000175000017500000000201614243763554013646 0ustar khwkhwuse strict; use warnings; use Pod::Simple::Search; use Test::More tests => 2; print "# ", __FILE__, ": Testing limit_glob ...\n"; my $x = Pod::Simple::Search->new; die "Couldn't make an object!?" unless ok defined $x; $x->inc(0); $x->shadows(1); use File::Spec; use Cwd (); use File::Basename (); my $t_dir = File::Basename::dirname(Cwd::abs_path(__FILE__)); my $here1 = File::Spec->catdir($t_dir, 'testlib1'); my $here2 = File::Spec->catdir($t_dir, 'testlib2'); my $here3 = File::Spec->catdir($t_dir, 'testlib3'); print "# OK, found the test corpora\n# as $here1\n# and $here2\n# and $here3\n#\n"; print $x->_state_as_string; #$x->verbose(12); use Pod::Simple; *pretty = \&Pod::Simple::BlackBox::pretty; my $glob = '*z?k*'; print "# Limiting to $glob\n"; $x->limit_glob($glob); my($name2where, $where2name) = $x->survey($here1, $here2, $here3); my $p = pretty( $where2name, $name2where )."\n"; $p =~ s/, +/,\n/g; $p =~ s/^/# /mg; print $p; { my $names = join "|", sort values %$where2name; is $names, "perlzuk|zikzik"; } Pod-Simple-3.45/t/html02.t0000644000175000017500000000124114243763554013333 0ustar khwkhw# Testing HTML text styles use strict; use warnings; use Test::More tests => 6; #use Pod::Simple::Debug (10); use Pod::Simple::HTML; sub x { Pod::Simple::HTML->_out( sub{ $_[0]->bare_output(1) }, "=pod\n\n$_[0]", ) } ok 1; my @pairs = ( [ "I" => qq{\n

    italicized

    \n} ], [ 'B' => qq{\n

    bolded

    \n} ], [ 'C' => qq{\n

    code

    \n} ], [ 'F' => qq{\n

    /tmp/foo

    \n} ], [ 'F' => qq{\n

    /tmp/foo

    \n} ], ); foreach( @pairs ) { print "# Testing pod source $$_[0] ...\n" unless $_->[0] =~ m/\n/; is( x($_->[0]), $_->[1] ) } Pod-Simple-3.45/t/eol2.t0000644000175000017500000000402614243763540013065 0ustar khwkhw# t/eol2.t - check handling of \r, \n, and \r\n as line separators (again) use strict; use warnings; use Test::More tests => 7; use_ok('Pod::Simple::XHTML') or exit; open(POD, ">$$.pod") or die "$$.pod: $!"; print POD <<__EOF__; =pod =head1 NAME crlf =head1 DESCRIPTION crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf =cut __EOF__ close(POD); # --- CR --- my $p1 = Pod::Simple::XHTML->new (); isa_ok ($p1, 'Pod::Simple::XHTML'); open(POD, "<$$.pod") or die "$$.pod: $!"; my $i1 = ''; while () { s/[\r\n]+/\r/g; $i1 .= $_; } close(POD); $p1->output_string(\my $o1); $p1->parse_string_document($i1); # --- LF --- my $p2 = Pod::Simple::XHTML->new (); isa_ok ($p2, 'Pod::Simple::XHTML'); open(POD, "<$$.pod") or die "$$.pod: $!"; my $i2 = ''; while () { s/[\r\n]+/\n/g; $i2 .= $_; } close(POD); $p2->output_string(\my $o2); $p2->parse_string_document($i2); # --- CRLF --- my $p3 = Pod::Simple::XHTML->new (); isa_ok ($p3, 'Pod::Simple::XHTML'); open(POD, "<$$.pod") or die "$$.pod: $!"; my $i3 = ''; while () { s/[\r\n]+/\r\n/g; $i3 .= $_; } close(POD); $p3->output_string(\my $o3); $p3->parse_string_document($i3); # --- now test --- my $cksum1 = unpack("%32C*", $o1); my $cksum2 = unpack("%32C*", $o2); my $cksum3 = unpack("%32C*", $o3); ok($cksum1 == $cksum2, "CR vs LF"); ok($cksum1 == $cksum3, "CR vs CRLF"); ok($cksum2 == $cksum3, "LF vs CRLF"); END { 1 while unlink("$$.pod", "$$.in"); } Pod-Simple-3.45/MANIFEST.SKIP0000644000175000017500000000201014243754137013463 0ustar khwkhw#!start included /usr/local/lib/perl5/5.10.1/ExtUtils/MANIFEST.SKIP # Avoid version control files. \bRCS\b \bCVS\b \bSCCS\b ,v$ \B\.svn\b \B\.git\b \B\.github\b \B\.gitignore\b \b_darcs\b \B\.cvsignore$ # Avoid VMS specific MakeMaker generated files \bDescrip.MMS$ \bDESCRIP.MMS$ \bdescrip.mms$ # Avoid Makemaker generated and utility files. \bMANIFEST\.bak \bMakefile$ \bblib/ \bMakeMaker-\d \bpm_to_blib\.ts$ \bpm_to_blib$ \bblibdirs\.ts$ # 6.18 through 6.25 generated this # Avoid Module::Build generated and utility files. \bBuild$ \b_build/ \bBuild.bat$ \bBuild.COM$ \bBUILD.COM$ \bbuild.com$ # Avoid temp and backup files. ~$ \.old$ \#$ \b\.# \.bak$ \.tmp$ \.# \.rej$ \.travis.yml # Avoid OS-specific files/dirs # Mac OSX metadata \B\.DS_Store # Mac OSX SMB mount metadata files \B\._ # Avoid Devel::Cover files. \bcover_db\b #!end included /usr/local/lib/perl5/5.10.1/ExtUtils/MANIFEST.SKIP ^Pod-Simple ^[-_a-zA-Z0-9]+[0-9]+\.[0-9]+(?:_[0-9]+)?$ \.out$ delme \.rej$ \..*\.sw.?$ ~ ^MYMETA\.yml$ ^MYMETA\.json$ Pod-Simple-3.45/Makefile.PL0000644000175000017500000000526614243763543013560 0ustar khwkhw# This -*- perl -*- script writes the Makefile for Pod::Simple # # Time-stamp: "2004-05-24 00:21:20 ADT" # # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. # require 5; use strict; use ExtUtils::MakeMaker; my %WriteMakefileArgs = ( NAME => 'Pod::Simple', VERSION_FROM => 'lib/Pod/Simple.pm', ABSTRACT_FROM => 'lib/Pod/Simple.pod', TEST_REQUIRES => { 'Test::More' => '0.88' }, PREREQ_PM => { 'Carp' => 0, 'Config' => 0, 'Cwd' => 0, 'File::Basename' => 0, 'File::Find' => 0, 'File::Spec' => 0, 'Pod::Escapes' => '1.04', 'Symbol' => 0, 'Text::Wrap' => '98.112902', 'if' => 0, 'integer' => 0, 'overload' => 0, 'strict' => 0, }, INSTALLDIRS => $] >= 5.009003 && $] <= 5.011000 ? 'perl' : 'site', LICENSE => 'perl', AUTHOR => 'Allison Randal ', META_MERGE => { "meta-spec" => { version => 2 }, resources => { homepage => 'https://metacpan.org/pod/Pod::Simple', license => 'http://dev.perl.org/licenses/', repository => { url => 'https://github.com/perl-pod/pod-simple.git', web => 'https://github.com/perl-pod/pod-simple', type => 'git', }, bugtracker => { web => 'https://github.com/perl-pod/pod-simple/issues', mailto => 'bug-pod-simple@rt.cpan.org', }, x_MailingList => 'https://lists.perl.org/list/pod-people.html', }, prereqs => { runtime => { recommends => { 'Encode' => '2.78', # Pod::Simple's new default code page (1252) is # pre-compiled in 2.78, which improves performance. }, }, }, }, ); unless ( eval { ExtUtils::MakeMaker->VERSION('6.63_03') } ) { $WriteMakefileArgs{BUILD_REQUIRES} = { %{ delete $WriteMakefileArgs{TEST_REQUIRES} || {} }, %{ $WriteMakefileArgs{BUILD_REQUIRES} || {} }, }; } unless ( eval { ExtUtils::MakeMaker->VERSION('6.55_01') } ) { $WriteMakefileArgs{PREREQ_PM} = { %{ delete $WriteMakefileArgs{BUILD_REQUIRES} || {} }, %{ $WriteMakefileArgs{PREREQ_PM} || {} }, }; } WriteMakefile(%WriteMakefileArgs); package MY; sub libscan { # Determine things that should *not* be installed my ( $self, $path ) = @_; return '' if $path =~ m/~/; $path; } __END__ Pod-Simple-3.45/lib/0000755000175000017500000000000014430216375012335 5ustar khwkhwPod-Simple-3.45/lib/Pod/0000755000175000017500000000000014430216375013057 5ustar khwkhwPod-Simple-3.45/lib/Pod/Simple.pod0000644000175000017500000003545414427236532015032 0ustar khwkhw =head1 NAME Pod::Simple - framework for parsing Pod =head1 SYNOPSIS TODO =head1 DESCRIPTION Pod::Simple is a Perl library for parsing text in the Pod ("plain old documentation") markup language that is typically used for writing documentation for Perl and for Perl modules. The Pod format is explained in L; the most common formatter is called C. Be sure to read L if your Pod contains non-ASCII characters. Pod formatters can use Pod::Simple to parse Pod documents and render them into plain text, HTML, or any number of other formats. Typically, such formatters will be subclasses of Pod::Simple, and so they will inherit its methods, like C. But note that Pod::Simple doesn't understand and properly parse Perl itself, so if you have a file which contains a Perl program that has a multi-line quoted string which has lines that look like pod, Pod::Simple will treat them as pod. This can be avoided if the file makes these into indented here documents instead. If you're reading this document just because you have a Pod-processing subclass that you want to use, this document (plus the documentation for the subclass) is probably all you need to read. If you're reading this document because you want to write a formatter subclass, continue reading it and then read L, and then possibly even read L (some of which is for parser-writers, but much of which is notes to formatter-writers). =head1 MAIN METHODS =over =item C<< $parser = I->new(); >> This returns a new parser object, where I> is a subclass of Pod::Simple. =item C<< $parser->output_fh( *OUT ); >> This sets the filehandle that C<$parser>'s output will be written to. You can pass C<*STDOUT> or C<*STDERR>, otherwise you should probably do something like this: my $outfile = "output.txt"; open TXTOUT, ">$outfile" or die "Can't write to $outfile: $!"; $parser->output_fh(*TXTOUT); ...before you call one of the C<< $parser->parse_I >> methods. =item C<< $parser->output_string( \$somestring ); >> This sets the string that C<$parser>'s output will be sent to, instead of any filehandle. =item C<< $parser->parse_file( I<$some_filename> ); >> =item C<< $parser->parse_file( *INPUT_FH ); >> This reads the Pod content of the file (or filehandle) that you specify, and processes it with that C<$parser> object, according to however C<$parser>'s class works, and according to whatever parser options you have set up for this C<$parser> object. =item C<< $parser->parse_string_document( I<$all_content> ); >> This works just like C except that it reads the Pod content not from a file, but from a string that you have already in memory. =item C<< $parser->parse_lines( I<...@lines...>, undef ); >> This processes the lines in C<@lines> (where each list item must be a defined value, and must contain exactly one line of content -- so no items like C<"foo\nbar"> are allowed). The final C is used to indicate the end of document being parsed. The other C> methods are meant to be called only once per C<$parser> object; but C can be called as many times per C<$parser> object as you want, as long as the last call (and only the last call) ends with an C value. =item C<< $parser->content_seen >> This returns true only if there has been any real content seen for this document. Returns false in cases where the document contains content, but does not make use of any Pod markup. =item C<< I->filter( I<$filename> ); >> =item C<< I->filter( I<*INPUT_FH> ); >> =item C<< I->filter( I<\$document_content> ); >> This is a shortcut method for creating a new parser object, setting the output handle to STDOUT, and then processing the specified file (or filehandle, or in-memory document). This is handy for one-liners like this: perl -MPod::Simple::Text -e "Pod::Simple::Text->filter('thingy.pod')" =back =head1 SECONDARY METHODS Some of these methods might be of interest to general users, as well as of interest to formatter-writers. Note that the general pattern here is that the accessor-methods read the attribute's value with C<< $value = $parser->I >> and set the attribute's value with C<< $parser->I(I) >>. For each accessor, I typically only mention one syntax or another, based on which I think you are actually most likely to use. =over =item C<< $parser->parse_characters( I ) >> The Pod parser normally expects to read octets and to convert those octets to characters based on the C<=encoding> declaration in the Pod source. Set this option to a true value to indicate that the Pod source is already a Perl character stream. This tells the parser to ignore any C<=encoding> command and to skip all the code paths involving decoding octets. =item C<< $parser->no_whining( I ) >> If you set this attribute to a true value, you will suppress the parser's complaints about irregularities in the Pod coding. By default, this attribute's value is false, meaning that irregularities will be reported. Note that turning this attribute to true won't suppress one or two kinds of complaints about rarely occurring unrecoverable errors. =item C<< $parser->no_errata_section( I ) >> If you set this attribute to a true value, you will stop the parser from generating a "POD ERRORS" section at the end of the document. By default, this attribute's value is false, meaning that an errata section will be generated, as necessary. =item C<< $parser->complain_stderr( I ) >> If you set this attribute to a true value, it will send reports of parsing errors to STDERR. By default, this attribute's value is false, meaning that no output is sent to STDERR. Setting C also sets C. =item C<< $parser->source_filename >> This returns the filename that this parser object was set to read from. =item C<< $parser->doc_has_started >> This returns true if C<$parser> has read from a source, and has seen Pod content in it. =item C<< $parser->source_dead >> This returns true if C<$parser> has read from a source, and come to the end of that source. =item C<< $parser->strip_verbatim_indent( I ) >> The perlpod spec for a Verbatim paragraph is "It should be reproduced exactly...", which means that the whitespace you've used to indent your verbatim blocks will be preserved in the output. This can be annoying for outputs such as HTML, where that whitespace will remain in front of every line. It's an unfortunate case where syntax is turned into semantics. If the POD you're parsing adheres to a consistent indentation policy, you can have such indentation stripped from the beginning of every line of your verbatim blocks. This method tells Pod::Simple what to strip. For two-space indents, you'd use: $parser->strip_verbatim_indent(' '); For tab indents, you'd use a tab character: $parser->strip_verbatim_indent("\t"); If the POD is inconsistent about the indentation of verbatim blocks, but you have figured out a heuristic to determine how much a particular verbatim block is indented, you can pass a code reference instead. The code reference will be executed with one argument, an array reference of all the lines in the verbatim block, and should return the value to be stripped from each line. For example, if you decide that you're fine to use the first line of the verbatim block to set the standard for indentation of the rest of the block, you can look at the first line and return the appropriate value, like so: $new->strip_verbatim_indent(sub { my $lines = shift; (my $indent = $lines->[0]) =~ s/\S.*//; return $indent; }); If you'd rather treat each line individually, you can do that, too, by just transforming them in-place in the code reference and returning C. Say that you don't want I lines indented. You can do something like this: $new->strip_verbatim_indent(sub { my $lines = shift; sub { s/^\s+// for @{ $lines }, return undef; }); =item C<< $parser->expand_verbatim_tabs( I ) >> Default: 8 If after any stripping of indentation in verbatim blocks, there remain tabs, this method call indicates what to do with them. C<0> means leave them as tabs, any other number indicates that each tab is to be translated so as to have tab stops every C columns. This is independent of other methods (except that it operates after any verbatim input stripping is done). Like the other methods, the input parameter is not checked for validity. C or containing non-digits has the same effect as 8. =back =head1 TERTIARY METHODS =over =item C<< $parser->abandon_output_fh() >>X Cancel output to the file handle. Any POD read by the C<$parser> is not effected. =item C<< $parser->abandon_output_string() >>X Cancel output to the output string. Any POD read by the C<$parser> is not effected. =item C<< $parser->accept_code( @codes ) >>X Alias for L<< accept_codes >>. =item C<< $parser->accept_codes( @codes ) >>X Allows C<$parser> to accept a list of L. This can be used to implement user-defined codes. =item C<< $parser->accept_directive_as_data( @directives ) >>X Allows C<$parser> to accept a list of directives for data paragraphs. A directive is the label of a L. A data paragraph is one delimited by C<< =begin/=for/=end >> directives. This can be used to implement user-defined directives. =item C<< $parser->accept_directive_as_processed( @directives ) >>X Allows C<$parser> to accept a list of directives for processed paragraphs. A directive is the label of a L. A processed paragraph is also known as L. This can be used to implement user-defined directives. =item C<< $parser->accept_directive_as_verbatim( @directives ) >>X Allows C<$parser> to accept a list of directives for L. A directive is the label of a L. This can be used to implement user-defined directives. =item C<< $parser->accept_target( @targets ) >>X Alias for L<< accept_targets >>. =item C<< $parser->accept_target_as_text( @targets ) >>X Alias for L<< accept_targets_as_text >>. =item C<< $parser->accept_targets( @targets ) >>X Accepts targets for C<< =begin/=for/=end >> sections of the POD. =item C<< $parser->accept_targets_as_text( @targets ) >>X Accepts targets for C<< =begin/=for/=end >> sections that should be parsed as POD. For details, see L<< perlpodspec/About Data Paragraphs >>. =item C<< $parser->any_errata_seen() >>X Used to check if any errata was seen. I die "too many errors\n" if $parser->any_errata_seen(); =item C<< $parser->errata_seen() >>X Returns a hash reference of all errata seen, both whines and screams. The hash reference's keys are the line number and the value is an array reference of the errors for that line. I if ( $parser->any_errata_seen() ) { $logger->log( $parser->errata_seen() ); } =item C<< $parser->detected_encoding() >>X Return the encoding corresponding to C<< =encoding >>, but only if the encoding was recognized and handled. =item C<< $parser->encoding() >>X Return encoding of the document, even if the encoding is not correctly handled. =item C<< $parser->parse_from_file( $source, $to ) >>X Parses from C<$source> file to C<$to> file. Similar to L<< Pod::Parser/parse_from_file >>. =item C<< $parser->scream( @error_messages ) >>X Log an error that can't be ignored. =item C<< $parser->unaccept_code( @codes ) >>X Alias for L<< unaccept_codes >>. =item C<< $parser->unaccept_codes( @codes ) >>X Removes C<< @codes >> as valid codes for the parse. =item C<< $parser->unaccept_directive( @directives ) >>X Alias for L<< unaccept_directives >>. =item C<< $parser->unaccept_directives( @directives ) >>X Removes C<< @directives >> as valid directives for the parse. =item C<< $parser->unaccept_target( @targets ) >>X Alias for L<< unaccept_targets >>. =item C<< $parser->unaccept_targets( @targets ) >>X Removes C<< @targets >> as valid targets for the parse. =item C<< $parser->version_report() >>X Returns a string describing the version. =item C<< $parser->whine( @error_messages ) >>X Log an error unless C<< $parser->no_whining( TRUE ); >>. =back =head1 ENCODING The Pod::Simple parser expects to read B. The parser will decode the octets into Perl's internal character string representation using the value of the C<=encoding> declaration in the POD source. If the POD source does not include an C<=encoding> declaration, the parser will attempt to guess the encoding (selecting one of UTF-8 or CP 1252) by examining the first non-ASCII bytes and applying the heuristic described in L. (If the POD source contains only ASCII bytes, the encoding is assumed to be ASCII.) If you set the C option to a true value the parser will expect characters rather than octets; will ignore any C<=encoding>; and will make no attempt to decode the input. =head1 SEE ALSO L L L L L =head1 SUPPORT Questions or discussion about POD and Pod::Simple should be sent to the pod-people@perl.org mail list. Send an empty email to pod-people-subscribe@perl.org to subscribe. This module is managed in an open GitHub repository, L. Feel free to fork and contribute, or to clone L and send patches! Please use L to file a bug report. =head1 COPYRIGHT AND DISCLAIMERS Copyright (c) 2002 Sean M. Burke. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. This program is distributed in the hope that it will be useful, but without any warranty; without even the implied warranty of merchantability or fitness for a particular purpose. =head1 AUTHOR Pod::Simple was created by Sean M. Burke . But don't bother him, he's retired. Pod::Simple is maintained by: =over =item * Allison Randal C =item * Hans Dieter Pearcey C =item * David E. Wheeler C =item * Karl Williamson C =back Documentation has been contributed by: =over =item * Gabor Szabo C =item * Shawn H Corey C =back =cut Pod-Simple-3.45/lib/Pod/Simple.pm0000644000175000017500000015216114427237107014656 0ustar khwkhwpackage Pod::Simple; use strict; use warnings; use Carp (); BEGIN { *DEBUG = sub () {0} unless defined &DEBUG } use integer; use Pod::Escapes 1.04 (); use Pod::Simple::LinkSection (); use Pod::Simple::BlackBox (); use Pod::Simple::TiedOutFH; #use utf8; our @ISA = ('Pod::Simple::BlackBox'); our $VERSION = '3.45'; our @Known_formatting_codes = qw(I B C L E F S X Z); our %Known_formatting_codes = map(($_=>1), @Known_formatting_codes); our @Known_directives = qw(head1 head2 head3 head4 head5 head6 item over back); our %Known_directives = map(($_=>'Plain'), @Known_directives); our $NL = $/ unless defined $NL; #----------------------------------------------------------------------------- # Set up some constants: BEGIN { if(defined &ASCII) { } elsif(chr(65) eq 'A') { *ASCII = sub () {1} } else { *ASCII = sub () {''} } unless(defined &MANY_LINES) { *MANY_LINES = sub () {20} } DEBUG > 4 and print STDERR "MANY_LINES is ", MANY_LINES(), "\n"; unless(MANY_LINES() >= 1) { die "MANY_LINES is too small (", MANY_LINES(), ")!\nAborting"; } if(defined &UNICODE) { } elsif($] >= 5.008) { *UNICODE = sub() {1} } else { *UNICODE = sub() {''} } } if(DEBUG > 2) { print STDERR "# We are ", ASCII ? '' : 'not ', "in ASCII-land\n"; print STDERR "# We are under a Unicode-safe Perl.\n"; } # The NO BREAK SPACE and SOFT HYHPEN are used in several submodules. if ($] ge 5.007_003) { # On sufficiently modern Perls we can handle any # character set $Pod::Simple::nbsp = chr utf8::unicode_to_native(0xA0); $Pod::Simple::shy = chr utf8::unicode_to_native(0xAD); } elsif (Pod::Simple::ASCII) { # Hard code ASCII early Perl $Pod::Simple::nbsp = "\xA0"; $Pod::Simple::shy = "\xAD"; } else { # EBCDIC on early Perl. We know what the values are for the code # pages supported then. $Pod::Simple::nbsp = "\x41"; $Pod::Simple::shy = "\xCA"; } # Design note: # This is a parser for Pod. It is not a parser for the set of Pod-like # languages which happens to contain Pod -- it is just for Pod, plus possibly # some extensions. # @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ #@ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ @ #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ __PACKAGE__->_accessorize( '_output_is_for_JustPod', # For use only by Pod::Simple::JustPod, # If non-zero, don't expand Z<> E<> S<> L<>, # and count how many brackets in format codes 'nbsp_for_S', # Whether to map S<...>'s to \xA0 characters 'source_filename', # Filename of the source, for use in warnings 'source_dead', # Whether to consider this parser's source dead 'output_fh', # The filehandle we're writing to, if applicable. # Used only in some derived classes. 'hide_line_numbers', # For some dumping subclasses: whether to pointedly # suppress the start_line attribute 'line_count', # the current line number 'pod_para_count', # count of pod paragraphs seen so far 'no_whining', # whether to suppress whining 'no_errata_section', # whether to suppress the errata section 'complain_stderr', # whether to complain to stderr 'doc_has_started', # whether we've fired the open-Document event yet 'bare_output', # For some subclasses: whether to prepend # header-code and postpend footer-code 'keep_encoding_directive', # whether to emit =encoding 'nix_X_codes', # whether to ignore X<...> codes 'merge_text', # whether to avoid breaking a single piece of # text up into several events 'preserve_whitespace', # whether to try to keep whitespace as-is 'strip_verbatim_indent', # What indent to strip from verbatim 'expand_verbatim_tabs', # 0: preserve tabs in verbatim blocks # n: expand tabs to stops every n columns 'parse_characters', # Whether parser should expect chars rather than octets 'content_seen', # whether we've seen any real Pod content 'errors_seen', # TODO: document. whether we've seen any errors (fatal or not) 'codes_in_verbatim', # for PseudoPod extensions 'code_handler', # coderef to call when a code (non-pod) line is seen 'cut_handler', # ... when a =cut line is seen 'pod_handler', # ... when a =pod line is seen 'whiteline_handler', # ... when a line with only whitespace is seen #Called like: # $code_handler->($line, $self->{'line_count'}, $self) if $code_handler; # $cut_handler->($line, $self->{'line_count'}, $self) if $cut_handler; # $pod_handler->($line, $self->{'line_count'}, $self) if $pod_handler; # $wl_handler->($line, $self->{'line_count'}, $self) if $wl_handler; 'parse_empty_lists', # whether to acknowledge empty =over/=back blocks 'raw_mode', # to report entire raw lines instead of Pod elements ); #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ sub any_errata_seen { # good for using as an exit() value... return shift->{'errors_seen'} || 0; } sub errata_seen { return shift->{'all_errata'} || {}; } # 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 STDERR " 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 STDERR " (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 { *pretty = \&Pod::Simple::BlackBox::pretty; *stringify_lol = \&Pod::Simple::BlackBox::stringify_lol; *my_qr = \&Pod::Simple::BlackBox::my_qr; } #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ sub version_report { my $class = ref($_[0]) || $_[0]; if($class eq __PACKAGE__) { return "$class $VERSION"; } else { my $v = $class->VERSION; return "$class $v (" . __PACKAGE__ . " $VERSION)"; } } #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ #sub curr_open { # read-only list accessor # return @{ $_[0]{'curr_open'} || return() }; #} #sub _curr_open_listref { $_[0]{'curr_open'} ||= [] } sub output_string { # Works by faking out output_fh. Simplifies our code. # my $this = shift; return $this->{'output_string'} unless @_; # GET. my $x = (defined($_[0]) and ref($_[0])) ? $_[0] : \( $_[0] ); $$x = '' unless defined $$x; DEBUG > 4 and print STDERR "# Output string set to $x ($$x)\n"; $this->{'output_fh'} = Pod::Simple::TiedOutFH->handle_on($_[0]); return $this->{'output_string'} = $_[0]; #${ ${ $this->{'output_fh'} } }; } sub abandon_output_string { $_[0]->abandon_output_fh; delete $_[0]{'output_string'} } sub abandon_output_fh { $_[0]->output_fh(undef) } # These don't delete the string or close the FH -- they just delete our # references to it/them. # TODO: document these #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ sub new { # takes no parameters my $class = ref($_[0]) || $_[0]; #Carp::croak(__PACKAGE__ . " is a virtual base class -- see perldoc " # . __PACKAGE__ ); my $obj = bless { 'accept_codes' => { map( ($_=>$_), @Known_formatting_codes ) }, 'accept_directives' => { %Known_directives }, 'accept_targets' => {}, }, $class; $obj->expand_verbatim_tabs(8); return $obj; } # TODO: an option for whether to interpolate E<...>'s, or just resolve to codes. #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ sub _handle_element_start { # OVERRIDE IN DERIVED CLASS my($self, $element_name, $attr_hash_r) = @_; return; } sub _handle_element_end { # OVERRIDE IN DERIVED CLASS my($self, $element_name) = @_; return; } sub _handle_text { # OVERRIDE IN DERIVED CLASS my($self, $text) = @_; return; } #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ # # And now directives (not targets) sub accept_directive_as_verbatim { shift->_accept_directives('Verbatim', @_) } sub accept_directive_as_data { shift->_accept_directives('Data', @_) } sub accept_directive_as_processed { shift->_accept_directives('Plain', @_) } sub _accept_directives { my($this, $type) = splice @_,0,2; foreach my $d (@_) { next unless defined $d and length $d; Carp::croak "\"$d\" isn't a valid directive name" unless $d =~ m/^[a-zA-Z][a-zA-Z0-9]*$/s; Carp::croak "\"$d\" is already a reserved Pod directive name" if exists $Known_directives{$d}; $this->{'accept_directives'}{$d} = $type; DEBUG > 2 and print STDERR "Learning to accept \"=$d\" as directive of type $type\n"; } DEBUG > 6 and print STDERR "$this\'s accept_directives : ", pretty($this->{'accept_directives'}), "\n"; return sort keys %{ $this->{'accept_directives'} } if wantarray; return; } #-------------------------------------------------------------------------- # TODO: document these: sub unaccept_directive { shift->unaccept_directives(@_) }; sub unaccept_directives { my $this = shift; foreach my $d (@_) { next unless defined $d and length $d; Carp::croak "\"$d\" isn't a valid directive name" unless $d =~ m/^[a-zA-Z][a-zA-Z0-9]*$/s; Carp::croak "But you must accept \"$d\" directives -- it's a builtin!" if exists $Known_directives{$d}; delete $this->{'accept_directives'}{$d}; DEBUG > 2 and print STDERR "OK, won't accept \"=$d\" as directive.\n"; } return sort keys %{ $this->{'accept_directives'} } if wantarray; return } #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ # # And now targets (not directives) sub accept_target { shift->accept_targets(@_) } # alias sub accept_target_as_text { shift->accept_targets_as_text(@_) } # alias sub accept_targets { shift->_accept_targets('1', @_) } sub accept_targets_as_text { shift->_accept_targets('force_resolve', @_) } # forces them to be processed, even when there's no ":". sub _accept_targets { my($this, $type) = splice @_,0,2; foreach my $t (@_) { next unless defined $t and length $t; # TODO: enforce some limitations on what a target name can be? $this->{'accept_targets'}{$t} = $type; DEBUG > 2 and print STDERR "Learning to accept \"$t\" as target of type $type\n"; } return sort keys %{ $this->{'accept_targets'} } if wantarray; return; } #-------------------------------------------------------------------------- sub unaccept_target { shift->unaccept_targets(@_) } sub unaccept_targets { my $this = shift; foreach my $t (@_) { next unless defined $t and length $t; # TODO: enforce some limitations on what a target name can be? delete $this->{'accept_targets'}{$t}; DEBUG > 2 and print STDERR "OK, won't accept \"$t\" as target.\n"; } return sort keys %{ $this->{'accept_targets'} } if wantarray; return; } #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ # # And now codes (not targets or directives) # XXX Probably it is an error that the digit '9' is excluded from these re's. # Broken for early Perls on EBCDIC my $xml_name_re = my_qr('[^-.0-8:A-Z_a-z[:^ascii:]]', '9'); $xml_name_re = qr/[\x00-\x2C\x2F\x39\x3B-\x40\x5B-\x5E\x60\x7B-\x7F]/ unless $xml_name_re; sub accept_code { shift->accept_codes(@_) } # alias sub accept_codes { # Add some codes my $this = shift; foreach my $new_code (@_) { next unless defined $new_code and length $new_code; # A good-enough check that it's good as an XML Name symbol: Carp::croak "\"$new_code\" isn't a valid element name" if $new_code =~ $xml_name_re # Characters under 0x80 that aren't legal in an XML Name. or $new_code =~ m/^[-\.0-9]/s or $new_code =~ m/:[-\.0-9]/s; # The legal under-0x80 Name characters that # an XML Name still can't start with. $this->{'accept_codes'}{$new_code} = $new_code; # Yes, map to itself -- just so that when we # see "=extend W [whatever] thatelementname", we say that W maps # to whatever $this->{accept_codes}{thatelementname} is, # i.e., "thatelementname". Then when we go re-mapping, # a "W" in the treelet turns into "thatelementname". We only # remap once. # If we say we accept "W", then a "W" in the treelet simply turns # into "W". } return; } #-------------------------------------------------------------------------- sub unaccept_code { shift->unaccept_codes(@_) } sub unaccept_codes { # remove some codes my $this = shift; foreach my $new_code (@_) { next unless defined $new_code and length $new_code; # A good-enough check that it's good as an XML Name symbol: Carp::croak "\"$new_code\" isn't a valid element name" if $new_code =~ $xml_name_re # Characters under 0x80 that aren't legal in an XML Name. or $new_code =~ m/^[-\.0-9]/s or $new_code =~ m/:[-\.0-9]/s; # The legal under-0x80 Name characters that # an XML Name still can't start with. Carp::croak "But you must accept \"$new_code\" codes -- it's a builtin!" if grep $new_code eq $_, @Known_formatting_codes; delete $this->{'accept_codes'}{$new_code}; DEBUG > 2 and print STDERR "OK, won't accept the code $new_code<...>.\n"; } return; } #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ sub parse_string_document { my $self = shift; my @lines; foreach my $line_group (@_) { next unless defined $line_group and length $line_group; pos($line_group) = 0; while($line_group =~ m/([^\n\r]*)(\r?\n?)/g # supports \r, \n ,\r\n #m/([^\n\r]*)((?:\r?\n)?)/g ) { #print(">> $1\n"), $self->parse_lines($1) if length($1) or length($2) or pos($line_group) != length($line_group); # I.e., unless it's a zero-length "empty line" at the very # end of "foo\nbar\n" (i.e., between the \n and the EOS). } } $self->parse_lines(undef); # to signal EOF return $self; } sub _init_fh_source { my($self, $source) = @_; #DEBUG > 1 and print STDERR "Declaring $source as :raw for starters\n"; #$self->_apply_binmode($source, ':raw'); #binmode($source, ":raw"); return; } #:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:. # sub parse_file { my($self, $source) = (@_); if(!defined $source) { Carp::croak("Can't use empty-string as a source for parse_file"); } elsif(ref(\$source) eq 'GLOB') { $self->{'source_filename'} = '' . ($source); } elsif(ref $source) { $self->{'source_filename'} = '' . ($source); } elsif(!length $source) { Carp::croak("Can't use empty-string as a source for parse_file"); } else { { local *PODSOURCE; open(PODSOURCE, "<$source") || Carp::croak("Can't open $source: $!"); $self->{'source_filename'} = $source; $source = *PODSOURCE{IO}; } $self->_init_fh_source($source); } # By here, $source is a FH. $self->{'source_fh'} = $source; my($i, @lines); until( $self->{'source_dead'} ) { splice @lines; for($i = MANY_LINES; $i--;) { # read those many lines at a time local $/ = $NL; push @lines, scalar(<$source>); # readline last unless defined $lines[-1]; # but pass thru the undef, which will set source_dead to true } my $at_eof = ! $lines[-1]; # keep track of the undef pop @lines if $at_eof; # silence warnings # be eol agnostic s/\r\n?/\n/g for @lines; # make sure there are only one line elements for parse_lines @lines = split(/(?<=\n)/, join('', @lines)); # push the undef back after popping it to set source_dead to true push @lines, undef if $at_eof; $self->parse_lines(@lines); } delete($self->{'source_fh'}); # so it can be GC'd return $self; } #:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:. sub parse_from_file { # An emulation of Pod::Parser's interface, for the sake of Perldoc. # Basically just a wrapper around parse_file. my($self, $source, $to) = @_; $self = $self->new unless ref($self); # so we tolerate being a class method if(!defined $source) { $source = *STDIN{IO} } elsif(ref(\$source) eq 'GLOB') { # stet } elsif(ref($source) ) { # stet } elsif(!length $source or $source eq '-' or $source =~ m/^<&(?:STDIN|0)$/i ) { $source = *STDIN{IO}; } if(!defined $to) { $self->output_fh( *STDOUT{IO} ); } elsif(ref(\$to) eq 'GLOB') { $self->output_fh( $to ); } elsif(ref($to)) { $self->output_fh( $to ); } elsif(!length $to or $to eq '-' or $to =~ m/^>&?(?:STDOUT|1)$/i ) { $self->output_fh( *STDOUT{IO} ); } elsif($to =~ m/^>&(?:STDERR|2)$/i) { $self->output_fh( *STDERR{IO} ); } else { require Symbol; my $out_fh = Symbol::gensym(); DEBUG and print STDERR "Write-opening to $to\n"; open($out_fh, ">$to") or Carp::croak "Can't write-open $to: $!"; binmode($out_fh) if $self->can('write_with_binmode') and $self->write_with_binmode; $self->output_fh($out_fh); } return $self->parse_file($source); } #----------------------------------------------------------------------------- sub whine { #my($self,$line,$complaint) = @_; my $self = shift(@_); ++$self->{'errors_seen'}; if($self->{'no_whining'}) { DEBUG > 9 and print STDERR "Discarding complaint (at line $_[0]) $_[1]\n because no_whining is on.\n"; return; } push @{$self->{'all_errata'}{$_[0]}}, $_[1]; return $self->_complain_warn(@_) if $self->{'complain_stderr'}; return $self->_complain_errata(@_); } sub scream { # like whine, but not suppressible #my($self,$line,$complaint) = @_; my $self = shift(@_); ++$self->{'errors_seen'}; push @{$self->{'all_errata'}{$_[0]}}, $_[1]; return $self->_complain_warn(@_) if $self->{'complain_stderr'}; return $self->_complain_errata(@_); } sub _complain_warn { my($self,$line,$complaint) = @_; return printf STDERR "%s around line %s: %s\n", $self->{'source_filename'} || 'Pod input', $line, $complaint; } sub _complain_errata { my($self,$line,$complaint) = @_; if( $self->{'no_errata_section'} ) { DEBUG > 9 and print STDERR "Discarding erratum (at line $line) $complaint\n because no_errata_section is on.\n"; } else { DEBUG > 9 and print STDERR "Queuing erratum (at line $line) $complaint\n"; push @{$self->{'errata'}{$line}}, $complaint # for a report to be generated later! } return 1; } #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ sub _get_initial_item_type { # A hack-wrapper here for when you have like "=over\n\n=item 456\n\n" my($self, $para) = @_; return $para->[1]{'~type'} if $para->[1]{'~type'}; return $para->[1]{'~type'} = 'text' if join("\n", @{$para}[2 .. $#$para]) =~ m/^\s*(\d+)\.?\s*$/s and $1 ne '1'; # Else fall thru to the general case: return $self->_get_item_type($para); } sub _get_item_type { # mutates the item!! my($self, $para) = @_; return $para->[1]{'~type'} if $para->[1]{'~type'}; # Otherwise we haven't yet been to this node. Maybe alter it... my $content = join "\n", @{$para}[2 .. $#$para]; if($content =~ m/^\s*\*\s*$/s or $content =~ m/^\s*$/s) { # Like: "=item *", "=item * ", "=item" splice @$para, 2; # so it ends up just being ['=item', { attrhash } ] $para->[1]{'~orig_content'} = $content; return $para->[1]{'~type'} = 'bullet'; } elsif($content =~ m/^\s*\*\s+(.+)/s) { # tolerance # Like: "=item * Foo bar baz"; $para->[1]{'~orig_content'} = $content; $para->[1]{'~_freaky_para_hack'} = $1; DEBUG > 2 and print STDERR " Tolerating $$para[2] as =item *\\n\\n$1\n"; splice @$para, 2; # so it ends up just being ['=item', { attrhash } ] return $para->[1]{'~type'} = 'bullet'; } elsif($content =~ m/^\s*(\d+)\.?\s*$/s) { # Like: "=item 1.", "=item 123412" $para->[1]{'~orig_content'} = $content; $para->[1]{'number'} = $1; # Yes, stores the number there! splice @$para, 2; # so it ends up just being ['=item', { attrhash } ] return $para->[1]{'~type'} = 'number'; } else { # It's anything else. return $para->[1]{'~type'} = 'text'; } } #----------------------------------------------------------------------------- sub _make_treelet { my $self = shift; # and ($para, $start_line) my $treelet; if(!@_) { return ['']; } if(ref $_[0] and ref $_[0][0] and $_[0][0][0] eq '~Top') { # Hack so we can pass in fake-o pre-cooked paragraphs: # just have the first line be a reference to a ['~Top', {}, ...] # We use this feechure in gen_errata and stuff. DEBUG and print STDERR "Applying precooked treelet hack to $_[0][0]\n"; $treelet = $_[0][0]; splice @$treelet, 0, 2; # lop the top off return $treelet; } else { $treelet = $self->_treelet_from_formatting_codes(@_); } if( ! $self->{'_output_is_for_JustPod'} # Retain these as-is for pod output && $self->_remap_sequences($treelet) ) { $self->_treat_Zs($treelet); # Might as well nix these first $self->_treat_Ls($treelet); # L has to precede E and S $self->_treat_Es($treelet); $self->_treat_Ss($treelet); # S has to come after E $self->_wrap_up($treelet); # Nix X's and merge texties } else { DEBUG and print STDERR "Formatless treelet gets fast-tracked.\n"; # Very common case! } splice @$treelet, 0, 2; # lop the top off return $treelet; } #:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:. sub _wrap_up { my($self, @stack) = @_; my $nixx = $self->{'nix_X_codes'}; my $merge = $self->{'merge_text' }; return unless $nixx or $merge; DEBUG > 2 and print STDERR "\nStarting _wrap_up traversal.\n", $merge ? (" Merge mode on\n") : (), $nixx ? (" Nix-X mode on\n") : (), ; my($i, $treelet); while($treelet = shift @stack) { DEBUG > 3 and print STDERR " Considering children of this $treelet->[0] node...\n"; for($i = 2; $i < @$treelet; ++$i) { # iterate over children DEBUG > 3 and print STDERR " Considering child at $i ", pretty($treelet->[$i]), "\n"; if($nixx and ref $treelet->[$i] and $treelet->[$i][0] eq 'X') { DEBUG > 3 and print STDERR " Nixing X node at $i\n"; splice(@$treelet, $i, 1); # just nix this node (and its descendants) # no need to back-update the counter just yet redo; } elsif($merge and $i != 2 and # non-initial !ref $treelet->[$i] and !ref $treelet->[$i - 1] ) { DEBUG > 3 and print STDERR " Merging ", $i-1, ":[$treelet->[$i-1]] and $i\:[$treelet->[$i]]\n"; $treelet->[$i-1] .= ( splice(@$treelet, $i, 1) )[0]; DEBUG > 4 and print STDERR " Now: ", $i-1, ":[$treelet->[$i-1]]\n"; --$i; next; # since we just pulled the possibly last node out from under # ourselves, we can't just redo() } elsif( ref $treelet->[$i] ) { DEBUG > 4 and print STDERR " Enqueuing ", pretty($treelet->[$i]), " for traversal.\n"; push @stack, $treelet->[$i]; if($treelet->[$i][0] eq 'L') { my $thing; foreach my $attrname ('section', 'to') { if(defined($thing = $treelet->[$i][1]{$attrname}) and ref $thing) { unshift @stack, $thing; DEBUG > 4 and print STDERR " +Enqueuing ", pretty( $treelet->[$i][1]{$attrname} ), " as an attribute value to tweak.\n"; } } } } } } DEBUG > 2 and print STDERR "End of _wrap_up traversal.\n\n"; return; } #:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:. sub _remap_sequences { my($self,@stack) = @_; if(@stack == 1 and @{ $stack[0] } == 3 and !ref $stack[0][2]) { # VERY common case: abort it. DEBUG and print STDERR "Skipping _remap_sequences: formatless treelet.\n"; return 0; } my $map = ($self->{'accept_codes'} || die "NO accept_codes in $self?!?"); my $start_line = $stack[0][1]{'start_line'}; DEBUG > 2 and printf "\nAbout to start _remap_sequences on treelet from line %s.\n", $start_line || '[?]' ; DEBUG > 3 and print STDERR " Map: ", join('; ', map "$_=" . ( ref($map->{$_}) ? join(",", @{$map->{$_}}) : $map->{$_} ), sort keys %$map ), ("B~C~E~F~I~L~S~X~Z" eq join '~', sort keys %$map) ? " (all normal)\n" : "\n" ; # A recursive algorithm implemented iteratively! Whee! my($is, $was, $i, $treelet); # scratch while($treelet = shift @stack) { DEBUG > 3 and print STDERR " Considering children of this $treelet->[0] node...\n"; for($i = 2; $i < @$treelet; ++$i) { # iterate over children next unless ref $treelet->[$i]; # text nodes are uninteresting DEBUG > 4 and print STDERR " Noting child $i : $treelet->[$i][0]<...>\n"; $is = $treelet->[$i][0] = $map->{ $was = $treelet->[$i][0] }; if( DEBUG > 3 ) { if(!defined $is) { print STDERR " Code $was<> is UNKNOWN!\n"; } elsif($is eq $was) { DEBUG > 4 and print STDERR " Code $was<> stays the same.\n"; } else { print STDERR " Code $was<> maps to ", ref($is) ? ( "tags ", map("$_<", @$is), '...', map('>', @$is), "\n" ) : "tag $is<...>.\n"; } } if(!defined $is) { $self->whine($start_line, "Deleting unknown formatting code $was<>"); $is = $treelet->[$i][0] = '1'; # But saving the children! # I could also insert a leading "$was<" and tailing ">" as # children of this node, but something about that seems icky. } if(ref $is) { my @dynasty = @$is; DEBUG > 4 and print STDERR " Renaming $was node to $dynasty[-1]\n"; $treelet->[$i][0] = pop @dynasty; my $nugget; while(@dynasty) { DEBUG > 4 and printf " Grafting a new %s node between %s and %s\n", $dynasty[-1], $treelet->[0], $treelet->[$i][0], ; #$nugget = ; splice @$treelet, $i, 1, [pop(@dynasty), {}, $treelet->[$i]]; # relace node with a new parent } } elsif($is eq '0') { splice(@$treelet, $i, 1); # just nix this node (and its descendants) --$i; # back-update the counter } elsif($is eq '1') { splice(@$treelet, $i, 1 # replace this node with its children! => splice @{ $treelet->[$i] },2 # (not catching its first two (non-child) items) ); --$i; # back up for new stuff } else { # otherwise it's unremarkable unshift @stack, $treelet->[$i]; # just recurse } } } DEBUG > 2 and print STDERR "End of _remap_sequences traversal.\n\n"; if(@_ == 2 and @{ $_[1] } == 3 and !ref $_[1][2]) { DEBUG and print STDERR "Noting that the treelet is now formatless.\n"; return 0; } return 1; } # . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . sub _ponder_extend { # "Go to an extreme, move back to a more comfortable place" # -- /Oblique Strategies/, Brian Eno and Peter Schmidt my($self, $para) = @_; my $content = join ' ', splice @$para, 2; $content =~ s/^\s+//s; $content =~ s/\s+$//s; DEBUG > 2 and print STDERR "Ogling extensor: =extend $content\n"; if($content =~ m/^ (\S+) # 1 : new item \s+ (\S+) # 2 : fallback(s) (?:\s+(\S+))? # 3 : element name(s) \s* $ /xs ) { my $new_letter = $1; my $fallbacks_one = $2; my $elements_one; $elements_one = defined($3) ? $3 : $1; DEBUG > 2 and print STDERR "Extensor has good syntax.\n"; unless($new_letter =~ m/^[A-Z]$/s or $new_letter) { DEBUG > 2 and print STDERR " $new_letter isn't a valid thing to entend.\n"; $self->whine( $para->[1]{'start_line'}, "You can extend only formatting codes A-Z, not like \"$new_letter\"" ); return; } if(grep $new_letter eq $_, @Known_formatting_codes) { DEBUG > 2 and print STDERR " $new_letter isn't a good thing to extend, because known.\n"; $self->whine( $para->[1]{'start_line'}, "You can't extend an established code like \"$new_letter\"" ); #TODO: or allow if last bit is same? return; } unless($fallbacks_one =~ m/^[A-Z](,[A-Z])*$/s # like "B", "M,I", etc. or $fallbacks_one eq '0' or $fallbacks_one eq '1' ) { $self->whine( $para->[1]{'start_line'}, "Format for second =extend parameter must be like" . " M or 1 or 0 or M,N or M,N,O but you have it like " . $fallbacks_one ); return; } unless($elements_one =~ m/^[^ ,]+(,[^ ,]+)*$/s) { # like "B", "M,I", etc. $self->whine( $para->[1]{'start_line'}, "Format for third =extend parameter: like foo or bar,Baz,qu:ux but not like " . $elements_one ); return; } my @fallbacks = split ',', $fallbacks_one, -1; my @elements = split ',', $elements_one, -1; foreach my $f (@fallbacks) { next if exists $Known_formatting_codes{$f} or $f eq '0' or $f eq '1'; DEBUG > 2 and print STDERR " Can't fall back on unknown code $f\n"; $self->whine( $para->[1]{'start_line'}, "Can't use unknown formatting code '$f' as a fallback for '$new_letter'" ); return; } DEBUG > 3 and printf STDERR "Extensor: Fallbacks <%s> Elements <%s>.\n", @fallbacks, @elements; my $canonical_form; foreach my $e (@elements) { if(exists $self->{'accept_codes'}{$e}) { DEBUG > 1 and print STDERR " Mapping '$new_letter' to known extension '$e'\n"; $canonical_form = $e; last; # first acceptable elementname wins! } else { DEBUG > 1 and print STDERR " Can't map '$new_letter' to unknown extension '$e'\n"; } } if( defined $canonical_form ) { # We found a good N => elementname mapping $self->{'accept_codes'}{$new_letter} = $canonical_form; DEBUG > 2 and print "Extensor maps $new_letter => known element $canonical_form.\n"; } else { # We have to use the fallback(s), which might be '0', or '1'. $self->{'accept_codes'}{$new_letter} = (@fallbacks == 1) ? $fallbacks[0] : \@fallbacks; DEBUG > 2 and print "Extensor maps $new_letter => fallbacks @fallbacks.\n"; } } else { DEBUG > 2 and print STDERR "Extensor has bad syntax.\n"; $self->whine( $para->[1]{'start_line'}, "Unknown =extend syntax: $content" ) } return; } #:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:.:. sub _treat_Zs { # Nix Z<...>'s my($self,@stack) = @_; my($i, $treelet); my $start_line = $stack[0][1]{'start_line'}; # A recursive algorithm implemented iteratively! Whee! while($treelet = shift @stack) { for($i = 2; $i < @$treelet; ++$i) { # iterate over children next unless ref $treelet->[$i]; # text nodes are uninteresting unless($treelet->[$i][0] eq 'Z') { unshift @stack, $treelet->[$i]; # recurse next; } DEBUG > 1 and print STDERR "Nixing Z node @{$treelet->[$i]}\n"; # bitch UNLESS it's empty unless( @{$treelet->[$i]} == 2 or (@{$treelet->[$i]} == 3 and $treelet->[$i][2] eq '') ) { $self->whine( $start_line, "A non-empty Z<>" ); } # but kill it anyway splice(@$treelet, $i, 1); # thereby just nix this node. --$i; } } return; } # . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . # Quoting perlpodspec: # In parsing an L<...> code, Pod parsers must distinguish at least four # attributes: ############# Not used. Expressed via the element children plus ############# the value of the "content-implicit" flag. # First: # The link-text. If there is none, this must be undef. (E.g., in "L", the link-text is "Perl Functions". In # "L" and even "L<|Time::HiRes>", there is no link text. Note # that link text may contain formatting.) # ############# The element children # Second: # The possibly inferred link-text -- i.e., if there was no real link text, # then this is the text that we'll infer in its place. (E.g., for # "L", the inferred link text is "Getopt::Std".) # ############# The "to" attribute (which might be text, or a treelet) # Third: # The name or URL, or undef if none. (E.g., in "L", the name -- also sometimes called the page -- is # "perlfunc". In "L", the name is undef.) # ############# The "section" attribute (which might be next, or a treelet) # Fourth: # The section (AKA "item" in older perlpods), or undef if none. E.g., in # Getopt::Std/DESCRIPTION, "DESCRIPTION" is the section. (Note that this # is not the same as a manpage section like the "5" in "man 5 crontab". # "Section Foo" in the Pod sense means the part of the text that's # introduced by the heading or item whose text is "Foo".) # # Pod parsers may also note additional attributes including: # ############# The "type" attribute. # Fifth: # A flag for whether item 3 (if present) is a URL (like # "http://lists.perl.org" is), in which case there should be no section # attribute; a Pod name (like "perldoc" and "Getopt::Std" are); or # possibly a man page name (like "crontab(5)" is). # ############# The "raw" attribute that is already there. # Sixth: # The raw original L<...> content, before text is split on "|", "/", etc, # and before E<...> codes are expanded. # For L<...> codes without a "name|" part, only E<...> and Z<> codes may # occur -- no other formatting codes. That is, authors should not use # "L>". # # Note, however, that formatting codes and Z<>'s can occur in any and all # parts of an L<...> (i.e., in name, section, text, and url). sub _treat_Ls { # Process our dear dear friends, the L<...> sequences # L # L or L # L or L or L<"sec"> # L # L or L # L or L or L # L # L my($self,@stack) = @_; my($i, $treelet); my $start_line = $stack[0][1]{'start_line'}; # A recursive algorithm implemented iteratively! Whee! while($treelet = shift @stack) { for(my $i = 2; $i < @$treelet; ++$i) { # iterate over children of current tree node next unless ref $treelet->[$i]; # text nodes are uninteresting unless($treelet->[$i][0] eq 'L') { unshift @stack, $treelet->[$i]; # recurse next; } # By here, $treelet->[$i] is definitely an L node my $ell = $treelet->[$i]; DEBUG > 1 and print STDERR "Ogling L node " . pretty($ell) . "\n"; # bitch if it's empty or is just '/' if (@{$ell} == 3 and $ell->[2] =~ m!\A\s*/\s*\z!) { $self->whine( $start_line, "L<> contains only '/'" ); $treelet->[$i] = 'L'; # just make it a text node next; # and move on } if( @{$ell} == 2 or (@{$ell} == 3 and $ell->[2] eq '') ) { $self->whine( $start_line, "An empty L<>" ); $treelet->[$i] = 'L<>'; # just make it a text node next; # and move on } if( (! ref $ell->[2] && $ell->[2] =~ /\A\s/) ||(! ref $ell->[-1] && $ell->[-1] =~ /\s\z/) ) { $self->whine( $start_line, "L<> starts or ends with whitespace" ); } # Catch URLs: # there are a number of possible cases: # 1) text node containing url: http://foo.com # -> [ 'http://foo.com' ] # 2) text node containing url and text: foo|http://foo.com # -> [ 'foo|http://foo.com' ] # 3) text node containing url start: mailto:xEfoo.com # -> [ 'mailto:x', [ E ... ], 'foo.com' ] # 4) text node containing url start and text: foo|mailto:xEfoo.com # -> [ 'foo|mailto:x', [ E ... ], 'foo.com' ] # 5) other nodes containing text and url start: OE<39>Malley|http://foo.com # -> [ 'O', [ E ... ], 'Malley', '|http://foo.com' ] # ... etc. # anything before the url is part of the text. # anything after it is part of the url. # the url text node itself may contain parts of both. if (my ($url_index, $text_part, $url_part) = # grep is no good here; we want to bail out immediately so that we can # use $1, $2, etc. without having to do the match twice. sub { for (2..$#$ell) { next if ref $ell->[$_]; next unless $ell->[$_] =~ m/^(?:([^|]*)\|)?(\w+:[^:\s]\S*)$/s; return ($_, $1, $2); } return; }->() ) { $ell->[1]{'type'} = 'url'; my @text = @{$ell}[2..$url_index-1]; push @text, $text_part if defined $text_part; my @url = @{$ell}[$url_index+1..$#$ell]; unshift @url, $url_part; unless (@text) { $ell->[1]{'content-implicit'} = 'yes'; @text = @url; } $ell->[1]{to} = Pod::Simple::LinkSection->new( @url == 1 ? $url[0] : [ '', {}, @url ], ); splice @$ell, 2, $#$ell, @text; next; } # 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]+[)]$}s) { # man sections # Hopefully neither too broad nor too restrictive a RE DEBUG > 1 and print STDERR "Catching \"$it\" as manpage link.\n"; $ell->[1]{'type'} = 'man'; # This's the only place where man links can get made. $ell->[1]{'content-implicit'} = 'yes'; $ell->[1]{'to' } = Pod::Simple::LinkSection->new( $it ); # treelet! next; } if($it =~ m/^[^\/\|,\$\%\@\ \"\<\>\:\#\&\*\{\}\[\]\(\)]+(\:\:[^\/\|,\$\%\@\ \"\<\>\:\#\&\*\{\}\[\]\(\)]+)*$/s) { # Extremely forgiving idea of what constitutes a bare # modulename link like L or even L DEBUG > 1 and print STDERR "Catching \"$it\" as ho-hum L link.\n"; $ell->[1]{'type'} = 'pod'; $ell->[1]{'content-implicit'} = 'yes'; $ell->[1]{'to' } = Pod::Simple::LinkSection->new( $it ); # treelet! next; } # else fall thru... } # ...Uhoh, here's the real L<...> parsing stuff... # "With the ill behavior, with the ill behavior, with the ill behavior..." DEBUG > 1 and print STDERR "Running a real parse on this non-trivial L\n"; my $link_text; # set to an arrayref if found my @ell_content = @$ell; splice @ell_content,0,2; # Knock off the 'L' and {} bits DEBUG > 3 and print STDERR " Ell content to start: ", pretty(@ell_content), "\n"; # Look for the "|" -- only in CHILDREN (not all underlings!) # Like L DEBUG > 3 and print STDERR " Peering at L content for a '|' ...\n"; for(my $j = 0; $j < @ell_content; ++$j) { next if ref $ell_content[$j]; DEBUG > 3 and print STDERR " Peering at L-content text bit \"$ell_content[$j]\" for a '|'.\n"; if($ell_content[$j] =~ m/^([^\|]*)\|(.*)$/s) { my @link_text = ($1); # might be 0-length $ell_content[$j] = $2; # might be 0-length DEBUG > 3 and print STDERR " FOUND a '|' in it. Splitting into [$1] + [$2]\n"; if ($link_text[0] =~ m{[|/]}) { $self->whine( $start_line, "alternative text '$link_text[0]' contains non-escaped | or /" ); } unshift @link_text, splice @ell_content, 0, $j; # leaving only things at J and after @ell_content = grep ref($_)||length($_), @ell_content ; $link_text = [grep ref($_)||length($_), @link_text ]; DEBUG > 3 and printf " So link text is %s\n and remaining ell content is %s\n", pretty($link_text), pretty(@ell_content); last; } } # Now look for the "/" -- only in CHILDREN (not all underlings!) # And afterward, anything left in @ell_content will be the raw name # Like L my $section_name; # set to arrayref if found DEBUG > 3 and print STDERR " Peering at L-content for a '/' ...\n"; for(my $j = 0; $j < @ell_content; ++$j) { next if ref $ell_content[$j]; DEBUG > 3 and print STDERR " Peering at L-content text bit \"$ell_content[$j]\" for a '/'.\n"; if($ell_content[$j] =~ m/^([^\/]*)\/(.*)$/s) { my @section_name = ($2); # might be 0-length $ell_content[$j] = $1; # might be 0-length DEBUG > 3 and print STDERR " FOUND a '/' in it.", " Splitting to page [...$1] + section [$2...]\n"; push @section_name, splice @ell_content, 1+$j; # leaving only things before and including J @ell_content = grep ref($_)||length($_), @ell_content ; @section_name = grep ref($_)||length($_), @section_name ; # Turn L<.../"foo"> into L<.../foo> if(@section_name and !ref($section_name[0]) and !ref($section_name[-1]) and $section_name[ 0] =~ m/^\"/s and $section_name[-1] =~ m/\"$/s and !( # catch weird degenerate case of L<"> ! @section_name == 1 and $section_name[0] eq '"' ) ) { $section_name[ 0] =~ s/^\"//s; $section_name[-1] =~ s/\"$//s; DEBUG > 3 and print STDERR " Quotes removed: ", pretty(@section_name), "\n"; } else { DEBUG > 3 and print STDERR " No need to remove quotes in ", pretty(@section_name), "\n"; } $section_name = \@section_name; last; } } # Turn L<"Foo Bar"> into L     if(!$section_name and @ell_content and !ref($ell_content[0]) and !ref($ell_content[-1]) and $ell_content[ 0] =~ m/^\"/s and $ell_content[-1] =~ m/\"$/s and !( # catch weird degenerate case of L<"> ! @ell_content == 1 and $ell_content[0] eq '"' ) ) { $section_name = [splice @ell_content]; $section_name->[ 0] =~ s/^\"//s; $section_name->[-1] =~ s/\"$//s; $ell->[1]{'~tolerated'} = 1; } # Turn L into L. if(!$section_name and !$link_text and @ell_content and grep !ref($_) && m/ /s, @ell_content ) { $section_name = [splice @ell_content]; $ell->[1]{'~deprecated'} = 1; # That's support for the now-deprecated syntax. # Note that it deliberately won't work on L<...|Foo Bar> } # Now make up the link_text # L -> L # L -> L<"Bar"|Bar> # L -> L<"Bar" in Foo/Foo> unless($link_text) { $ell->[1]{'content-implicit'} = 'yes'; $link_text = []; push @$link_text, '"', @$section_name, '"' if $section_name; if(@ell_content) { $link_text->[-1] .= ' in ' if $section_name; push @$link_text, @ell_content; } } # 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]+[)]$}s ) { $ell->[1]{'type'} = 'man'; DEBUG > 3 and print STDERR "Considering this ($ell_content[0]) a man link.\n"; } else { $ell->[1]{'type'} = 'pod'; DEBUG > 3 and print STDERR "Considering this a pod link (not man or url).\n"; } if( defined $section_name ) { $ell->[1]{'section'} = Pod::Simple::LinkSection->new( ['', {}, @$section_name] ); DEBUG > 3 and print STDERR "L-section content: ", pretty($ell->[1]{'section'}), "\n"; } if( @ell_content ) { $ell->[1]{'to'} = Pod::Simple::LinkSection->new( ['', {}, @ell_content] ); DEBUG > 3 and print STDERR "L-to content: ", pretty($ell->[1]{'to'}), "\n"; } # And update children to be the link-text: @$ell = (@$ell[0,1], defined($link_text) ? splice(@$link_text) : ''); DEBUG > 2 and print STDERR "End of L-parsing for this node " . pretty($treelet->[$i]) . "\n"; unshift @stack, $treelet->[$i]; # might as well recurse } } return; } # . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . sub _treat_Es { my($self,@stack) = @_; my($i, $treelet, $content, $replacer, $charnum); my $start_line = $stack[0][1]{'start_line'}; # A recursive algorithm implemented iteratively! Whee! # Has frightening side effects on L nodes' attributes. #my @ells_to_tweak; while($treelet = shift @stack) { for(my $i = 2; $i < @$treelet; ++$i) { # iterate over children next unless ref $treelet->[$i]; # text nodes are uninteresting if($treelet->[$i][0] eq 'L') { # SPECIAL STUFF for semi-processed L<>'s my $thing; foreach my $attrname ('section', 'to') { if(defined($thing = $treelet->[$i][1]{$attrname}) and ref $thing) { unshift @stack, $thing; DEBUG > 2 and print STDERR " Enqueuing ", pretty( $treelet->[$i][1]{$attrname} ), " as an attribute value to tweak.\n"; } } unshift @stack, $treelet->[$i]; # recurse next; } elsif($treelet->[$i][0] ne 'E') { unshift @stack, $treelet->[$i]; # recurse next; } DEBUG > 1 and print STDERR "Ogling E node ", pretty($treelet->[$i]), "\n"; # bitch if it's empty if( @{$treelet->[$i]} == 2 or (@{$treelet->[$i]} == 3 and $treelet->[$i][2] eq '') ) { $self->whine( $start_line, "An empty E<>" ); $treelet->[$i] = 'E<>'; # splice in a literal next; } # bitch if content is weird unless(@{$treelet->[$i]} == 3 and !ref($content = $treelet->[$i][2])) { $self->whine( $start_line, "An E<...> surrounding strange content" ); $replacer = $treelet->[$i]; # scratch splice(@$treelet, $i, 1, # fake out a literal 'E<', splice(@$replacer,2), # promote its content '>' ); # Don't need to do --$i, as the 'E<' we just added isn't interesting. next; } DEBUG > 1 and print STDERR "Ogling E<$content>\n"; # XXX E<>'s contents *should* be a valid char in the scope of the current # =encoding directive. Defaults to iso-8859-1, I believe. Fix this in the # future sometime. $charnum = Pod::Escapes::e2charnum($content); DEBUG > 1 and print STDERR " Considering E<$content> with char ", defined($charnum) ? $charnum : "undef", ".\n"; if(!defined( $charnum )) { DEBUG > 1 and print STDERR "I don't know how to deal with E<$content>.\n"; $self->whine( $start_line, "Unknown E content in E<$content>" ); $replacer = "E<$content>"; # better than nothing } elsif($charnum >= 255 and !UNICODE) { $replacer = ASCII ? "\xA4" : "?"; DEBUG > 1 and print STDERR "This Perl version can't handle ", "E<$content> (chr $charnum), so replacing with $replacer\n"; } else { $replacer = Pod::Escapes::e2char($content); DEBUG > 1 and print STDERR " Replacing E<$content> with $replacer\n"; } splice(@$treelet, $i, 1, $replacer); # no need to back up $i, tho } } return; } # . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . sub _treat_Ss { my($self,$treelet) = @_; _change_S_to_nbsp($treelet,0) if $self->{'nbsp_for_S'}; # TODO: or a change_nbsp_to_S # Normalizing nbsp's to S is harder: for each text node, make S content # out of anything matching m/([^ \xA0]*(?:\xA0+[^ \xA0]*)+)/ return; } sub _change_S_to_nbsp { # a recursive function # Sanely assumes that the top node in the excursion won't be an S node. my($treelet, $in_s) = @_; my $is_s = ('S' eq $treelet->[0]); $in_s ||= $is_s; # So in_s is on either by this being an S element, # or by an ancestor being an S element. for(my $i = 2; $i < @$treelet; ++$i) { if(ref $treelet->[$i]) { if( _change_S_to_nbsp( $treelet->[$i], $in_s ) ) { my $to_pull_up = $treelet->[$i]; splice @$to_pull_up,0,2; # ...leaving just its content splice @$treelet, $i, 1, @$to_pull_up; # Pull up content $i += @$to_pull_up - 1; # Make $i skip the pulled-up stuff } } else { $treelet->[$i] =~ s/\s/$Pod::Simple::nbsp/g if $in_s; # Note that if you apply nbsp_for_S to text, and so turn # "foo S quux" into "foo bar faz quux", you # end up with something that fails to say "and don't hyphenate # any part of 'bar baz'". However, hyphenation is such a vexing # problem anyway, that most Pod renderers just don't render it # at all. But if you do want to implement hyphenation, I guess # that you'd better have nbsp_for_S off. } } return $is_s; } #----------------------------------------------------------------------------- sub _accessorize { # A simple-minded method-maker no strict 'refs'; foreach my $attrname (@_) { next if $attrname =~ m/::/; # a hack *{caller() . '::' . $attrname} = sub { use strict; $Carp::CarpLevel = 1, Carp::croak( "Accessor usage: \$obj->$attrname() or \$obj->$attrname(\$new_value)" ) unless (@_ == 1 or @_ == 2) and ref $_[0]; (@_ == 1) ? $_[0]->{$attrname} : ($_[0]->{$attrname} = $_[1]); }; } # Ya know, they say accessories make the ensemble! return; } # . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . # . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . #============================================================================= sub filter { my($class, $source) = @_; my $new = $class->new; $new->output_fh(*STDOUT{IO}); if(ref($source || '') eq 'SCALAR') { $new->parse_string_document( $$source ); } elsif(ref($source)) { # it's a file handle $new->parse_file($source); } else { # it's a filename $new->parse_file($source); } return $new; } #----------------------------------------------------------------------------- sub _out { # For use in testing: Class->_out($source) # returns the transformation of $source my $class = shift(@_); my $mutor = shift(@_) if @_ and ref($_[0] || '') eq 'CODE'; DEBUG and print STDERR "\n\n", '#' x 76, "\nAbout to parse source: {{\n$_[0]\n}}\n\n"; my $parser = ref $class && $class->isa(__PACKAGE__) ? $class : $class->new; $parser->hide_line_numbers(1); my $out = ''; $parser->output_string( \$out ); DEBUG and print STDERR " _out to ", \$out, "\n"; $mutor->($parser) if $mutor; $parser->parse_string_document( $_[0] ); # use Data::Dumper; print STDERR Dumper($parser), "\n"; return $out; } sub _duo { # For use in testing: Class->_duo($source1, $source2) # returns the parse trees of $source1 and $source2. # Good in things like: &ok( Class->duo(... , ...) ); my $class = shift(@_); Carp::croak "But $class->_duo is useful only in list context!" unless wantarray; my $mutor = shift(@_) if @_ and ref($_[0] || '') eq 'CODE'; Carp::croak "But $class->_duo takes two parameters, not: @_" unless @_ == 2; my(@out); while( @_ ) { my $parser = $class->new; push @out, ''; $parser->output_string( \( $out[-1] ) ); DEBUG and print STDERR " _duo out to ", $parser->output_string(), " = $parser->{'output_string'}\n"; $parser->hide_line_numbers(1); $mutor->($parser) if $mutor; $parser->parse_string_document( shift( @_ ) ); # use Data::Dumper; print STDERR Dumper($parser), "\n"; } return @out; } #----------------------------------------------------------------------------- 1; __END__ TODO: A start_formatting_code and end_formatting_code methods, which in the base class call start_L, end_L, start_C, end_C, etc., if they are defined. have the POD FORMATTING ERRORS section note the localtime, and the version of Pod::Simple. option to delete all Es? option to scream if under-0x20 literals are found in the input, or under-E<32> E codes are found in the tree. And ditto \x7f-\x9f Option to turn highbit characters into their compromised form? (applies to E parsing too) TODO: BOM/encoding things. TODO: ascii-compat things in the XML classes? Pod-Simple-3.45/lib/Pod/Simple/0000755000175000017500000000000014430216375014310 5ustar khwkhwPod-Simple-3.45/lib/Pod/Simple/SimpleTree.pm0000644000175000017500000001076014427237107016725 0ustar khwkhwpackage Pod::Simple::SimpleTree; use strict; use warnings; use Carp (); use Pod::Simple (); our $VERSION = '3.45'; BEGIN { our @ISA = ('Pod::Simple'); *DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG; } __PACKAGE__->_accessorize( 'root', # root of the tree ); #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ sub _handle_element_start { # self, tagname, attrhash DEBUG > 2 and print STDERR "Handling $_[1] start-event\n"; my $x = [$_[1], $_[2]]; if($_[0]{'_currpos'}) { push @{ $_[0]{'_currpos'}[0] }, $x; # insert in parent's child-list unshift @{ $_[0]{'_currpos'} }, $x; # prefix to stack } else { DEBUG and print STDERR " And oo, it gets to be root!\n"; $_[0]{'_currpos'} = [ $_[0]{'root'} = $x ]; # first event! set to stack, and set as root. } DEBUG > 3 and print STDERR "Stack is now: ", join(">", map $_->[0], @{$_[0]{'_currpos'}}), "\n"; return; } sub _handle_element_end { # self, tagname DEBUG > 2 and print STDERR "Handling $_[1] end-event\n"; shift @{$_[0]{'_currpos'}}; DEBUG > 3 and print STDERR "Stack is now: ", join(">", map $_->[0], @{$_[0]{'_currpos'}}), "\n"; return; } sub _handle_text { # self, text DEBUG > 2 and print STDERR "Handling $_[1] text-event\n"; push @{ $_[0]{'_currpos'}[0] }, $_[1]; return; } # A bit of evil from the black box... please avert your eyes, kind souls. sub _traverse_treelet_bit { DEBUG > 2 and print STDERR "Handling $_[1] paragraph event\n"; my $self = shift; push @{ $self->{'_currpos'}[0] }, [@_]; return; } #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1; __END__ =head1 NAME Pod::Simple::SimpleTree -- parse Pod into a simple parse tree =head1 SYNOPSIS % cat ptest.pod =head1 PIE I like B! % perl -MPod::Simple::SimpleTree -MData::Dumper -e \ "print Dumper(Pod::Simple::SimpleTree->new->parse_file(shift)->root)" \ ptest.pod $VAR1 = [ 'Document', { 'start_line' => 1 }, [ 'head1', { 'start_line' => 1 }, 'PIE' ], [ 'Para', { 'start_line' => 3 }, 'I like ', [ 'B', {}, 'pie' ], '!' ] ]; =head1 DESCRIPTION This class is of interest to people writing a Pod processor/formatter. This class takes Pod and parses it, returning a parse tree made just of arrayrefs, and hashrefs, and strings. This is a subclass of L and inherits all its methods. This class is inspired by XML::Parser's "Tree" parsing-style, although it doesn't use exactly the same LoL format. =head1 METHODS At the end of the parse, call C<< $parser->root >> to get the tree's top node. =head1 Tree Contents Every element node in the parse tree is represented by an arrayref of the form: C<[ I, \%attributes, I<...subnodes...> ]>. See the example tree dump in the Synopsis, above. Every text node in the tree is represented by a simple (non-ref) string scalar. So you can test C to see whether you have an element node or just a text node. The top node in the tree is C<[ 'Document', \%attributes, I<...subnodes...> ]> =head1 SEE ALSO L L L =head1 SUPPORT Questions or discussion about POD and Pod::Simple should be sent to the pod-people@perl.org mail list. Send an empty email to pod-people-subscribe@perl.org to subscribe. This module is managed in an open GitHub repository, L. Feel free to fork and contribute, or to clone L and send patches! Patches against Pod::Simple are welcome. Please send bug reports to . =head1 COPYRIGHT AND DISCLAIMERS Copyright (c) 2002 Sean M. Burke. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. This program is distributed in the hope that it will be useful, but without any warranty; without even the implied warranty of merchantability or fitness for a particular purpose. =head1 AUTHOR Pod::Simple was created by Sean M. Burke . But don't bother him, he's retired. Pod::Simple is maintained by: =over =item * Allison Randal C =item * Hans Dieter Pearcey C =item * David E. Wheeler C =back =cut Pod-Simple-3.45/lib/Pod/Simple/Text.pm0000644000175000017500000001174514427237107015604 0ustar khwkhwpackage Pod::Simple::Text; use strict; use warnings; use Carp (); use Pod::Simple::Methody (); use Pod::Simple (); our $VERSION = '3.45'; our @ISA = ('Pod::Simple::Methody'); BEGIN { *DEBUG = defined(&Pod::Simple::DEBUG) ? \&Pod::Simple::DEBUG : sub() {0} } our $FREAKYMODE; use Text::Wrap 98.112902 (); #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ sub new { my $self = shift; my $new = $self->SUPER::new(@_); $new->{'output_fh'} ||= *STDOUT{IO}; $new->accept_target_as_text(qw( text plaintext plain )); $new->nix_X_codes(1); $new->nbsp_for_S(1); $new->{'Thispara'} = ''; $new->{'Indent'} = 0; $new->{'Indentstring'} = ' '; return $new; } #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ sub handle_text { $_[0]{'Thispara'} .= $_[1] } sub start_Para { $_[0]{'Thispara'} = '' } sub start_head1 { $_[0]{'Thispara'} = '' } sub start_head2 { $_[0]{'Thispara'} = '' } sub start_head3 { $_[0]{'Thispara'} = '' } sub start_head4 { $_[0]{'Thispara'} = '' } sub start_Verbatim { $_[0]{'Thispara'} = '' } sub start_item_bullet { $_[0]{'Thispara'} = $FREAKYMODE ? '' : '* ' } sub start_item_number { $_[0]{'Thispara'} = $FREAKYMODE ? '' : "$_[1]{'number'}. " } sub start_item_text { $_[0]{'Thispara'} = '' } sub start_over_bullet { ++$_[0]{'Indent'} } sub start_over_number { ++$_[0]{'Indent'} } sub start_over_text { ++$_[0]{'Indent'} } sub start_over_block { ++$_[0]{'Indent'} } sub end_over_bullet { --$_[0]{'Indent'} } sub end_over_number { --$_[0]{'Indent'} } sub end_over_text { --$_[0]{'Indent'} } sub end_over_block { --$_[0]{'Indent'} } # . . . . . Now the actual formatters: sub end_head1 { $_[0]->emit_par(-4) } sub end_head2 { $_[0]->emit_par(-3) } sub end_head3 { $_[0]->emit_par(-2) } sub end_head4 { $_[0]->emit_par(-1) } sub end_Para { $_[0]->emit_par( 0) } sub end_item_bullet { $_[0]->emit_par( 0) } sub end_item_number { $_[0]->emit_par( 0) } sub end_item_text { $_[0]->emit_par(-2) } sub start_L { $_[0]{'Link'} = $_[1] if $_[1]->{type} eq 'url' } sub end_L { if (my $link = delete $_[0]{'Link'}) { # Append the URL to the output unless it's already present. $_[0]{'Thispara'} .= " <$link->{to}>" unless $_[0]{'Thispara'} =~ /\b\Q$link->{to}/; } } sub emit_par { my($self, $tweak_indent) = splice(@_,0,2); my $indent = ' ' x ( 2 * $self->{'Indent'} + 4 + ($tweak_indent||0) ); # Yes, 'STRING' x NEGATIVE gives '', same as 'STRING' x 0 $self->{'Thispara'} =~ s/$Pod::Simple::shy//g; local $Text::Wrap::huge = 'overflow'; my $out = Text::Wrap::wrap($indent, $indent, $self->{'Thispara'} .= "\n"); $out =~ s/$Pod::Simple::nbsp/ /g; print {$self->{'output_fh'}} $out, "\n"; $self->{'Thispara'} = ''; return; } # . . . . . . . . . . And then off by its lonesome: sub end_Verbatim { my $self = shift; $self->{'Thispara'} =~ s/$Pod::Simple::nbsp/ /g; $self->{'Thispara'} =~ s/$Pod::Simple::shy//g; my $i = ' ' x ( 2 * $self->{'Indent'} + 4); #my $i = ' ' x (4 + $self->{'Indent'}); $self->{'Thispara'} =~ s/^/$i/mg; print { $self->{'output_fh'} } '', $self->{'Thispara'}, "\n\n" ; $self->{'Thispara'} = ''; return; } #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 1; __END__ =head1 NAME Pod::Simple::Text -- format Pod as plaintext =head1 SYNOPSIS perl -MPod::Simple::Text -e \ "exit Pod::Simple::Text->filter(shift)->any_errata_seen" \ thingy.pod =head1 DESCRIPTION This class is a formatter that takes Pod and renders it as wrapped plaintext. Its wrapping is done by L, so you can change C<$Text::Wrap::columns> as you like. This is a subclass of L and inherits all its methods. =head1 SEE ALSO L, L, L =head1 SUPPORT Questions or discussion about POD and Pod::Simple should be sent to the pod-people@perl.org mail list. Send an empty email to pod-people-subscribe@perl.org to subscribe. This module is managed in an open GitHub repository, L. Feel free to fork and contribute, or to clone L and send patches! Patches against Pod::Simple are welcome. Please send bug reports to . =head1 COPYRIGHT AND DISCLAIMERS Copyright (c) 2002 Sean M. Burke. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. This program is distributed in the hope that it will be useful, but without any warranty; without even the implied warranty of merchantability or fitness for a particular purpose. =head1 AUTHOR Pod::Simple was created by Sean M. Burke . But don't bother him, he's retired. Pod::Simple is maintained by: =over =item * Allison Randal C =item * Hans Dieter Pearcey C =item * David E. Wheeler C =back =cut Pod-Simple-3.45/lib/Pod/Simple/TranscodeDumb.pm0000644000175000017500000000505514427237107017407 0ustar khwkhwpackage Pod::Simple::TranscodeDumb; use strict; our $VERSION = '3.45'; # This module basically pretends it knows how to transcode, except # only for null-transcodings! We use this when Encode isn't # available. our %Supported = ( 'ascii' => 1, 'ascii-ctrl' => 1, 'iso-8859-1' => 1, 'cp1252' => 1, 'null' => 1, 'latin1' => 1, 'latin-1' => 1, %Supported, ); sub is_dumb {1} sub is_smart {0} sub all_encodings { return sort keys %Supported; } sub encoding_is_available { return exists $Supported{lc $_[1]}; } sub encmodver { return __PACKAGE__ . " v" .($VERSION || '?'); } sub make_transcoder { my ($e) = $_[1]; die "WHAT ENCODING!?!?" unless $e; # No-op for all but CP1252. return sub {;} if $e !~ /^cp-?1252$/i; # Replace CP1252 nerbles with their ASCII equivalents. return sub { # Copied from Encode::ZapCP1252. my %ascii_for = ( # http://en.wikipedia.org/wiki/Windows-1252 "\x80" => 'e', # EURO SIGN "\x82" => ',', # SINGLE LOW-9 QUOTATION MARK "\x83" => 'f', # LATIN SMALL LETTER F WITH HOOK "\x84" => ',,', # DOUBLE LOW-9 QUOTATION MARK "\x85" => '...', # HORIZONTAL ELLIPSIS "\x86" => '+', # DAGGER "\x87" => '++', # DOUBLE DAGGER "\x88" => '^', # MODIFIER LETTER CIRCUMFLEX ACCENT "\x89" => '%', # PER MILLE SIGN "\x8a" => 'S', # LATIN CAPITAL LETTER S WITH CARON "\x8b" => '<', # SINGLE LEFT-POINTING ANGLE QUOTATION MARK "\x8c" => 'OE', # LATIN CAPITAL LIGATURE OE "\x8e" => 'Z', # LATIN CAPITAL LETTER Z WITH CARON "\x91" => "'", # LEFT SINGLE QUOTATION MARK "\x92" => "'", # RIGHT SINGLE QUOTATION MARK "\x93" => '"', # LEFT DOUBLE QUOTATION MARK "\x94" => '"', # RIGHT DOUBLE QUOTATION MARK "\x95" => '*', # BULLET "\x96" => '-', # EN DASH "\x97" => '--', # EM DASH "\x98" => '~', # SMALL TILDE "\x99" => '(tm)', # TRADE MARK SIGN "\x9a" => 's', # LATIN SMALL LETTER S WITH CARON "\x9b" => '>', # SINGLE RIGHT-POINTING ANGLE QUOTATION MARK "\x9c" => 'oe', # LATIN SMALL LIGATURE OE "\x9e" => 'z', # LATIN SMALL LETTER Z WITH CARON "\x9f" => 'Y', # LATIN CAPITAL LETTER Y WITH DIAERESIS ); s{([\x80-\x9f])}{$ascii_for{$1} || $1}emxsg for @_; }; } 1; use warnings; Pod-Simple-3.45/lib/Pod/Simple/Search.pm0000644000175000017500000010562314427237107016064 0ustar khwkhwpackage Pod::Simple::Search; use strict; use warnings; our $VERSION = '3.45'; ## Current version of this package BEGIN { *DEBUG = sub () {0} unless defined &DEBUG; } # set DEBUG level use Carp (); our $SLEEPY; $SLEEPY = 1 if !defined $SLEEPY and $^O =~ /mswin|mac/i; # flag to occasionally sleep for $SLEEPY - 1 seconds. our $MAX_VERSION_WITHIN ||= 60; ############################################################################# #use diagnostics; use File::Spec (); use File::Basename qw( basename dirname ); use Config (); use Cwd qw( cwd ); #========================================================================== __PACKAGE__->_accessorize( # Make my dumb accessor methods 'callback', 'progress', 'dir_prefix', 'inc', 'laborious', 'limit_glob', 'limit_re', 'shadows', 'verbose', 'name2path', 'path2name', 'recurse', 'ciseen', 'is_case_insensitive' ); #========================================================================== sub new { my $class = shift; my $self = bless {}, ref($class) || $class; $self->init; return $self; } sub init { my $self = shift; $self->inc(1); $self->recurse(1); $self->verbose(DEBUG); $self->is_case_insensitive(-e uc __FILE__ && -e lc __FILE__); return $self; } #-------------------------------------------------------------------------- sub survey { my($self, @search_dirs) = @_; $self = $self->new unless ref $self; # tolerate being a class method $self->_expand_inc( \@search_dirs ); $self->{'_scan_count'} = 0; $self->{'_dirs_visited'} = {}; $self->path2name( {} ); $self->name2path( {} ); $self->ciseen( {} ); $self->limit_re( $self->_limit_glob_to_limit_re ) if $self->{'limit_glob'}; my $cwd = cwd(); my $verbose = $self->verbose; local $_; # don't clobber the caller's $_ ! foreach my $try (@search_dirs) { unless( File::Spec->file_name_is_absolute($try) ) { # make path absolute $try = File::Spec->catfile( $cwd ,$try); } # simplify path $try = File::Spec->canonpath($try); my $start_in; my $modname_prefix; if($self->{'dir_prefix'}) { $start_in = File::Spec->catdir( $try, grep length($_), split '[\\/:]+', $self->{'dir_prefix'} ); $modname_prefix = [grep length($_), split m{[:/\\]}, $self->{'dir_prefix'}]; $verbose and print "Appending \"$self->{'dir_prefix'}\" to $try, ", "giving $start_in (= @$modname_prefix)\n"; } else { $start_in = $try; } if( $self->{'_dirs_visited'}{$start_in} ) { $verbose and print "Directory '$start_in' already seen, skipping.\n"; next; } else { $self->{'_dirs_visited'}{$start_in} = 1; } unless(-e $start_in) { $verbose and print "Skipping non-existent $start_in\n"; next; } my $closure = $self->_make_search_callback; if(-d $start_in) { # Normal case: $verbose and print "Beginning excursion under $start_in\n"; $self->_recurse_dir( $start_in, $closure, $modname_prefix ); $verbose and print "Back from excursion under $start_in\n\n"; } elsif(-f _) { # A excursion consisting of just one file! $_ = basename($start_in); $verbose and print "Pondering $start_in ($_)\n"; $closure->($start_in, $_, 0, []); } else { $verbose and print "Skipping mysterious $start_in\n"; } } $self->progress and $self->progress->done( "Noted $$self{'_scan_count'} Pod files total"); $self->ciseen( {} ); return unless defined wantarray; # void return $self->name2path unless wantarray; # scalar return $self->name2path, $self->path2name; # list } #========================================================================== sub _make_search_callback { my $self = $_[0]; # Put the options in variables, for easy access my( $laborious, $verbose, $shadows, $limit_re, $callback, $progress, $path2name, $name2path, $recurse, $ciseen, $is_case_insensitive) = map scalar($self->$_()), qw(laborious verbose shadows limit_re callback progress path2name name2path recurse ciseen is_case_insensitive); my ($seen, $remember, $files_for); if ($is_case_insensitive) { $seen = sub { $ciseen->{ lc $_[0] } }; $remember = sub { $name2path->{ $_[0] } = $ciseen->{ lc $_[0] } = $_[1]; }; $files_for = sub { my $n = lc $_[0]; grep { lc $path2name->{$_} eq $n } %{ $path2name } }; } else { $seen = sub { $name2path->{ $_[0] } }; $remember = sub { $name2path->{ $_[0] } = $_[1] }; $files_for = sub { my $n = $_[0]; grep { $path2name->{$_} eq $n } %{ $path2name } }; } my($file, $shortname, $isdir, $modname_bits); return sub { ($file, $shortname, $isdir, $modname_bits) = @_; if($isdir) { # this never gets called on the startdir itself, just subdirs unless( $recurse ) { $verbose and print "Not recursing into '$file' as per requested.\n"; return 'PRUNE'; } if( $self->{'_dirs_visited'}{$file} ) { $verbose and print "Directory '$file' already seen, skipping.\n"; return 'PRUNE'; } print "Looking in dir $file\n" if $verbose; unless ($laborious) { # $laborious overrides pruning if( m/^(\d+\.[\d_]{3,})\z/s and do { my $x = $1; $x =~ tr/_//d; $x != $] } ) { $verbose and print "Perl $] version mismatch on $_, skipping.\n"; return 'PRUNE'; } if( m/^([A-Za-z][a-zA-Z0-9_]*)\z/s ) { $verbose and print "$_ is a well-named module subdir. Looking....\n"; } else { $verbose and print "$_ is a fishy directory name. Skipping.\n"; return 'PRUNE'; } } # end unless $laborious $self->{'_dirs_visited'}{$file} = 1; return; # (not pruning); } # Make sure it's a file even worth even considering if($laborious) { unless( m/\.(pod|pm|plx?)\z/i || -x _ and -T _ # Note that the cheapest operation (the RE) is run first. ) { $verbose > 1 and print " Brushing off uninteresting $file\n"; return; } } else { unless( m/^[-_a-zA-Z0-9]+\.(?:pod|pm|plx?)\z/is ) { $verbose > 1 and print " Brushing off oddly-named $file\n"; return; } } $verbose and print "Considering item $file\n"; my $name = $self->_path2modname( $file, $shortname, $modname_bits ); $verbose > 0.01 and print " Nominating $file as $name\n"; if($limit_re and $name !~ m/$limit_re/i) { $verbose and print "Shunning $name as not matching $limit_re\n"; return; } if( !$shadows and $seen->($name) ) { $verbose and print "Not worth considering $file ", "-- already saw $name as ", join(' ', $files_for->($name)), "\n"; return; } # Put off until as late as possible the expense of # actually reading the file: $progress and $progress->reach($self->{'_scan_count'}, "Scanning $file"); return unless $self->contains_pod( $file ); ++ $self->{'_scan_count'}; # Or finally take note of it: if ( my $prev = $seen->($name) ) { $verbose and print "Duplicate POD found (shadowing?): $name ($file)\n", " Already seen in ", join(' ', $files_for->($name)), "\n"; } else { $remember->($name, $file); # Noting just the first occurrence } $verbose and print " Noting $name = $file\n"; if( $callback ) { local $_ = $_; # insulate from changes, just in case $callback->($file, $name); } $path2name->{$file} = $name; return; } } #========================================================================== sub _path2modname { my($self, $file, $shortname, $modname_bits) = @_; # this code simplifies the POD name for Perl modules: # * remove "site_perl" # * remove e.g. "i586-linux" (from 'archname') # * remove e.g. 5.00503 # * remove pod/ if followed by perl*.pod (e.g. in pod/perlfunc.pod) # * dig into the file for case-preserved name if not already mixed case my @m = @$modname_bits; my $x; my $verbose = $self->verbose; # Shaving off leading naughty-bits while(@m and defined($x = lc( $m[0] )) and( $x eq 'site_perl' or($x =~ m/^pods?$/ and @m == 1 and $shortname =~ m{^perl.*\.pod$}s ) or $x =~ m{\\d+\\.z\\d+([_.]?\\d+)?} # if looks like a vernum or $x eq lc( $Config::Config{'archname'} ) )) { shift @m } my $name = join '::', @m, $shortname; $self->_simplify_base($name); # On VMS, case-preserved document names can't be constructed from # filenames, so try to extract them from the "=head1 NAME" tag in the # file instead. if ($^O eq 'VMS' && ($name eq lc($name) || $name eq uc($name))) { open PODFILE, "<$file" or die "_path2modname: Can't open $file: $!"; my $in_pod = 0; my $in_name = 0; my $line; while ($line = ) { chomp $line; $in_pod = 1 if ($line =~ m/^=\w/); $in_pod = 0 if ($line =~ m/^=cut/); next unless $in_pod; # skip non-pod text next if ($line =~ m/^\s*\z/); # and blank lines next if ($in_pod && ($line =~ m/^X{'fs_recursion_maxdepth'} || 10; my $verbose = $self->verbose; my $here_string = File::Spec->curdir; my $up_string = File::Spec->updir; $modname_bits ||= []; my $recursor; $recursor = sub { my($dir_long, $dir_bare) = @_; if( @$modname_bits >= 10 ) { $verbose and print "Too deep! [@$modname_bits]\n"; return; } unless(-d $dir_long) { $verbose > 2 and print "But it's not a dir! $dir_long\n"; return; } unless( opendir(INDIR, $dir_long) ) { $verbose > 2 and print "Can't opendir $dir_long : $!\n"; closedir(INDIR); return } # Load all items; put no extension before .pod before .pm before .plx?. my @items = map { $_->[0] } sort { $a->[1] cmp $b->[1] || $b->[2] cmp $a->[2] } map { (my $t = $_) =~ s/[.]p(m|lx?|od)\z//; [$_, $t, lc($1 || 'z') ] } readdir(INDIR); closedir(INDIR); push @$modname_bits, $dir_bare unless $dir_bare eq ''; my $i_full; foreach my $i (@items) { next if $i eq $here_string or $i eq $up_string or $i eq ''; $i_full = File::Spec->catfile( $dir_long, $i ); if(!-r $i_full) { $verbose and print "Skipping unreadable $i_full\n"; } elsif(-f $i_full) { $_ = $i; $callback->( $i_full, $i, 0, $modname_bits ); } elsif(-d _) { $i =~ s/\.DIR\z//i if $^O eq 'VMS'; $_ = $i; my $rv = $callback->( $i_full, $i, 1, $modname_bits ) || ''; if($rv eq 'PRUNE') { $verbose > 1 and print "OK, pruning"; } else { # Otherwise, recurse into it $recursor->( File::Spec->catdir($dir_long, $i) , $i); } } else { $verbose > 1 and print "Skipping oddity $i_full\n"; } } pop @$modname_bits; return; };; local $_; $recursor->($startdir, ''); undef $recursor; # allow it to be GC'd return; } #========================================================================== sub run { # A function, useful in one-liners my $self = __PACKAGE__->new; $self->limit_glob($ARGV[0]) if @ARGV; $self->callback( sub { my($file, $name) = @_; my $version = ''; # Yes, I know we won't catch the version in like a File/Thing.pm # if we see File/Thing.pod first. That's just the way the # cookie crumbles. -- SMB if($file =~ m/\.pod$/i) { # Don't bother looking for $VERSION in .pod files DEBUG and print "Not looking for \$VERSION in .pod $file\n"; } elsif( !open(INPOD, $file) ) { DEBUG and print "Couldn't open $file: $!\n"; close(INPOD); } else { # Sane case: file is readable my $lines = 0; while() { last if $lines++ > $MAX_VERSION_WITHIN; # some degree of sanity if( s/^\s*\$VERSION\s*=\s*//s and m/\d/ ) { DEBUG and print "Found version line (#$lines): $_"; s/\s*\#.*//s; s/\;\s*$//s; s/\s+$//s; s/\t+/ /s; # nix tabs # Optimize the most common cases: $_ = "v$1" if m{^v?["']?([0-9_]+(\.[0-9_]+)*)["']?$}s # like in $VERSION = "3.14159"; or m{\$Revision:\s*([0-9_]+(?:\.[0-9_]+)*)\s*\$}s # like in sprintf("%d.%02d", q$Revision: 4.13 $ =~ /(\d+)\.(\d+)/); ; # Like in sprintf("%d.%s", map {s/_//g; $_} q$Name: release-0_55-public $ =~ /-(\d+)_([\d_]+)/) $_ = sprintf("v%d.%s", map {s/_//g; $_} $1 =~ m/-(\d+)_([\d_]+)/) # snare just the numeric part if m{\$Name:\s*([^\$]+)\$}s ; $version = $_; DEBUG and print "Noting $version as version\n"; last; } } close(INPOD); } print "$name\t$version\t$file\n"; return; # End of callback! }); $self->survey; } #========================================================================== sub simplify_name { my($self, $str) = @_; # Remove all path components # XXX Why not just use basename()? -- SMB if ($^O eq 'MacOS') { $str =~ s{^.*:+}{}s } else { $str =~ s{^.*/+}{}s } $self->_simplify_base($str); return $str; } #========================================================================== sub _simplify_base { # Internal method only # strip Perl's own extensions $_[1] =~ s/\.(pod|pm|plx?)\z//i; # strip meaningless extensions on Win32 and OS/2 $_[1] =~ s/\.(bat|exe|cmd)\z//i if $^O =~ /mswin|os2/i; # strip meaningless extensions on VMS $_[1] =~ s/\.(com)\z//i if $^O eq 'VMS'; return; } #========================================================================== sub _expand_inc { my($self, $search_dirs) = @_; return unless $self->{'inc'}; my %seen = map { File::Spec->rel2abs($_) => 1 } @{ $search_dirs }; if ($^O eq 'MacOS') { push @$search_dirs, grep { !$seen{ File::Spec->rel2abs($_) }++ } $self->_mac_whammy(@INC); # Any other OSs need custom handling here? } else { push @$search_dirs, grep { !$seen{ File::Spec->rel2abs($_) }++ } @INC; } $self->{'laborious'} = 0; # Since inc said to use INC return; } #========================================================================== sub _mac_whammy { # Tolerate '.', './some_dir' and '(../)+some_dir' on Mac OS my @them; (undef,@them) = @_; for $_ (@them) { if ( $_ eq '.' ) { $_ = ':'; } elsif ( $_ =~ s|^((?:\.\./)+)|':' x (length($1)/3)|e ) { $_ = ':'. $_; } else { $_ =~ s|^\./|:|; } } return @them; } #========================================================================== sub _limit_glob_to_limit_re { my $self = $_[0]; my $limit_glob = $self->{'limit_glob'} || return; my $limit_re = '^' . quotemeta($limit_glob) . '$'; $limit_re =~ s/\\\?/./g; # glob "?" => "." $limit_re =~ s/\\\*/.*?/g; # glob "*" => ".*?" $limit_re =~ s/\.\*\?\$$//s; # final glob "*" => ".*?$" => "" $self->{'verbose'} and print "Turning limit_glob $limit_glob into re $limit_re\n"; # A common optimization: if(!exists($self->{'dir_prefix'}) and $limit_glob =~ m/^(?:\w+\:\:)+/s # like "File::*" or "File::Thing*" # Optimize for sane and common cases (but not things like "*::File") ) { $self->{'dir_prefix'} = join "::", $limit_glob =~ m/^(?:\w+::)+/sg; $self->{'verbose'} and print " and setting dir_prefix to $self->{'dir_prefix'}\n"; } return $limit_re; } #========================================================================== # contribution mostly from Tim Jenness sub _actual_filenames { my $dir = shift; my $fn = lc shift; opendir my ($dh), $dir or return; return map { File::Spec->catdir($dir, $_) } grep { lc $_ eq $fn } readdir $dh; } sub find { my($self, $pod, @search_dirs) = @_; $self = $self->new unless ref $self; # tolerate being a class method # Check usage Carp::carp 'Usage: \$self->find($podname, ...)' unless defined $pod and length $pod; my $verbose = $self->verbose; # Split on :: and then join the name together using File::Spec my @parts = split /::/, $pod; $verbose and print "Chomping {$pod} => {@parts}\n"; #@search_dirs = File::Spec->curdir unless @search_dirs; $self->_expand_inc(\@search_dirs); # Add location of binaries such as pod2text: push @search_dirs, $Config::Config{'scriptdir'} if $self->inc; my %seen_dir; while (my $dir = shift @search_dirs ) { next unless defined $dir and length $dir; next if $seen_dir{$dir}; $seen_dir{$dir} = 1; unless(-d $dir) { print "Directory $dir does not exist\n" if $verbose; } print "Looking in directory $dir\n" if $verbose; my $fullname = File::Spec->catfile( $dir, @parts ); print "Filename is now $fullname\n" if $verbose; foreach my $ext ('', '.pod', '.pm', '.pl') { # possible extensions my $fullext = $fullname . $ext; if ( -f $fullext and $self->contains_pod($fullext) ) { print "FOUND: $fullext\n" if $verbose; if (@parts > 1 && lc $parts[0] eq 'pod' && $self->is_case_insensitive() && $ext eq '.pod') { # Well, this file could be for a program (perldoc) but we actually # want a module (Pod::Perldoc). So see if there is a .pm with the # proper casing. my $subdir = dirname $fullext; unless (grep { $fullext eq $_ } _actual_filenames $subdir, "$parts[-1].pod") { print "# Looking for alternate spelling in $subdir\n" if $verbose; # Try the .pm file. my $pm = $fullname . '.pm'; if ( -f $pm and $self->contains_pod($pm) ) { # Prefer the .pm if its case matches. if (grep { $pm eq $_ } _actual_filenames $subdir, "$parts[-1].pm") { print "FOUND: $fullext\n" if $verbose; return $pm; } } } } return $fullext; } } # Case-insensitively Look for ./pod directories and slip them in. for my $subdir ( _actual_filenames($dir, 'pods'), _actual_filenames($dir, 'pod') ) { if (-d $subdir) { $verbose and print "Noticing $subdir and looking there...\n"; unshift @search_dirs, $subdir; } } } return undef; } #========================================================================== sub contains_pod { my($self, $file) = @_; my $verbose = $self->{'verbose'}; # check for one line of POD $verbose > 1 and print " Scanning $file for pod...\n"; unless( open(MAYBEPOD,"<$file") ) { print "Error: $file is unreadable: $!\n"; return undef; } sleep($SLEEPY - 1) if $SLEEPY; # avoid totally hogging the processor on OSs with poor process control local $_; while( ) { if(m/^=(head\d|pod|over|item)\b/s) { close(MAYBEPOD) || die "Bizarre error closing $file: $!\nAborting"; chomp; $verbose > 1 and print " Found some pod ($_) in $file\n"; return 1; } } close(MAYBEPOD) || die "Bizarre error closing $file: $!\nAborting"; $verbose > 1 and print " No POD in $file, skipping.\n"; return 0; } #========================================================================== sub _accessorize { # A simple-minded method-maker shift; no strict 'refs'; foreach my $attrname (@_) { *{caller() . '::' . $attrname} = sub { use strict; $Carp::CarpLevel = 1, Carp::croak( "Accessor usage: \$obj->$attrname() or \$obj->$attrname(\$new_value)" ) unless (@_ == 1 or @_ == 2) and ref $_[0]; # Read access: return $_[0]->{$attrname} if @_ == 1; # Write access: $_[0]->{$attrname} = $_[1]; return $_[0]; # RETURNS MYSELF! }; } # Ya know, they say accessories make the ensemble! return; } #========================================================================== sub _state_as_string { my $self = $_[0]; return '' unless ref $self; my @out = "{\n # State of $self ...\n"; foreach my $k (sort keys %$self) { push @out, " ", _esc($k), " => ", _esc($self->{$k}), ",\n"; } push @out, "}\n"; my $x = join '', @out; $x =~ s/^/#/mg; return $x; } sub _esc { my $in = $_[0]; return 'undef' unless defined $in; $in =~ s<([^\x20\x21\x23\x27-\x3F\x41-\x5B\x5D-\x7E])> <'\\x'.(unpack("H2",$1))>eg; return qq{"$in"}; } #========================================================================== run() unless caller; # run if "perl whatever/Search.pm" 1; #========================================================================== __END__ =head1 NAME Pod::Simple::Search - find POD documents in directory trees =head1 SYNOPSIS use Pod::Simple::Search; my $name2path = Pod::Simple::Search->new->limit_glob('LWP::*')->survey; print "Looky see what I found: ", join(' ', sort keys %$name2path), "\n"; print "LWPUA docs = ", Pod::Simple::Search->new->find('LWP::UserAgent') || "?", "\n"; =head1 DESCRIPTION B is a class that you use for running searches for Pod files. An object of this class has several attributes (mostly options for controlling search options), and some methods for searching based on those attributes. The way to use this class is to make a new object of this class, set any options, and then call one of the search options (probably C or C). The sections below discuss the syntaxes for doing all that. =head1 CONSTRUCTOR This class provides the one constructor, called C. It takes no parameters: use Pod::Simple::Search; my $search = Pod::Simple::Search->new; =head1 ACCESSORS This class defines several methods for setting (and, occasionally, reading) the contents of an object. With two exceptions (discussed at the end of this section), these attributes are just for controlling the way searches are carried out. Note that each of these return C<$self> when you call them as C<< $self->I >>. That's so that you can chain together set-attribute calls like this: my $name2path = Pod::Simple::Search->new -> inc(0) -> verbose(1) -> callback(\&blab) ->survey(@there); ...which works exactly as if you'd done this: my $search = Pod::Simple::Search->new; $search->inc(0); $search->verbose(1); $search->callback(\&blab); my $name2path = $search->survey(@there); =over =item $search->inc( I ); This attribute, if set to a true value, means that searches should implicitly add perl's I<@INC> paths. This automatically considers paths specified in the C environment as this is prepended to I<@INC> by the Perl interpreter itself. This attribute's default value is B. If you want to search only specific directories, set $self->inc(0) before calling $inc->survey or $inc->find. =item $search->verbose( I ); This attribute, if set to a nonzero positive value, will make searches output (via C) notes about what they're doing as they do it. This option may be useful for debugging a pod-related module. This attribute's default value is zero, meaning that no C messages are produced. (Setting verbose to 1 turns on some messages, and setting it to 2 turns on even more messages, i.e., makes the following search(es) even more verbose than 1 would make them.) =item $search->limit_glob( I ); This option means that you want to limit the results just to items whose podnames match the given glob/wildcard expression. For example, you might limit your search to just "LWP::*", to search only for modules starting with "LWP::*" (but not including the module "LWP" itself); or you might limit your search to "LW*" to see only modules whose (full) names begin with "LW"; or you might search for "*Find*" to search for all modules with "Find" somewhere in their full name. (You can also use "?" in a glob expression; so "DB?" will match "DBI" and "DBD".) =item $search->callback( I<\&some_routine> ); This attribute means that every time this search sees a matching Pod file, it should call this callback routine. The routine is called with two parameters: the current file's filespec, and its pod name. (For example: C<("/etc/perljunk/File/Crunk.pm", "File::Crunk")> would be in C<@_>.) The callback routine's return value is not used for anything. This attribute's default value is false, meaning that no callback is called. =item $search->laborious( I ); Unless you set this attribute to a true value, Pod::Search will apply Perl-specific heuristics to find the correct module PODs quickly. This attribute's default value is false. You won't normally need to set this to true. Specifically: Turning on this option will disable the heuristics for seeing only files with Perl-like extensions, omitting subdirectories that are numeric but do I match the current Perl interpreter's version ID, suppressing F as a module hierarchy name, etc. =item $search->recurse( I ); Unless you set this attribute to a false value, Pod::Search will recurse into subdirectories of the search directories. =item $search->shadows( I ); Unless you set this attribute to a true value, Pod::Simple::Search will consider only the first file of a given modulename as it looks thru the specified directories; that is, with this option off, if Pod::Simple::Search has seen a C already in this search, then it won't bother looking at a C later on in that search, because that file is merely a "shadow". But if you turn on C<< $self->shadows(1) >>, then these "shadow" files are inspected too, and are noted in the pathname2podname return hash. This attribute's default value is false; and normally you won't need to turn it on. =item $search->is_case_insensitive( I ); Pod::Simple::Search will by default internally make an assumption based on the underlying filesystem where the class file is found whether it is case insensitive or not. If it is determined to be case insensitive, during survey() it may skip pod files/modules that happen to be equal to names it's already seen, ignoring case. However, it's possible to have distinct files in different directories that intentionally has the same name, just differing in case, that should be reported. Hence, you may force the behavior by setting this to true or false. =item $search->limit_re( I ); Setting this attribute (to a value that's a regexp) means that you want to limit the results just to items whose podnames match the given regexp. Normally this option is not needed, and the more efficient C attribute is used instead. =item $search->dir_prefix( I ); Setting this attribute to a string value means that the searches should begin in the specified subdirectory name (like "Pod" or "File::Find", also expressible as "File/Find"). For example, the search option C<< $search->limit_glob("File::Find::R*") >> is the same as the combination of the search options C<< $search->limit_re("^File::Find::R") -> dir_prefix("File::Find") >>. Normally you don't need to know about the C option, but I include it in case it might prove useful for someone somewhere. (Implementationally, searching with limit_glob ends up setting limit_re and usually dir_prefix.) =item $search->progress( I ); If you set a value for this attribute, the value is expected to be an object (probably of a class that you define) that has a C method and a C method. This is meant for reporting progress during the search, if you don't want to use a simple callback. Normally you don't need to know about the C option, but I include it in case it might prove useful for someone somewhere. While a search is in progress, the progress object's C and C methods are called like this: # Every time a file is being scanned for pod: $progress->reach($count, "Scanning $file"); ++$count; # And then at the end of the search: $progress->done("Noted $count Pod files total"); Internally, we often set this to an object of class Pod::Simple::Progress. That class is probably undocumented, but you may wish to look at its source. =item $name2path = $self->name2path; This attribute is not a search parameter, but is used to report the result of C method, as discussed in the next section. =item $path2name = $self->path2name; This attribute is not a search parameter, but is used to report the result of C method, as discussed in the next section. =back =head1 MAIN SEARCH METHODS Once you've actually set any options you want (if any), you can go ahead and use the following methods to search for Pod files in particular ways. =head2 C<< $search->survey( @directories ) >> The method C searches for POD documents in a given set of files and/or directories. This runs the search according to the various options set by the accessors above. (For example, if the C attribute is on, as it is by default, then the perl @INC directories are implicitly added to the list of directories (if any) that you specify.) The return value of C is two hashes: =over =item C A hash that maps from each pod-name to the filespec (like "Stuff::Thing" => "/whatever/plib/Stuff/Thing.pm") =item C A hash that maps from each Pod filespec to its pod-name (like "/whatever/plib/Stuff/Thing.pm" => "Stuff::Thing") =back Besides saving these hashes as the hashref attributes C and C, calling this function also returns these hashrefs. In list context, the return value of C<< $search->survey >> is the list C<(\%name2path, \%path2name)>. In scalar context, the return value is C<\%name2path>. Or you can just call this in void context. Regardless of calling context, calling C saves its results in its C and C attributes. E.g., when searching in F<$HOME/perl5lib>, the file F<$HOME/perl5lib/MyModule.pm> would get the POD name I, whereas F<$HOME/perl5lib/Myclass/Subclass.pm> would be I. The name information can be used for POD translators. Only text files containing at least one valid POD command are found. In verbose mode, a warning is printed if shadows are found (i.e., more than one POD file with the same POD name is found, e.g. F in different directories). This usually indicates duplicate occurrences of modules in the I<@INC> search path, which is occasionally inadvertent (but is often simply a case of a user's path dir having a more recent version than the system's general path dirs in general.) The options to this argument is a list of either directories that are searched recursively, or files. (Usually you wouldn't specify files, but just dirs.) Or you can just specify an empty-list, as in $name2path; with the C option on, as it is by default. The POD names of files are the plain basenames with any Perl-like extension (.pm, .pl, .pod) stripped, and path separators replaced by C<::>'s. Calling Pod::Simple::Search->search(...) is short for Pod::Simple::Search->new->search(...). That is, a throwaway object with default attribute values is used. =head2 C<< $search->simplify_name( $str ) >> The method B is equivalent to B, but also strips Perl-like extensions (.pm, .pl, .pod) and extensions like F<.bat>, F<.cmd> on Win32 and OS/2, or F<.com> on VMS, respectively. =head2 C<< $search->find( $pod ) >> =head2 C<< $search->find( $pod, @search_dirs ) >> Returns the location of a Pod file, given a Pod/module/script name (like "Foo::Bar" or "perlvar" or "perldoc"), and an idea of what files/directories to look in. It searches according to the various options set by the accessors above. (For example, if the C attribute is on, as it is by default, then the perl @INC directories are implicitly added to the list of directories (if any) that you specify.) This returns the full path of the first occurrence to the file. Package names (eg 'A::B') are automatically converted to directory names in the selected directory. Additionally, '.pm', '.pl' and '.pod' are automatically appended to the search as required. (So, for example, under Unix, "A::B" is converted to "somedir/A/B.pm", "somedir/A/B.pod", or "somedir/A/B.pl", as appropriate.) If no such Pod file is found, this method returns undef. If any of the given search directories contains a F subdirectory, then it is searched. (That's how we manage to find F, for example, which is usually in F in most Perl dists.) The C and C attributes influence the behavior of this search; notably, C, if true, adds @INC I to the list of directories to search. It is common to simply say C<< $filename = Pod::Simple::Search-> new ->find("perlvar") >> so that just the @INC (well, and scriptdir) directories are searched. (This happens because the C attribute is true by default.) Calling Pod::Simple::Search->find(...) is short for Pod::Simple::Search->new->find(...). That is, a throwaway object with default attribute values is used. =head2 C<< $self->contains_pod( $file ) >> Returns true if the supplied filename (not POD module) contains some Pod documentation. =head1 SUPPORT Questions or discussion about POD and Pod::Simple should be sent to the pod-people@perl.org mail list. Send an empty email to pod-people-subscribe@perl.org to subscribe. This module is managed in an open GitHub repository, L. Feel free to fork and contribute, or to clone L and send patches! Patches against Pod::Simple are welcome. Please send bug reports to . =head1 COPYRIGHT AND DISCLAIMERS Copyright (c) 2002 Sean M. Burke. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. This program is distributed in the hope that it will be useful, but without any warranty; without even the implied warranty of merchantability or fitness for a particular purpose. =head1 AUTHOR Pod::Simple was created by Sean M. Burke with code borrowed from Marek Rouchal's L, which in turn heavily borrowed code from Nick Ing-Simmons' C. But don't bother him, he's retired. Pod::Simple is maintained by: =over =item * Allison Randal C =item * Hans Dieter Pearcey C =item * David E. Wheeler C =back =cut Pod-Simple-3.45/lib/Pod/Simple/HTML.pm0000644000175000017500000010347514427237107015426 0ustar khwkhwpackage Pod::Simple::HTML; use strict; use warnings; use Pod::Simple::PullParser (); our @ISA = ('Pod::Simple::PullParser'); our $VERSION = '3.45'; BEGIN { if(defined &DEBUG) { } # no-op elsif( defined &Pod::Simple::DEBUG ) { *DEBUG = \&Pod::Simple::DEBUG } else { *DEBUG = sub () {0}; } } our $Doctype_decl ||= ''; # No. Just No. Don't even ask me for it. # qq{\n}; our $Content_decl ||= q{}; our $HTML_EXTENSION; $HTML_EXTENSION = '.html' unless defined $HTML_EXTENSION; our $Computerese; $Computerese = "" unless defined $Computerese; our $LamePad; $LamePad = '' unless defined $LamePad; our $Linearization_Limit; $Linearization_Limit = 120 unless defined $Linearization_Limit; # headings/items longer than that won't get an our $Perldoc_URL_Prefix; $Perldoc_URL_Prefix = 'https://metacpan.org/pod/' unless defined $Perldoc_URL_Prefix; our $Perldoc_URL_Postfix; $Perldoc_URL_Postfix = '' unless defined $Perldoc_URL_Postfix; our $Man_URL_Prefix = 'http://man.he.net/man'; our $Man_URL_Postfix = ''; our $Title_Prefix; $Title_Prefix = '' unless defined $Title_Prefix; our $Title_Postfix; $Title_Postfix = '' unless defined $Title_Postfix; our %ToIndex = map {; $_ => 1 } qw(head1 head2 head3 head4 ); # item-text # 'item-text' stuff in the index doesn't quite work, and may # not be a good idea anyhow. __PACKAGE__->_accessorize( 'perldoc_url_prefix', # In turning L into http://whatever/Foo%3a%3aBar, what # to put before the "Foo%3a%3aBar". # (for singleton mode only?) 'perldoc_url_postfix', # what to put after "Foo%3a%3aBar" in the URL. Normally "". 'man_url_prefix', # In turning L into http://whatever/man/1/crontab, what # to put before the "1/crontab". 'man_url_postfix', # what to put after the "1/crontab" in the URL. Normally "". 'batch_mode', # whether we're in batch mode 'batch_mode_current_level', # When in batch mode, how deep the current module is: 1 for "LWP", # 2 for "LWP::Procotol", 3 for "LWP::Protocol::GHTTP", etc 'title_prefix', 'title_postfix', # What to put before and after the title in the head. # Should already be &-escaped 'html_h_level', 'html_header_before_title', 'html_header_after_title', 'html_footer', 'top_anchor', 'index', # whether to add an index at the top of each page # (actually it's a table-of-contents, but we'll call it an index, # out of apparently longstanding habit) 'html_css', # URL of CSS file to point to 'html_javascript', # URL of Javascript file to point to 'force_title', # should already be &-escaped 'default_title', # should already be &-escaped ); #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ my @_to_accept; our %Tagmap = ( 'Verbatim' => "\n", '/Verbatim' => "\n", 'VerbatimFormatted' => "\n", '/VerbatimFormatted' => "\n", 'VerbatimB' => "", '/VerbatimB' => "", 'VerbatimI' => "", '/VerbatimI' => "", 'VerbatimBI' => "", '/VerbatimBI' => "", 'Data' => "\n", '/Data' => "\n", 'head1' => "\n

    ", # And also stick in an 'head2' => "\n

    ", # '' 'head3' => "\n

    ", # '' 'head4' => "\n

    ", # '' 'head5' => "\n

    ", # '' 'head6' => "\n
    ", # '' '/head1' => "
    \n", '/head2' => "

    \n", '/head3' => "\n", '/head4' => "\n", '/head5' => "\n", '/head6' => "\n", 'X' => "", changes(qw( Para=p B=b I=i over-bullet=ul over-number=ol over-text=dl over-block=blockquote item-bullet=li item-number=li item-text=dt )), changes2( map {; m/^([-a-z]+)/s && push @_to_accept, $1; $_ } qw[ sample=samp definition=dfn keyboard=kbd variable=var citation=cite abbreviation=abbr acronym=acronym subscript=sub superscript=sup big=big small=small underline=u strikethrough=s preformat=pre teletype=tt ] # no point in providing a way to get ..., I think ), '/item-bullet' => "$LamePad\n", '/item-number' => "$LamePad\n", '/item-text' => "$LamePad\n", 'item-body' => "\n
    ", '/item-body' => "
    \n", 'B' => "", '/B' => "", 'I' => "", '/I' => "", 'F' => "", '/F' => "", 'C' => "", '/C' => "    ", 'L' => "", # ideally never used! '/L' => "", ); sub changes { return map {; m/^([-_:0-9a-zA-Z]+)=([-_:0-9a-zA-Z]+)$/s ? ( $1, => "\n<$2>", "/$1", => "\n" ) : die "Funky $_" } @_; } sub changes2 { return map {; m/^([-_:0-9a-zA-Z]+)=([-_:0-9a-zA-Z]+)$/s ? ( $1, => "<$2>", "/$1", => "" ) : die "Funky $_" } @_; } #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ sub go { Pod::Simple::HTML->parse_from_file(@ARGV); exit 0 } # Just so we can run from the command line. No options. # For that, use perldoc! #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ sub new { my $new = shift->SUPER::new(@_); #$new->nix_X_codes(1); $new->nbsp_for_S(1); $new->accept_targets( 'html', 'HTML' ); $new->accept_codes('VerbatimFormatted'); $new->accept_codes(@_to_accept); DEBUG > 2 and print STDERR "To accept: ", join(' ',@_to_accept), "\n"; $new->perldoc_url_prefix( $Perldoc_URL_Prefix ); $new->perldoc_url_postfix( $Perldoc_URL_Postfix ); $new->man_url_prefix( $Man_URL_Prefix ); $new->man_url_postfix( $Man_URL_Postfix ); $new->title_prefix( $Title_Prefix ); $new->title_postfix( $Title_Postfix ); $new->html_header_before_title( qq[$Doctype_decl] ); $new->html_header_after_title( join "\n" => "", $Content_decl, "\n", $new->version_tag_comment, "\n", ); $new->html_footer( qq[\n\n\n\n] ); $new->top_anchor( "\n" ); $new->{'Tagmap'} = {%Tagmap}; return $new; } sub __adjust_html_h_levels { my ($self) = @_; my $Tagmap = $self->{'Tagmap'}; my $add = $self->html_h_level; return unless defined $add; return if ($self->{'Adjusted_html_h_levels'}||0) == $add; $add -= 1; for (1 .. 6) { $Tagmap->{"head$_"} =~ s/$_/$_ + $add/e; $Tagmap->{"/head$_"} =~ s/$_/$_ + $add/e; } } sub batch_mode_page_object_init { my($self, $batchconvobj, $module, $infile, $outfile, $depth) = @_; DEBUG and print STDERR "Initting $self\n for $module\n", " in $infile\n out $outfile\n depth $depth\n"; $self->batch_mode(1); $self->batch_mode_current_level($depth); return $self; } sub run { my $self = $_[0]; return $self->do_middle if $self->bare_output; return $self->do_beginning && $self->do_middle && $self->do_end; } #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ sub do_beginning { my $self = $_[0]; my $title; if(defined $self->force_title) { $title = $self->force_title; DEBUG and print STDERR "Forcing title to be $title\n"; } else { # Actually try looking for the title in the document: $title = $self->get_short_title(); unless($self->content_seen) { DEBUG and print STDERR "No content seen in search for title.\n"; return; } $self->{'Title'} = $title; if(defined $title and $title =~ m/\S/) { $title = $self->title_prefix . esc($title) . $self->title_postfix; } else { $title = $self->default_title; $title = '' unless defined $title; DEBUG and print STDERR "Title defaults to $title\n"; } } my $after = $self->html_header_after_title || ''; if($self->html_css) { my $link = $self->html_css =~ m/html_css # It's a big blob of markup, let's drop it in : sprintf( # It's just a URL, so let's wrap it up qq[\n], $self->html_css, ); $after =~ s{()}{$link\n$1}i; # otherwise nevermind } $self->_add_top_anchor(\$after); if($self->html_javascript) { my $link = $self->html_javascript =~ m/html_javascript # It's a big blob of markup, let's drop it in : sprintf( # It's just a URL, so let's wrap it up qq[\n], $self->html_javascript, ); $after =~ s{()}{$link\n$1}i; # otherwise nevermind } print {$self->{'output_fh'}} $self->html_header_before_title || '', $title, # already escaped $after, ; DEBUG and print STDERR "Returning from do_beginning...\n"; return 1; } sub _add_top_anchor { my($self, $text_r) = @_; unless($$text_r and $$text_r =~ m/name=['"]___top['"]/) { # a hack $$text_r .= $self->top_anchor || ''; } return; } sub version_tag_comment { my $self = shift; return sprintf "\n", esc( ref($self), $self->VERSION(), $ISA[0], $ISA[0]->VERSION(), $], scalar(gmtime($ENV{SOURCE_DATE_EPOCH} || time)), ), $self->_modnote(), ; } sub _modnote { my $class = ref($_[0]) || $_[0]; return join "\n " => grep m/\S/, split "\n", qq{ If you want to change this HTML document, you probably shouldn't do that by changing it directly. Instead, see about changing the calling options to $class, and/or subclassing $class, then reconverting this document from the Pod source. When in doubt, email the author of $class for advice. See 'perldoc $class' for more info. }; } sub do_end { my $self = $_[0]; print {$self->{'output_fh'}} $self->html_footer || ''; return 1; } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Normally this would just be a call to _do_middle_main_loop -- but we # have to do some elaborate things to emit all the content and then # summarize it and output it /before/ the content that it's a summary of. sub do_middle { my $self = $_[0]; return $self->_do_middle_main_loop unless $self->index; if( $self->output_string ) { # An efficiency hack my $out = $self->output_string; #it's a reference to it my $sneakytag = "\f\f\e\e\b\bIndex Here\e\e\b\b\f\f\n"; $$out .= $sneakytag; $self->_do_middle_main_loop; $sneakytag = quotemeta($sneakytag); my $index = $self->index_as_html(); if( $$out =~ s/$sneakytag/$index/s ) { # Expected case DEBUG and print STDERR "Inserted ", length($index), " bytes of index HTML into $out.\n"; } else { DEBUG and print STDERR "Odd, couldn't find where to insert the index in the output!\n"; # I don't think this should ever happen. } return 1; } unless( $self->output_fh ) { require Carp; Carp::confess("Parser object \$p doesn't seem to have any output object! I don't know how to deal with that."); } # If we get here, we're outputting to a FH. So we need to do some magic. # Namely, divert all content to a string, which we output after the index. my $fh = $self->output_fh; my $content = ''; { # Our horrible bait and switch: $self->output_string( \$content ); $self->_do_middle_main_loop; $self->abandon_output_string(); $self->output_fh($fh); } print $fh $self->index_as_html(); print $fh $content; return 1; } ########################################################################### sub index_as_html { my $self = $_[0]; # This is meant to be called AFTER the input document has been parsed! my $points = $self->{'PSHTML_index_points'} || []; @$points > 1 or return qq[
    \n]; # There's no point in having a 0-item or 1-item index, I dare say. my(@out) = qq{\n
    }; my $level = 0; my( $target_level, $previous_tagname, $tagname, $text, $anchorname, $indent); foreach my $p (@$points, ['head0', '(end)']) { ($tagname, $text) = @$p; $anchorname = $self->section_escape($text); if( $tagname =~ m{^head(\d+)$} ) { $target_level = 0 + $1; } else { # must be some kinda list item if($previous_tagname =~ m{^head\d+$} ) { $target_level = $level + 1; } else { $target_level = $level; # no change needed } } # Get to target_level by opening or closing ULs while($level > $target_level) { --$level; push @out, (" " x $level) . ""; } while($level < $target_level) { ++$level; push @out, (" " x ($level-1)) . "
      "; } $previous_tagname = $tagname; next unless $level; $indent = ' ' x $level; push @out, sprintf "%s
    • %s", $indent, $level, esc($anchorname), esc($text) ; } push @out, "
    \n"; return join "\n", @out; } ########################################################################### sub _do_middle_main_loop { my $self = $_[0]; my $fh = $self->{'output_fh'}; my $tagmap = $self->{'Tagmap'}; $self->__adjust_html_h_levels; my($token, $type, $tagname, $linkto, $linktype); my @stack; my $dont_wrap = 0; while($token = $self->get_token) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if( ($type = $token->type) eq 'start' ) { if(($tagname = $token->tagname) eq 'L') { $linktype = $token->attr('type') || 'insane'; $linkto = $self->do_link($token); if(defined $linkto and length $linkto) { esc($linkto); # (Yes, SGML-escaping applies on top of %-escaping! # But it's rarely noticeable in practice.) print $fh qq{}; } else { print $fh ""; # Yes, an 'a' element with no attributes! } } elsif ($tagname eq 'item-text' or $tagname =~ m/^head\d$/s) { print $fh $tagmap->{$tagname} || next; my @to_unget; while(1) { push @to_unget, $self->get_token; last if $to_unget[-1]->is_end and $to_unget[-1]->tagname eq $tagname; # TODO: support for X<...>'s found in here? (maybe hack into linearize_tokens) } my $name = $self->linearize_tokens(@to_unget); $name = $self->do_section($name, $token) if defined $name; print $fh "index ? " href='#___top' title='click to go to top of document'\n" : "\n"; } if(defined $name) { my $esc = esc( $self->section_name_tidy( $name ) ); print $fh qq[name="$esc"]; DEBUG and print STDERR "Linearized ", scalar(@to_unget), " tokens as \"$name\".\n"; push @{ $self->{'PSHTML_index_points'} }, [$tagname, $name] if $ToIndex{ $tagname }; # Obviously, this discards all formatting codes (saving # just their content), but ahwell. } else { # ludicrously long, so nevermind DEBUG and print STDERR "Linearized ", scalar(@to_unget), " tokens, but it was too long, so nevermind.\n"; } print $fh "\n>"; $self->unget_token(@to_unget); } elsif ($tagname eq 'Data') { my $next = $self->get_token; next unless defined $next; unless( $next->type eq 'text' ) { $self->unget_token($next); next; } DEBUG and print STDERR " raw text ", $next->text, "\n"; # The parser sometimes preserves newlines and sometimes doesn't! (my $text = $next->text) =~ s/\n\z//; print $fh $text, "\n"; next; } else { if( $tagname =~ m/^over-/s ) { push @stack, ''; } elsif( $tagname =~ m/^item-/s and @stack and $stack[-1] ) { print $fh $stack[-1]; $stack[-1] = ''; } print $fh $tagmap->{$tagname} || next; ++$dont_wrap if $tagname eq 'Verbatim' or $tagname eq "VerbatimFormatted" or $tagname eq 'X'; } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - } elsif( $type eq 'end' ) { if( ($tagname = $token->tagname) =~ m/^over-/s ) { if( my $end = pop @stack ) { print $fh $end; } } elsif( $tagname =~ m/^item-/s and @stack) { $stack[-1] = $tagmap->{"/$tagname"}; if( $tagname eq 'item-text' and defined(my $next = $self->get_token) ) { $self->unget_token($next); if( $next->type eq 'start' ) { print $fh $tagmap->{"/item-text"},$tagmap->{"item-body"}; $stack[-1] = $tagmap->{"/item-body"}; } } next; } print $fh $tagmap->{"/$tagname"} || next; --$dont_wrap if $tagname eq 'Verbatim' or $tagname eq 'X'; # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - } elsif( $type eq 'text' ) { esc($type = $token->text); # reuse $type, why not $type =~ s/([\?\!\"\'\.\,]) /$1\n/g unless $dont_wrap; print $fh $type; } } return 1; } ########################################################################### # sub do_section { my($self, $name, $token) = @_; return $name; } sub do_link { my($self, $token) = @_; my $type = $token->attr('type'); if(!defined $type) { $self->whine("Typeless L!?", $token->attr('start_line')); } elsif( $type eq 'pod') { return $self->do_pod_link($token); } elsif( $type eq 'url') { return $self->do_url_link($token); } elsif( $type eq 'man') { return $self->do_man_link($token); } else { $self->whine("L of unknown type $type!?", $token->attr('start_line')); } return 'FNORG'; # should never get called } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - sub do_url_link { return $_[1]->attr('to') } sub do_man_link { my ($self, $link) = @_; my $to = $link->attr('to'); my $frag = $link->attr('section'); return undef unless defined $to and length $to; # should never happen $frag = $self->section_escape($frag) if defined $frag and length($frag .= ''); # (stringify) DEBUG and print STDERR "Resolving \"$to/$frag\"\n\n"; return $self->resolve_man_page_link($to, $frag); } sub do_pod_link { # And now things get really messy... my($self, $link) = @_; my $to = $link->attr('to'); my $section = $link->attr('section'); return undef unless( # should never happen (defined $to and length $to) or (defined $section and length $section) ); $section = $self->section_escape($section) if defined $section and length($section .= ''); # (stringify) DEBUG and printf STDERR "Resolving \"%s\" \"%s\"...\n", $to || "(nil)", $section || "(nil)"; { # An early hack: my $complete_url = $self->resolve_pod_link_by_table($to, $section); if( $complete_url ) { DEBUG > 1 and print STDERR "resolve_pod_link_by_table(T,S) gives ", $complete_url, "\n (Returning that.)\n"; return $complete_url; } else { DEBUG > 4 and print STDERR " resolve_pod_link_by_table(T,S)", " didn't return anything interesting.\n"; } } if(defined $to and length $to) { # Give this routine first hack again my $there = $self->resolve_pod_link_by_table($to); if(defined $there and length $there) { DEBUG > 1 and print STDERR "resolve_pod_link_by_table(T) gives $there\n"; } else { $there = $self->resolve_pod_page_link($to, $section); # (I pass it the section value, but I don't see a # particular reason it'd use it.) DEBUG > 1 and print STDERR "resolve_pod_page_link gives ", $there || "(nil)", "\n"; unless( defined $there and length $there ) { DEBUG and print STDERR "Can't resolve $to\n"; return undef; } # resolve_pod_page_link returning undef is how it # can signal that it gives up on making a link } $to = $there; } #DEBUG and print STDERR "So far [", $to||'nil', "] [", $section||'nil', "]\n"; my $out = (defined $to and length $to) ? $to : ''; $out .= "#" . $section if defined $section and length $section; unless(length $out) { # sanity check DEBUG and printf STDERR "Oddly, couldn't resolve \"%s\" \"%s\"...\n", $to || "(nil)", $section || "(nil)"; return undef; } DEBUG and print STDERR "Resolved to $out\n"; return $out; } # . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . sub section_escape { my($self, $section) = @_; return $self->section_url_escape( $self->section_name_tidy($section) ); } sub section_name_tidy { my($self, $section) = @_; $section =~ s/^\s+//; $section =~ s/\s+$//; $section =~ tr/ /_/; if ($] ge 5.006) { $section =~ s/[[:cntrl:][:^ascii:]]//g; # drop crazy characters } elsif ('A' eq chr(65)) { # But not on early EBCDIC $section =~ tr/\x00-\x1F\x80-\x9F//d; } $section = $self->unicode_escape_url($section); $section = '_' unless length $section; return $section; } sub section_url_escape { shift->general_url_escape(@_) } sub pagepath_url_escape { shift->general_url_escape(@_) } sub manpage_url_escape { shift->general_url_escape(@_) } sub general_url_escape { my($self, $string) = @_; $string =~ s/([^\x00-\xFF])/join '', map sprintf('%%%02X',$_), unpack 'C*', $1/eg; # express Unicode things as urlencode(utf(orig)). # A pretty conservative escaping, behoovey even for query components # of a URL (see RFC 2396) if ($] ge 5.007_003) { $string =~ s/([^-_\.!~*()abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/sprintf('%%%02X',utf8::native_to_unicode(ord($1)))/eg; } else { # Is broken for non-ASCII platforms on early perls $string =~ s/([^-_\.!~*()abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/sprintf('%%%02X',ord($1))/eg; } # Yes, stipulate the list without a range, so that this can work right on # all charsets that this module happens to run under. return $string; } #-------------------------------------------------------------------------- # # Oh look, a yawning portal to Hell! Let's play touch football right by it! # sub resolve_pod_page_link { # resolve_pod_page_link must return a properly escaped URL my $self = shift; return $self->batch_mode() ? $self->resolve_pod_page_link_batch_mode(@_) : $self->resolve_pod_page_link_singleton_mode(@_) ; } sub resolve_pod_page_link_singleton_mode { my($self, $it) = @_; return undef unless defined $it and length $it; my $url = $self->pagepath_url_escape($it); $url =~ s{::$}{}s; # probably never comes up anyway $url =~ s{::}{/}g unless $self->perldoc_url_prefix =~ m/\?/s; # sane DWIM? return undef unless length $url; return $self->perldoc_url_prefix . $url . $self->perldoc_url_postfix; } sub resolve_pod_page_link_batch_mode { my($self, $to) = @_; DEBUG > 1 and print STDERR " During batch mode, resolving $to ...\n"; my @path = grep length($_), split m/::/s, $to, -1; unless( @path ) { # sanity DEBUG and print STDERR "Very odd! Splitting $to gives (nil)!\n"; return undef; } $self->batch_mode_rectify_path(\@path); my $out = join('/', map $self->pagepath_url_escape($_), @path) . $HTML_EXTENSION; DEBUG > 1 and print STDERR " => $out\n"; return $out; } sub batch_mode_rectify_path { my($self, $pathbits) = @_; my $level = $self->batch_mode_current_level; $level--; # how many levels up to go to get to the root if($level < 1) { unshift @$pathbits, '.'; # just to be pretty } else { unshift @$pathbits, ('..') x $level; } return; } sub resolve_man_page_link { my ($self, $to, $frag) = @_; my ($page, $section) = $to =~ /^([^(]+)(?:[(](\d+)[)])?$/; return undef unless defined $page and length $page; $section ||= 1; return $self->man_url_prefix . "$section/" . $self->manpage_url_escape($page) . $self->man_url_postfix; } #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ sub resolve_pod_link_by_table { # A crazy hack to allow specifying custom L => URL mappings return unless $_[0]->{'podhtml_LOT'}; # An optimizy shortcut my($self, $to, $section) = @_; # TODO: add a method that actually populates podhtml_LOT from a file? if(defined $section) { $to = '' unless defined $to and length $to; return $self->{'podhtml_LOT'}{"$to#$section"}; # quite possibly undef! } else { return $self->{'podhtml_LOT'}{$to}; # quite possibly undef! } return; } ########################################################################### sub linearize_tokens { # self, tokens my $self = shift; my $out = ''; my $t; while($t = shift @_) { if(!ref $t or !UNIVERSAL::can($t, 'is_text')) { $out .= $t; # a string, or some insane thing } elsif($t->is_text) { $out .= $t->text; } elsif($t->is_start and $t->tag eq 'X') { # Ignore until the end of this X<...> sequence: my $x_open = 1; while($x_open) { next if( ($t = shift @_)->is_text ); if( $t->is_start and $t->tag eq 'X') { ++$x_open } elsif($t->is_end and $t->tag eq 'X') { --$x_open } } } } return undef if length $out > $Linearization_Limit; return $out; } #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ sub unicode_escape_url { my($self, $string) = @_; $string =~ s/([^\x00-\xFF])/'('.ord($1).')'/eg; # Turn char 1234 into "(1234)" return $string; } #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ sub esc { # a function. if(defined wantarray) { if(wantarray) { @_ = splice @_; # break aliasing } else { my $x = shift; if ($] ge 5.007_003) { $x =~ s/([^-\n\t !\#\$\%\(\)\*\+,\.\~\/\:\;=\?\@\[\\\]\^_\`\{\|\}abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/'&#'.(utf8::native_to_unicode(ord($1))).';'/eg; } else { # Is broken for non-ASCII platforms on early perls $x =~ s/([^-\n\t !\#\$\%\(\)\*\+,\.\~\/\:\;=\?\@\[\\\]\^_\`\{\|\}abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/'&#'.(ord($1)).';'/eg; } return $x; } } foreach my $x (@_) { # Escape things very cautiously: if (defined $x) { if ($] ge 5.007_003) { $x =~ s/([^-\n\t !\#\$\%\(\)\*\+,\.\~\/\:\;=\?\@\[\\\]\^_\`\{\|\}abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/'&#'.(utf8::native_to_unicode(ord($1))).';'/eg } else { # Is broken for non-ASCII platforms on early perls $x =~ s/([^-\n\t !\#\$\%\(\)\*\+,\.\~\/\:\;=\?\@\[\\\]\^_\`\{\|\}abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/'&#'.(ord($1)).';'/eg } } # Leave out "- so that "--" won't make it thru in X-generated comments # with text in them. # Yes, stipulate the list without a range, so that this can work right on # all charsets that this module happens to run under. } return @_; } #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1; __END__ =head1 NAME Pod::Simple::HTML - convert Pod to HTML =head1 SYNOPSIS perl -MPod::Simple::HTML -e Pod::Simple::HTML::go thingy.pod =head1 DESCRIPTION This class is for making an HTML rendering of a Pod document. This is a subclass of L and inherits all its methods (and options). Note that if you want to do a batch conversion of a lot of Pod documents to HTML, you should see the module L. =head1 CALLING FROM THE COMMAND LINE TODO perl -MPod::Simple::HTML -e Pod::Simple::HTML::go Thing.pod Thing.html =head1 CALLING FROM PERL =head2 Minimal code use Pod::Simple::HTML; my $p = Pod::Simple::HTML->new; $p->output_string(\my $html); $p->parse_file('path/to/Module/Name.pm'); open my $out, '>', 'out.html' or die "Cannot open 'out.html': $!\n"; print $out $html; =head2 More detailed example use Pod::Simple::HTML; Set the content type: $Pod::Simple::HTML::Content_decl = q{}; my $p = Pod::Simple::HTML->new; Include a single javascript source: $p->html_javascript('http://abc.com/a.js'); Or insert multiple javascript source in the header (or for that matter include anything, thought this is not recommended) $p->html_javascript(' '); Include a single css source in the header: $p->html_css('/style.css'); or insert multiple css sources: $p->html_css(' '); Tell the parser where should the output go. In this case it will be placed in the $html variable: my $html; $p->output_string(\$html); Parse and process a file with pod in it: $p->parse_file('path/to/Module/Name.pm'); =head1 METHODS TODO all (most?) accessorized methods The following variables need to be set B the call to the ->new constructor. Set the string that is included before the opening tag: $Pod::Simple::HTML::Doctype_decl = qq{\n}; Set the content-type in the HTML head: (defaults to ISO-8859-1) $Pod::Simple::HTML::Content_decl = q{}; Set the value that will be embedded in the opening tags of F, C tags and verbatim text. F maps to , C maps to , Verbatim text maps to 
     (Computerese defaults to "")

  $Pod::Simple::HTML::Computerese =  ' class="some_class_name';

=head2 html_css

=head2 html_javascript

=head2 title_prefix

=head2 title_postfix

=head2 html_header_before_title

This includes everything before the  opening tag including the Document type
and including the opening <title> tag. The following call will set it to be a simple HTML
file:

  $p->html_header_before_title('<html><head><title>');

=head2 top_anchor

By default Pod::Simple::HTML adds a dummy anchor at the top of the HTML.
You can change it by calling

  $p->top_anchor('<a name="zz" >');

=head2 html_h_level

Normally =head1 will become <h1>, =head2 will become <h2> etc.
Using the html_h_level method will change these levels setting the h level
of =head1 tags:

  $p->html_h_level(3);

Will make sure that =head1 will become <h3> and =head2 will become <h4> etc...


=head2 index

Set it to some true value if you want to have an index (in reality a table of contents)
to be added at the top of the generated HTML.

  $p->index(1);

=head2 html_header_after_title

Includes the closing tag of  and through the rest of the head
till the opening of the body

  $p->html_header_after_title('...');

=head2 html_footer

The very end of the document:

  $p->html_footer( qq[\n\n\n\n] );

=head1 SUBCLASSING

Can use any of the methods described above but for further customization
one needs to override some of the methods:

  package My::Pod;
  use strict;
  use warnings;

  use base 'Pod::Simple::HTML';

  # needs to return a URL string such
  # http://some.other.com/page.html
  # #anchor_in_the_same_file
  # /internal/ref.html
  sub do_pod_link {
    # My::Pod object and Pod::Simple::PullParserStartToken object
    my ($self, $link) = @_;

    say $link->tagname;          # will be L for links
    say $link->attr('to');       #
    say $link->attr('type');     # will be 'pod' always
    say $link->attr('section');

    # Links local to our web site
    if ($link->tagname eq 'L' and $link->attr('type') eq 'pod') {
      my $to = $link->attr('to');
      if ($to =~ /^Padre::/) {
          $to =~ s{::}{/}g;
          return "/docs/Padre/$to.html";
      }
    }

    # all other links are generated by the parent class
    my $ret = $self->SUPER::do_pod_link($link);
    return $ret;
  }

  1;

Meanwhile in script.pl:

  use My::Pod;

  my $p = My::Pod->new;

  my $html;
  $p->output_string(\$html);
  $p->parse_file('path/to/Module/Name.pm');
  open my $out, '>', 'out.html' or die;
  print $out $html;

TODO

maybe override do_beginning do_end

=head1 SEE ALSO

L, L

TODO: a corpus of sample Pod input and HTML output?  Or common
idioms?

=head1 SUPPORT

Questions or discussion about POD and Pod::Simple should be sent to the
pod-people@perl.org mail list. Send an empty email to
pod-people-subscribe@perl.org to subscribe.

This module is managed in an open GitHub repository,
L. Feel free to fork and contribute, or
to clone L and send patches!

Patches against Pod::Simple are welcome. Please send bug reports to
.

=head1 COPYRIGHT AND DISCLAIMERS

Copyright (c) 2002-2004 Sean M. Burke.

This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

This program is distributed in the hope that it will be useful, but
without any warranty; without even the implied warranty of
merchantability or fitness for a particular purpose.

=head1 ACKNOWLEDGEMENTS

Thanks to L for permission to use its
L site for man page links.

Thanks to L for permission to use the
site for Perl module links.

=head1 AUTHOR

Pod::Simple was created by Sean M. Burke .
But don't bother him, he's retired.

Pod::Simple is maintained by:

=over

=item * Allison Randal C

=item * Hans Dieter Pearcey C

=item * David E. Wheeler C

=back

=cut
Pod-Simple-3.45/lib/Pod/Simple/Subclassing.pod0000644000175000017500000010243714427236532017303 0ustar  khwkhw=head1 NAME

Pod::Simple::Subclassing -- write a formatter as a Pod::Simple subclass

=head1 SYNOPSIS

  package Pod::SomeFormatter;
  use Pod::Simple;
  @ISA = qw(Pod::Simple);
  $VERSION = '1.01';
  use strict;

  sub _handle_element_start {
    my($parser, $element_name, $attr_hash_r) = @_;
    ...
  }

  sub _handle_element_end {
    my($parser, $element_name, $attr_hash_r) = @_;
    # NOTE: $attr_hash_r is only present when $element_name is "over" or "begin"
    # The remaining code excerpts will mostly ignore this $attr_hash_r, as it is
    # mostly useless. It is documented where "over-*" and "begin" events are
    # documented.
    ...
  }

  sub _handle_text {
    my($parser, $text) = @_;
    ...
  }
  1;

=head1 DESCRIPTION

This document is about using Pod::Simple to write a Pod processor,
generally a Pod formatter. If you just want to know about using an
existing Pod formatter, instead see its documentation and see also the
docs in L.

B in writing a Pod formatter is to make sure that there
isn't already a decent one in CPAN. See L, and
run a search on the name of the format you want to render to. Also
consider joining the Pod People list
L and asking whether
anyone has a formatter for that format -- maybe someone cobbled one
together but just hasn't released it.

B in writing a Pod processor is to read L,
which contains information on writing a Pod parser (which has been
largely taken care of by Pod::Simple), but also a lot of requirements
and recommendations for writing a formatter.

B is to actually learn the format you're planning to
format to -- or at least as much as you need to know to represent Pod,
which probably isn't much.

B is to pick which of Pod::Simple's interfaces you want to
use:

=over

=item Pod::Simple

The basic L interface that uses C<_handle_element_start()>,
C<_handle_element_end()> and C<_handle_text()>.

=item Pod::Simple::Methody

The L interface is event-based, similar to that of
L or L's "Handlers".

=item Pod::Simple::PullParser

L provides a token-stream interface, sort of
like L's interface.

=item Pod::Simple::SimpleTree

L provides a simple tree interface, rather like
L's "Tree" interface. Users familiar with XML handling will
be comfortable with this interface. Users interested in outputting XML,
should look into the modules that produce an XML representation of the
Pod stream, notably L; you can feed the output
of such a class to whatever XML parsing system you are most at home with.

=back

B is to write your code based on how the events (or tokens,
or tree-nodes, or the XML, or however you're parsing) will map to
constructs in the output format. Also be sure to consider how to escape
text nodes containing arbitrary text, and what to do with text
nodes that represent preformatted text (from verbatim sections).



=head1 Events

TODO intro... mention that events are supplied for implicits, like for
missing >'s

In the following section, we use XML to represent the event structure
associated with a particular construct.  That is, an opening tag
represents the element start, the attributes of that opening tag are
the attributes given to the callback, and the closing tag represents
the end element.

Three callback methods must be supplied by a class extending
L to receive the corresponding event:

=over

=item C<< $parser->_handle_element_start( I, I ) >>

=item C<< $parser->_handle_element_end( I  ) >>

=item C<< $parser->_handle_text(  I  ) >>

=back

Here's the comprehensive list of values you can expect as
I in your implementation of C<_handle_element_start>
and C<_handle_element_end>::

=over

=item events with an element_name of Document

Parsing a document produces this event structure:

  
    ...all events...
  

The value of the I attribute will be the line number of the first
Pod directive in the document.

If there is no Pod in the given document, then the
event structure will be this:

  
  

In that case, the value of the I attribute will not be meaningful;
under current implementations, it will probably be the line number of the
last line in the file.

=item events with an element_name of Para

Parsing a plain (non-verbatim, non-directive, non-data) paragraph in
a Pod document produces this event structure:

    
      ...all events in this paragraph...
    

The value of the I attribute will be the line number of the start
of the paragraph.

For example, parsing this paragraph of Pod:

  The value of the I attribute will be the
  line number of the start of the paragraph.

produces this event structure:

    
      The value of the
      
        start_line
      
      attribute will be the line number of the first Pod directive
      in the document.
    

=item events with an element_name of B, C, F, or I.

Parsing a BE...E formatting code (or of course any of its
semantically identical syntactic variants
SE ... EE>,
or SEEE ... EEEE>, etc.)
produces this event structure:

      
        ...stuff...
      

Currently, there are no attributes conveyed.

Parsing C, F, or I codes produce the same structure, with only a
different element name.

If your parser object has been set to accept other formatting codes,
then they will be presented like these B/C/F/I codes -- i.e., without
any attributes.

=item events with an element_name of S

Normally, parsing an SE...E sequence produces this event
structure, just as if it were a B/C/F/I code:

      
        ...stuff...
      

However, Pod::Simple (and presumably all derived parsers) offers the
C option which, if enabled, will suppress all S events, and
instead change all spaces in the content to non-breaking spaces. This is
intended for formatters that output to a format that has no code that
means the same as SE...E, but which has a code/character that
means non-breaking space.

=item events with an element_name of X

Normally, parsing an XE...E sequence produces this event
structure, just as if it were a B/C/F/I code:

      
        ...stuff...
      

However, Pod::Simple (and presumably all derived parsers) offers the
C option which, if enabled, will suppress all X events
and ignore their content.  For formatters/processors that don't use
X events, this is presumably quite useful.


=item events with an element_name of L

Because the LE...E is the most complex construct in the
language, it should not surprise you that the events it generates are
the most complex in the language. Most of complexity is hidden away in
the attribute values, so for those of you writing a Pod formatter that
produces a non-hypertextual format, you can just ignore the attributes
and treat an L event structure like a formatting element that
(presumably) doesn't actually produce a change in formatting.  That is,
the content of the L event structure (as opposed to its
attributes) is always what text should be displayed.

There are, at first glance, three kinds of L links: URL, man, and pod.

When a LEIE code is parsed, it produces this event
structure:

  
    that_url
  

The C attribute is always specified for this type of
L code.

For example, this Pod source:

  L

produces this event structure:

  
    http://www.perl.com/CPAN/authors/
  

When a LEIE code is parsed (and these are
fairly rare and not terribly useful), it produces this event structure:

  
    manpage(section)
  

The C attribute is always specified for this type of
L code.

For example, this Pod source:

  L

produces this event structure:

  
    crontab(5)
  

In the rare cases where a man page link has a section specified, that text appears
in a I
     attribute. For example, this Pod source:

  L

will produce this event structure:

  
    "ENVIRONMENT" in crontab(5)
  

In the rare case where the Pod document has code like
LEI|IE, then the I will appear
as the content of the element, the I text will appear
only as the value of the I attribute, and there will be no
C attribute (whose presence means that the Pod parser
had to infer what text should appear as the link text -- as opposed to
cases where that attribute is absent, which means that the Pod parser did
I have to infer the link text, because that L code explicitly specified
some link text.)

For example, this Pod source:

  L

will produce this event structure:

  
    hell itself!
  

The last type of L structure is for links to/within Pod documents. It is
the most complex because it can have a I attribute, I a
I
     attribute, or both. The C attribute is always
specified for this type of L code.

In the most common case, the simple case of a LEpodpageE code
produces this event structure:

  
    podpage
  

For example, this Pod source:

  L

produces this event structure:

  
    Net::Ping
  

In cases where there is link-text explicitly specified, it
is to be found in the content of the element (and not the
attributes), just as with the LEI|IE
case discussed above.  For example, this Pod source:

  L

produces this event structure:

  
    Perl Error Messages
  

In cases of links to a section in the current Pod document,
there is a I
     attribute instead of a I attribute.
For example, this Pod source:

  L

produces this event structure:

  
    "Member Data"
  

As another example, this Pod source:

  L

produces this event structure:

  
    the various attributes
  

In cases of links to a section in a different Pod document,
there are both a I
     attribute and a L attribute.
For example, this Pod source:

  L

produces this event structure:

  
    "Basic BLOCKs and Switch Statements" in perlsyn
  

As another example, this Pod source:

  L

produces this event structure:

  
    SWITCH statements
  

Incidentally, note that we do not distinguish between these syntaxes:

  L
  L<"Member Data">
  L
  L    [deprecated syntax]

That is, they all produce the same event structure (for the most part), namely:

  
    "Member Data"
  

The I attribute depends on what the raw content of the CE> is,
so that is why the event structure is the same "for the most part".

If you have not guessed it yet, the I attribute contains the raw,
original, unescaped content of the CE> formatting code. In addition
to the examples above, take notice of the following event structure produced
by the following CE> formatting code.

  L|page/About the C<-M> switch>

  
    click B
  

Specifically, notice that the formatting codes are present and unescaped
in I.

There is a known bug in the I attribute where any surrounding whitespace
is condensed into a single ' '. For example, given LE<60>   linkE<62>, I
will be " link".

=item events with an element_name of E or Z

While there are Pod codes EE...E and ZEE, these
I produce any E or Z events -- that is, there are no such
events as E or Z.

=item events with an element_name of Verbatim

When a Pod verbatim paragraph (AKA "codeblock") is parsed, it
produces this event structure:

  
    ...text...
  

The value of the I attribute will be the line number of the
first line of this verbatim block.  The I attribute is always
present, and always has the value "preserve".

The text content will have tabs already expanded.


=item events with an element_name of head1 .. head4

When a "=head1 ..." directive is parsed, it produces this event
structure:

  
    ...stuff...
  

For example, a directive consisting of this:

  =head1 Options to C et al.

will produce this event structure:

  
    Options to
    
      new
    
    et al.
  

"=head2" through "=head4" directives are the same, except for the element
names in the event structure.

=item events with an element_name of encoding

In the default case, the events corresponding to C<=encoding> directives
are not emitted. They are emitted if C is true.
In that case they produce event structures like
L above.

=item events with an element_name of over-bullet

When an "=over ... Z<>=back" block is parsed where the items are
a bulleted list, it will produce this event structure:

  
    
      ...Stuff...
    
    ...more item-bullets...
  

The attribute I is only present if it is a true value; it is not
present if it is a false value. It is shown in the above example to illustrate
where the attribute is (in the B tag). It signifies that the C<=over>
did not have a matching C<=back>, and thus Pod::Simple had to create a fake
closer.

For example, this Pod source:

  =over

  =item *

  Something

  =back

Would produce an event structure that does B have the I
attribute, whereas this Pod source:

  =over

  =item *

  Gasp! An unclosed =over block!

would. The rest of the over-* examples will not demonstrate this attribute,
but they all can have it. See L's source for an example of this
attribute being used.

The value of the I attribute is whatever value is after the
"=over" directive, as in "=over 8".  If no such value is specified
in the directive, then the I attribute has the value "4".

For example, this Pod source:

  =over

  =item *

  Stuff

  =item *

  Bar I!

  =back

produces this event structure:

  
    
      Stuff
    
    
      Bar baz!
    
  

=item events with an element_name of over-number

When an "=over ... Z<>=back" block is parsed where the items are
a numbered list, it will produce this event structure:

  
    
      ...Stuff...
    
    ...more item-number...
  

This is like the "over-bullet" event structure; but note that the contents
are "item-number" instead of "item-bullet", and note that they will have
a "number" attribute, which some formatters/processors may ignore
(since, for example, there's no need for it in HTML when producing
an "
    • ...
      • ...
    " structure), but which any processor may use.

Note that the values for the I attributes of "item-number"
elements in a given "over-number" area I start at 1 and go up by
one each time.  If the Pod source doesn't follow that order (even though
it really should!), whatever numbers it has will be ignored (with
the correct values being put in the I attributes), and an error
message might be issued to the user.

=item events with an element_name of over-text

These events are somewhat unlike the other over-*
structures, as far as what their contents are.  When
an "=over ... Z<>=back" block is parsed where the items are
a list of text "subheadings", it will produce this event structure:

  
    
      ...stuff...
    
    ...stuff (generally Para or Verbatim elements)...
    
    ...more item-text and/or stuff...
  

The I and I attributes are as with the other over-* events.

For example, this Pod source:

  =over

  =item Foo

  Stuff

  =item Bar I!

  Quux

  =back

produces this event structure:

  
    
      Foo
    
    
      Stuff
    
    
      Bar
        
          baz
        
      !
    
    
      Quux
    
  



=item events with an element_name of over-block

These events are somewhat unlike the other over-*
structures, as far as what their contents are.  When
an "=over ... Z<>=back" block is parsed where there are no items,
it will produce this event structure:

  
    ...stuff (generally Para or Verbatim elements)...
  

The I and I attributes are as with the other over-* events.

For example, this Pod source:

  =over

  For cutting off our trade with all parts of the world

  For transporting us beyond seas to be tried for pretended offenses

  He is at this time transporting large armies of foreign mercenaries to
  complete the works of death, desolation and tyranny, already begun with
  circumstances of cruelty and perfidy scarcely paralleled in the most
  barbarous ages, and totally unworthy the head of a civilized nation.

  =back

will produce this event structure:

  
    
      For cutting off our trade with all parts of the world
    
    
      For transporting us beyond seas to be tried for pretended offenses
    
    
      He is at this time transporting large armies of [...more text...]
    
  

=item events with an element_name of over-empty

B is set to a
true value.>

These events are somewhat unlike the other over-* structures, as far as what
their contents are.  When an "=over ... Z<>=back" block is parsed where there
is no content, it will produce this event structure:

  
  

The I and I attributes are as with the other over-* events.

For example, this Pod source:

  =over

  =over

  =back

  =back

will produce this event structure:

  
    
    
  

Note that the outer C<=over> is a block because it has no C<=item>s but still
has content: the inner C<=over>. The inner C<=over>, in turn, is completely
empty, and is treated as such.

=item events with an element_name of item-bullet

See L, above.

=item events with an element_name of item-number

See L, above.

=item events with an element_name of item-text

See L, above.

=item events with an element_name of for

TODO...

=item events with an element_name of Data

TODO...

=back



=head1 More Pod::Simple Methods

Pod::Simple provides a lot of methods that aren't generally interesting
to the end user of an existing Pod formatter, but some of which you
might find useful in writing a Pod formatter. They are listed below. The
first several methods (the accept_* methods) are for declaring the
capabilities of your parser, notably what C<=for I> sections
it's interested in, what extra NE...E codes it accepts beyond
the ones described in the I.

=over

=item C<< $parser->accept_targets( I ) >>

As the parser sees sections like:

    =for html  

or

    =begin html

      

    =end html

...the parser will ignore these sections unless your subclass has
specified that it wants to see sections targeted to "html" (or whatever
the formatter name is).

If you want to process all sections, even if they're not targeted for you,
call this before you start parsing:

  $parser->accept_targets('*');

=item C<< $parser->accept_targets_as_text(  I  ) >>

This is like accept_targets, except that it specifies also that the
content of sections for this target should be treated as Pod text even
if the target name in "=for I" doesn't start with a ":".

At time of writing, I don't think you'll need to use this.


=item C<< $parser->accept_codes( I, I...  ) >>

This tells the parser that you accept additional formatting codes,
beyond just the standard ones (I B C L F S X, plus the two weird ones
you don't actually see in the parse tree, Z and E). For example, to also
accept codes "N", "R", and "W":

    $parser->accept_codes( qw( N R W ) );

B


=item C<< $parser->accept_directive_as_data( I ) >>

=item C<< $parser->accept_directive_as_verbatim( I ) >>

=item C<< $parser->accept_directive_as_processed( I ) >>

In the unlikely situation that you need to tell the parser that you will
accept additional directives ("=foo" things), you need to first set the
parser to treat its content as data (i.e., not really processed at
all), or as verbatim (mostly just expanding tabs), or as processed text
(parsing formatting codes like BE...E).

For example, to accept a new directive "=method", you'd presumably
use:

    $parser->accept_directive_as_processed("method");

so that you could have Pod lines like:

    =method I<$whatever> thing B

Making up your own directives breaks compatibility with other Pod
formatters, in a way that using "=for I ..." lines doesn't;
however, you may find this useful if you're making a Pod superset
format where you don't need to worry about compatibility.


=item C<< $parser->nbsp_for_S( I ); >>

Setting this attribute to a true value (and by default it is false) will
turn "SE...E" sequences into sequences of words separated by
C<\xA0> (non-breaking space) characters. For example, it will take this:

    I like S, don't you?

and treat it as if it were:

    I like DutchEappleEpie, don't you?

This is handy for output formats that don't have anything quite like an
"SE...E" code, but which do have a code for non-breaking space.

There is currently no method for going the other way; but I can
probably provide one upon request.


=item C<< $parser->version_report() >>

This returns a string reporting the $VERSION value from your module (and
its classname) as well as the $VERSION value of Pod::Simple.  Note that
L requires output formats (wherever possible) to note
this detail in a comment in the output format.  For example, for
some kind of SGML output format:

    print OUT "";


=item C<< $parser->pod_para_count() >>

This returns the count of Pod paragraphs seen so far.


=item C<< $parser->line_count() >>

This is the current line number being parsed. But you might find the
"line_number" event attribute more accurate, when it is present.


=item C<< $parser->nix_X_codes(  I  ) >>

This attribute, when set to a true value (and it is false by default)
ignores any "XE...E" sequences in the document being parsed.
Many formats don't actually use the content of these codes, so have
no reason to process them.

=item C<< $parser->keep_encoding_directive(  I  ) >>

This attribute, when set to a true value (it is false by default)
will keep C<=encoding> and its content in the event structure. Most
formats don't actually need to process the content of an C<=encoding>
directive, even when this directive sets the encoding and the
processor makes use of the encoding information. Indeed, it is
possible to know the encoding without processing the directive
content.

=item C<< $parser->merge_text(  I  ) >>

This attribute, when set to a true value (and it is false by default)
makes sure that only one event (or token, or node) will be created
for any single contiguous sequence of text.  For example, consider
this somewhat contrived example:

    I just LOVE Z<>hotE<32>apple pie!

When that is parsed and events are about to be called on it, it may
actually seem to be four different text events, one right after another:
one event for "I just LOVE ", one for "hot", one for " ", and one for
"apple pie!". But if you have merge_text on, then you're guaranteed
that it will be fired as one text event:  "I just LOVE hot apple pie!".


=item C<< $parser->code_handler(  I  ) >>

This specifies code that should be called when a code line is seen
(i.e., a line outside of the Pod).  Normally this is undef, meaning
that no code should be called.  If you provide a routine, it should
start out like this:

    sub get_code_line {  # or whatever you'll call it
      my($line, $line_number, $parser) = @_;
      ...
    }

Note, however, that sometimes the Pod events aren't processed in exactly
the same order as the code lines are -- i.e., if you have a file with
Pod, then code, then more Pod, sometimes the code will be processed (via
whatever you have code_handler call) before the all of the preceding Pod
has been processed.


=item C<< $parser->cut_handler(  I  ) >>

This is just like the code_handler attribute, except that it's for
"=cut" lines, not code lines. The same caveats apply. "=cut" lines are
unlikely to be interesting, but this is included for completeness.


=item C<< $parser->pod_handler(  I  ) >>

This is just like the code_handler attribute, except that it's for
"=pod" lines, not code lines. The same caveats apply. "=pod" lines are
unlikely to be interesting, but this is included for completeness.


=item C<< $parser->whiteline_handler(  I  ) >>

This is just like the code_handler attribute, except that it's for
lines that are seemingly blank but have whitespace (" " and/or "\t") on them,
not code lines. The same caveats apply. These lines are unlikely to be
interesting, but this is included for completeness.


=item C<< $parser->whine( I, I ) >>

This notes a problem in the Pod, which will be reported in the "Pod
Errors" section of the document and/or sent to STDERR, depending on the
values of the attributes C, C, and
C.

=item C<< $parser->scream( I, I ) >>

This notes an error like C does, except that it is not
suppressible with C. This should be used only for very
serious errors.


=item C<< $parser->source_dead(1) >>

This aborts parsing of the current document, by switching on the flag
that indicates that EOF has been seen.  In particularly drastic cases,
you might want to do this.  It's rather nicer than just calling
C!

=item C<< $parser->hide_line_numbers( I ) >>

Some subclasses that indiscriminately dump event attributes (well,
except for ones beginning with "~") can use this object attribute for
refraining to dump the "start_line" attribute.

=item C<< $parser->no_whining( I ) >>

This attribute, if set to true, will suppress reports of non-fatal
error messages.  The default value is false, meaning that complaints
I reported.  How they get reported depends on the values of
the attributes C and C.

=item C<< $parser->no_errata_section( I ) >>

This attribute, if set to true, will suppress generation of an errata
section.  The default value is false -- i.e., an errata section will be
generated.

=item C<< $parser->complain_stderr( I ) >>

This attribute, if set to true will send complaints to STDERR.  The
default value is false -- i.e., complaints do not go to STDERR.

=item C<< $parser->bare_output( I ) >>

Some formatter subclasses use this as a flag for whether output should
have prologue and epilogue code omitted. For example, setting this to
true for an HTML formatter class should omit the
"......" prologue and the
"" epilogue.

If you want to set this to true, you should probably also set
C or at least C to true.

=item C<< $parser->preserve_whitespace( I ) >>

If you set this attribute to a true value, the parser will try to
preserve whitespace in the output.  This means that such formatting
conventions as two spaces after periods will be preserved by the parser.
This is primarily useful for output formats that treat whitespace as
significant (such as text or *roff, but not HTML).

=item C<< $parser->parse_empty_lists( I ) >>

If this attribute is set to true, the parser will not ignore empty
C<=over>/C<=back> blocks. The type of C<=over> will be I, documented
above, L.

=back

=head1 SEE ALSO

L -- event-based Pod-parsing framework

L -- like Pod::Simple, but each sort of event
calls its own method (like C)

L -- a Pod-parsing framework like Pod::Simple,
but with a token-stream interface

L -- a Pod-parsing framework like Pod::Simple,
but with a tree interface

L -- a simple Pod::Simple subclass that reads
documents, and then makes a plaintext report of any errors found in the
document

L -- for dumping Pod documents as tidily
indented XML, showing each event on its own line

L -- dumps a Pod document as XML (without
introducing extra whitespace as Pod::Simple::DumpAsXML does).

L -- for dumping Pod documents as tidily
indented text, showing each event on its own line

L -- class for objects representing the values
of the TODO and TODO attributes of LE...E elements

L -- the module that Pod::Simple uses for evaluating
EE...E content

L -- a simple plaintext formatter for Pod

L -- like Pod::Simple::Text, but
makes no effort for indent or wrap the text being formatted

L -- a simple HTML formatter for Pod

L

L

L

=head1 SUPPORT

Questions or discussion about POD and Pod::Simple should be sent to the
pod-people@perl.org mail list. Send an empty email to
pod-people-subscribe@perl.org to subscribe.

This module is managed in an open GitHub repository,
L. Feel free to fork and contribute, or
to clone L and send patches!

Patches against Pod::Simple are welcome. Please send bug reports to
.

=head1 COPYRIGHT AND DISCLAIMERS

Copyright (c) 2002 Sean M. Burke.

This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

This program is distributed in the hope that it will be useful, but
without any warranty; without even the implied warranty of
merchantability or fitness for a particular purpose.

=head1 AUTHOR

Pod::Simple was created by Sean M. Burke .
But don't bother him, he's retired.

Pod::Simple is maintained by:

=over

=item * Allison Randal C

=item * Hans Dieter Pearcey C

=item * David E. Wheeler C

=back

=for notes
Hm, my old podchecker version (1.2) says:
 *** WARNING: node 'http://search.cpan.org/' contains non-escaped | or / at line 38 in file Subclassing.pod
 *** WARNING: node 'http://lists.perl.org/showlist.cgi?name=pod-people' contains non-escaped | or / at line 41 in file Subclassing.pod
Yes, L<...> is hard.


=cut
Pod-Simple-3.45/lib/Pod/Simple/Transcode.pm0000644000175000017500000000130614427237107016572 0ustar  khwkhwpackage Pod::Simple::Transcode;
use strict;
our $VERSION = '3.45';

BEGIN {
  if(defined &DEBUG) {;} # Okay
  elsif( defined &Pod::Simple::DEBUG ) { *DEBUG = \&Pod::Simple::DEBUG; }
  else { *DEBUG = sub () {0}; }
}

our @ISA;
foreach my $class (
  'Pod::Simple::TranscodeSmart',
  'Pod::Simple::TranscodeDumb',
  '',
) {
  $class or die "Couldn't load any encoding classes";
  DEBUG and print STDERR "About to try loading $class...\n";
  eval "require $class;";
  if($@) {
    DEBUG and print STDERR "Couldn't load $class: $@\n";
  } else {
    DEBUG and print STDERR "OK, loaded $class.\n";
    @ISA = ($class);
    last;
  }
}

sub _blorp { return; } # just to avoid any "empty class" warning

1;
__END__


Pod-Simple-3.45/lib/Pod/Simple/Debug.pm0000644000175000017500000001076414427237107015706 0ustar  khwkhwpackage Pod::Simple::Debug;
use strict;
our $VERSION = '3.45';

sub import {
  my($value,$variable);

  if(@_ == 2) {
    $value = $_[1];
  } elsif(@_ == 3) {
    ($variable, $value) = @_[1,2];

    ($variable, $value) = ($value, $variable)
       if     defined $value    and ref($value)    eq 'SCALAR'
      and not(defined $variable and ref($variable) eq 'SCALAR')
    ; # tolerate getting it backwards

    unless( defined $variable and ref($variable) eq 'SCALAR') {
      require Carp;
      Carp::croak("Usage:\n use Pod::Simple::Debug (NUMVAL)\nor"
                . "\n use Pod::Simple::Debug (\\\$var, STARTNUMVAL)\nAborting");
    }
  } else {
    require Carp;
    Carp::croak("Usage:\n use Pod::Simple::Debug (NUMVAL)\nor"
                    . "\n use Pod::Simple::Debug (\\\$var, STARTNUMVAL)\nAborting");
  }

  if( defined &Pod::Simple::DEBUG ) {
    require Carp;
    Carp::croak("It's too late to call Pod::Simple::Debug -- "
              . "Pod::Simple has already loaded\nAborting");
  }

  $value = 0 unless defined $value;

  unless($value =~ m/^-?\d+$/) {
    require Carp;
    Carp::croak( "$value isn't a numeric value."
            . "\nUsage:\n use Pod::Simple::Debug (NUMVAL)\nor"
                    . "\n use Pod::Simple::Debug (\\\$var, STARTNUMVAL)\nAborting");
  }

  if( defined $variable ) {
    # make a not-really-constant
    *Pod::Simple::DEBUG = sub () { $$variable } ;
    $$variable = $value;
    print STDERR "# Starting Pod::Simple::DEBUG = non-constant $variable with val $value\n";
  } else {
    *Pod::Simple::DEBUG = eval " sub () { $value } ";
    print STDERR "# Starting Pod::Simple::DEBUG = $value\n";
  }

  require Pod::Simple;
  return;
}

1;


__END__

=head1 NAME

Pod::Simple::Debug -- put Pod::Simple into trace/debug mode

=head1 SYNOPSIS

 use Pod::Simple::Debug (5);  # or some integer

Or:

 my $debuglevel;
 use Pod::Simple::Debug (\$debuglevel, 0);
 ...some stuff that uses Pod::Simple to do stuff, but which
  you don't want debug output from...

 $debug_level = 4;
 ...some stuff that uses Pod::Simple to do stuff, but which
  you DO want debug output from...

 $debug_level = 0;

=head1 DESCRIPTION

This is an internal module for controlling the debug level (a.k.a. trace
level) of Pod::Simple.  This is of interest only to Pod::Simple
developers.


=head1 CAVEATS

Note that you should load this module I loading Pod::Simple (or
any Pod::Simple-based class).  If you try loading Pod::Simple::Debug
after &Pod::Simple::DEBUG is already defined, Pod::Simple::Debug will
throw a fatal error to the effect that
"It's too late to call Pod::Simple::Debug".

Note that the C)> mode will make
Pod::Simple (et al) run rather slower, since &Pod::Simple::DEBUG won't
be a constant sub anymore, and so Pod::Simple (et al) won't compile with
constant-folding.


=head1 GUTS

Doing this:

  use Pod::Simple::Debug (5);  # or some integer

is basically equivalent to:

  BEGIN { sub Pod::Simple::DEBUG () {5} }  # or some integer
  use Pod::Simple ();

And this:

  use Pod::Simple::Debug (\$debug_level,0);  # or some integer

is basically equivalent to this:

  my $debug_level;
  BEGIN { $debug_level = 0 }
  BEGIN { sub Pod::Simple::DEBUG () { $debug_level }
  use Pod::Simple ();

=head1 SEE ALSO

L

The article "Constants in Perl", in I issue
21.  See L

=head1 SUPPORT

Questions or discussion about POD and Pod::Simple should be sent to the
pod-people@perl.org mail list. Send an empty email to
pod-people-subscribe@perl.org to subscribe.

This module is managed in an open GitHub repository,
L. Feel free to fork and contribute, or
to clone L and send patches!

Patches against Pod::Simple are welcome. Please send bug reports to
.

=head1 COPYRIGHT AND DISCLAIMERS

Copyright (c) 2002 Sean M. Burke.

This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

This program is distributed in the hope that it will be useful, but
without any warranty; without even the implied warranty of
merchantability or fitness for a particular purpose.

=head1 AUTHOR

Pod::Simple was created by Sean M. Burke .
But don't bother him, he's retired.

Pod::Simple is maintained by:

=over

=item * Allison Randal C

=item * Hans Dieter Pearcey C

=item * David E. Wheeler C

=back

=cut
use warnings;
Pod-Simple-3.45/lib/Pod/Simple/TiedOutFH.pm0000644000175000017500000000525714427237107016454 0ustar  khwkhwpackage Pod::Simple::TiedOutFH;
use strict;
use warnings;
use Symbol ('gensym');
use Carp ();
our $VERSION = '3.45';

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

sub handle_on { # some horrible frightening things are encapsulated in here
  my $class = shift;
  $class = ref($class) || $class;

  Carp::croak "Usage: ${class}->handle_on(\$somescalar)" unless @_;

  my $x = (defined($_[0]) and ref($_[0]))
    ? $_[0]
    : ( \( $_[0] ) )[0]
  ;
  $$x = '' unless defined $$x;

  #Pod::Simple::DEBUG and print STDERR "New $class handle on $x = \"$$x\"\n";

  my $new = gensym();
  tie *$new, $class, $x;
  return $new;
}

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

sub TIEHANDLE {  # Ties to just a scalar ref
  my($class, $scalar_ref) = @_;
  $$scalar_ref = '' unless defined $$scalar_ref;
  return bless \$scalar_ref,  ref($class) || $class;
}

sub PRINT {
  my $it = shift;
  foreach my $x (@_) { $$$it .= $x }

  #Pod::Simple::DEBUG > 10 and print STDERR " appended to $$it = \"$$$it\"\n";

  return 1;
}

sub FETCH {
  return ${$_[0]};
}

sub PRINTF {
  my $it = shift;
  my $format = shift;
  $$$it .= sprintf $format, @_;
  return 1;
}

sub FILENO { ${ $_[0] } + 100 } # just to produce SOME number

sub CLOSE { 1 }

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1;
__END__

Chole

 * 1 large red onion
 * 2 tomatillos
 * 4 or 5 roma tomatoes (optionally with the pulp discarded)
 * 1 tablespoons chopped ginger root (or more, to taste)
 * 2 tablespoons canola oil (or vegetable oil)

 * 1 tablespoon garam masala
 * 1/2 teaspoon red chili powder, or to taste
 * Salt, to taste (probably quite a bit)
 * 2 (15-ounce) cans chick peas or garbanzo beans, drained and rinsed
 * juice of one smallish lime
 * a dash of balsamic vinegar (to taste)
 * cooked rice, preferably long-grain white rice (whether plain,
    basmati rice, jasmine rice, or even a mild pilaf)

In a blender or food processor, puree the onions, tomatoes, tomatillos,
and ginger root.  You can even do it with a Braun hand "mixer", if you
chop things finer to start with, and work at it.

In a saucepan set over moderate heat, warm the oil until hot.

Add the puree and the balsamic vinegar, and cook, stirring occasionally,
for 20 to 40 minutes. (Cooking it longer will make it sweeter.)

Add the Garam Masala, chili powder, and cook, stirring occasionally, for
5 minutes.

Add the salt and chick peas and cook, stirring, until heated through.

Stir in the lime juice, and optionally one or two teaspoons of tahini.
You can let it simmer longer, depending on how much softer you want the
garbanzos to get.

Serve over rice, like a curry.

Yields 5 to 7 servings.


Pod-Simple-3.45/lib/Pod/Simple/Progress.pm0000644000175000017500000000456314427237107016464 0ustar  khwkhwpackage Pod::Simple::Progress;
use strict;
use warnings;

our $VERSION = '3.45';

# Objects of this class are used for noting progress of an
#  operation every so often.  Messages delivered more often than that
#  are suppressed.
#
# There's actually nothing in here that's specific to Pod processing;
#  but it's ad-hoc enough that I'm not willing to give it a name that
#  implies that it's generally useful, like "IO::Progress" or something.
#
# -- sburke
#
#--------------------------------------------------------------------------

sub new {
  my($class,$delay) = @_;
  my $self = bless {'quiet_until' => 1},  ref($class) || $class;
  $self->to(*STDOUT{IO});
  $self->delay(defined($delay) ? $delay : 5);
  return $self;
}

sub copy {
  my $orig = shift;
  bless {%$orig, 'quiet_until' => 1}, ref($orig);
}
#--------------------------------------------------------------------------

sub reach {
  my($self, $point, $note) = @_;
  if( (my $now = time) >= $self->{'quiet_until'}) {
    my $goal;
    my    $to = $self->{'to'};
    print $to join('',
      ($self->{'quiet_until'} == 1) ? () : '... ',
      (defined $point) ? (
        '#',
        ($goal = $self->{'goal'}) ? (
          ' ' x (length($goal) - length($point)),
          $point, '/', $goal,
        ) : $point,
        $note ? ': ' : (),
      ) : (),
      $note || '',
      "\n"
    );
    $self->{'quiet_until'} = $now + $self->{'delay'};
  }
  return $self;
}

#--------------------------------------------------------------------------

sub done {
  my($self, $note) = @_;
  $self->{'quiet_until'} = 1;
  return $self->reach( undef, $note );
}

#--------------------------------------------------------------------------
# Simple accessors:

sub delay {
  return $_[0]{'delay'} if @_ == 1; $_[0]{'delay'} = $_[1]; return $_[0] }
sub goal {
  return $_[0]{'goal' } if @_ == 1; $_[0]{'goal' } = $_[1]; return $_[0] }
sub to   {
  return $_[0]{'to'   } if @_ == 1; $_[0]{'to'   } = $_[1]; return $_[0] }

#--------------------------------------------------------------------------

unless(caller) { # Simple self-test:
  my $p = __PACKAGE__->new->goal(5);
  $p->reach(1, "Primus!");
  sleep 1;
  $p->reach(2, "Secundus!");
  sleep 3;
  $p->reach(3, "Tertius!");
  sleep 5;
  $p->reach(4);
  $p->reach(5, "Quintus!");
  sleep 1;
  $p->done("All done");
}

#--------------------------------------------------------------------------
1;
__END__

Pod-Simple-3.45/lib/Pod/Simple/JustPod.pm0000644000175000017500000002264014427236532016245 0ustar  khwkhwpackage Pod::Simple::JustPod;
# ABSTRACT: Pod::Simple formatter that extracts POD from a file containing
#           other things as well
use strict;
use warnings;

use Pod::Simple::Methody ();
our @ISA = ('Pod::Simple::Methody');

sub new {
  my $self = shift;
  my $new  = $self->SUPER::new(@_);

  $new->accept_targets('*');
  $new->keep_encoding_directive(1);
  $new->preserve_whitespace(1);
  $new->complain_stderr(1);
  $new->_output_is_for_JustPod(1);

  return $new;
}

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

sub check_that_all_is_closed {

  # Actually checks that the things we depend on being balanced in fact are,
  # so that we can continue in spit of pod errors

  my $self = shift;
  while ($self->{inL}) {
    $self->end_L(@_);
  }
  while ($self->{fcode_end} && @{$self->{fcode_end}}) {
    $self->_end_fcode(@_);
  }
}

sub handle_text {

  # Add text to the output buffer.  This is skipped if within a L<>, as we use
  # the 'raw' attribute of that tag instead.

  $_[0]{buffer} .= $_[1] unless $_[0]{inL} ;
}

sub spacer {

  # Prints the white space following things like =head1.  This is normally a
  # blank, unless BlackBox has told us otherwise.

  my ($self, $arg) = @_;
  return unless $arg;

  my $spacer = ($arg->{'~orig_spacer'})
                ? $arg->{'~orig_spacer'}
                : " ";
  $self->handle_text($spacer);
}

sub _generic_start {

  # Called from tags like =head1, etc.

  my ($self, $text, $arg) = @_;
  $self->check_that_all_is_closed();
  $self->handle_text($text);
  $self->spacer($arg);
}

sub start_Document    { shift->_generic_start("=pod\n\n"); }
sub start_head1       { shift->_generic_start('=head1', @_); }
sub start_head2       { shift->_generic_start('=head2', @_); }
sub start_head3       { shift->_generic_start('=head3', @_); }
sub start_head4       { shift->_generic_start('=head4', @_); }
sub start_head5       { shift->_generic_start('=head5', @_); }
sub start_head6       { shift->_generic_start('=head6', @_); }
sub start_encoding    { shift->_generic_start('=encoding', @_); }
# sub start_Para
# sub start_Verbatim

sub start_item_bullet { # Handle =item *
  my ($self, $arg) = @_;
  $self->check_that_all_is_closed();
  $self->handle_text('=item');

  # It can be that they said simply '=item', and it is inferred that it is to
  # be a bullet.
  if (! $arg->{'~orig_content'}) {
    $self->handle_text("\n\n");
  }
  else {
    $self->spacer($arg);
    if ($arg->{'~_freaky_para_hack'}) {

        # See Message Id <87y3gtcwa2.fsf@hope.eyrie.org>
        my $item_text = $arg->{'~orig_content'};
        my $trailing = quotemeta $arg->{'~_freaky_para_hack'};
        $item_text =~ s/$trailing$//;
        $self->handle_text($item_text);
    }
    else {
        $self->handle_text("*\n\n");
    }
  }
}

sub start_item_number {     # Handle '=item 2'
  my ($self, $arg) = @_;
  $self->check_that_all_is_closed();
  $self->handle_text("=item");
  $self->spacer($arg);
  $self->handle_text("$arg->{'~orig_content'}\n\n");
}

sub start_item_text {   # Handle '=item foo bar baz'
  my ($self, $arg) = @_;
  $self->check_that_all_is_closed();
  $self->handle_text('=item');
  $self->spacer($arg);
}

sub _end_item {
  my $self = shift;
  $self->check_that_all_is_closed();
  $self->emit;
}

*end_item_bullet = *_end_item;
*end_item_number = *_end_item;
*end_item_text   = *_end_item;

sub _start_over  {  # Handle =over
  my ($self, $arg) = @_;
  $self->check_that_all_is_closed();
  $self->handle_text("=over");

  # The =over amount is optional
  if ($arg->{'~orig_content'}) {
    $self->spacer($arg);
    $self->handle_text("$arg->{'~orig_content'}");
  }
  $self->handle_text("\n\n");
}

*start_over_bullet = *_start_over;
*start_over_number = *_start_over;
*start_over_text   = *_start_over;
*start_over_block  = *_start_over;

sub _end_over  {
  my $self = shift;
  $self->check_that_all_is_closed();
  $self->handle_text('=back');
  $self->emit;
}

*end_over_bullet = *_end_over;
*end_over_number = *_end_over;
*end_over_text   = *_end_over;
*end_over_block  = *_end_over;

sub end_Document    {
  my $self = shift;
  $self->emit;        # Make sure buffer gets flushed
  print {$self->{'output_fh'} } "=cut\n"
}

sub _end_generic  {
  my $self = shift;
  $self->check_that_all_is_closed();
  $self->emit;
}

*end_head1    = *_end_generic;
*end_head2    = *_end_generic;
*end_head3    = *_end_generic;
*end_head4    = *_end_generic;
*end_head5    = *_end_generic;
*end_head6    = *_end_generic;
*end_encoding = *_end_generic;
*end_Para     = *_end_generic;
*end_Verbatim = *_end_generic;

sub _start_fcode {
  my ($type, $self, $flags) = @_;

  # How many brackets is set by BlackBox unless the count is 1
  my $bracket_count = (exists $flags->{'~bracket_count'})
                       ? $flags->{'~bracket_count'}
                       : 1;
  $self->handle_text($type . ( "<" x $bracket_count));

  my $rspacer = "";
  if ($bracket_count > 1) {
    my $lspacer = (exists $flags->{'~lspacer'})
                  ? $flags->{'~lspacer'}
                  : " ";
    $self->handle_text($lspacer);

    $rspacer = (exists $flags->{'~rspacer'})
                  ? $flags->{'~rspacer'}
                  : " ";
  }

  # BlackBox doesn't output things for for the ending code callbacks, so save
  # what we need.
  push @{$self->{'fcode_end'}}, [ $bracket_count, $rspacer ];
}

sub start_B { _start_fcode('B', @_); }
sub start_C { _start_fcode('C', @_); }
sub start_E { _start_fcode('E', @_); }
sub start_F { _start_fcode('F', @_); }
sub start_I { _start_fcode('I', @_); }
sub start_S { _start_fcode('S', @_); }
sub start_X { _start_fcode('X', @_); }
sub start_Z { _start_fcode('Z', @_); }

sub _end_fcode {
    my $self = shift;
    my $fcode_end = pop @{$self->{'fcode_end'}};
    my $bracket_count = 1;
    my $rspacer = "";

    if (! defined $fcode_end) { # If BlackBox is working, this shouldn't
                                # happen, but verify
      $self->whine($self->{line_count}, "Extra '>'");
    }
    else {
      $bracket_count = $fcode_end->[0];
      $rspacer = $fcode_end->[1];
    }

    $self->handle_text($rspacer) if $bracket_count > 1;
    $self->handle_text(">" x $bracket_count);
}

*end_B   = *_end_fcode;
*end_C   = *_end_fcode;
*end_E   = *_end_fcode;
*end_F   = *_end_fcode;
*end_I   = *_end_fcode;
*end_S   = *_end_fcode;
*end_X   = *_end_fcode;
*end_Z   = *_end_fcode;

sub start_L {
    _start_fcode('L', @_);
    $_[0]->handle_text($_[1]->{raw});
    $_[0]->{inL}++
}

sub end_L {
  my $self = shift;
  $self->{inL}--;
  if ($self->{inL} < 0) {   # If BlackBox is working, this shouldn't
                            # happen, but verify
    $self->whine($self->{line_count}, "Extra '>' ending L<>");
    $self->{inL} = 0;
  }

  $self->_end_fcode(@_);
}

sub emit {
  my $self = shift;

  if ($self->{buffer} ne "") {
    print { $self->{'output_fh'} } "",$self->{buffer} ,"\n\n";

    $self->{buffer} = "";
  }

  return;
}

1;

__END__

=head1 NAME

Pod::Simple::JustPod -- just the Pod, the whole Pod, and nothing but the Pod

=head1 SYNOPSIS

 my $infile  = "mixed_code_and_pod.pm";
 my $outfile = "just_the_pod.pod";
 open my $fh, ">$outfile" or die "Can't write to $outfile: $!";

 my $parser = Pod::Simple::JustPod->new();
 $parser->output_fh($fh);
 $parser->parse_file($infile);
 close $fh or die "Can't close $outfile: $!";

=head1 DESCRIPTION

This class returns a copy of its input, translated into Perl's internal
encoding (UTF-8), and with all the non-Pod lines removed.

This is a subclass of L and inherits all its methods.
And since, that in turn is a subclass of L, you can use any of
its methods.  This means you can output to a string instead of a file, or
you can parse from an array.

This class strives to return the Pod lines of the input completely unchanged,
except for any necessary translation into Perl's internal encoding, and it makes
no effort to return trailing spaces on lines; these likely will be stripped.
If the input pod is well-formed with no warnings nor errors generated, the
extracted pod should generate the same documentation when formatted by a Pod
formatter as the original file does.

By default, warnings are output to STDERR

=head1 SEE ALSO

L, L

=head1 SUPPORT

Questions or discussion about POD and Pod::Simple should be sent to the
L mail list. Send an empty email to
L to subscribe.

This module is managed in an open GitHub repository,
L. Feel free to fork and contribute, or
to clone L and send patches!

Patches against Pod::Simple are welcome. Please send bug reports to
L.

=head1 COPYRIGHT AND DISCLAIMERS

Copyright (c) 2002 Sean M. Burke.

This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

This program is distributed in the hope that it will be useful, but
without any warranty; without even the implied warranty of
merchantability or fitness for a particular purpose.

=head1 AUTHOR

Pod::Simple was created by Sean M. Burke .
But don't bother him, he's retired.

Pod::Simple is maintained by:

=over

=item * Allison Randal C

=item * Hans Dieter Pearcey C

=item * David E. Wheeler C

=back

Pod::Simple::JustPod was developed by John SJ Anderson
C, with contributions from Karl Williamson
C.

=cut
Pod-Simple-3.45/lib/Pod/Simple/PullParserTextToken.pm0000644000175000017500000000642314427237107020614 0ustar  khwkhwpackage Pod::Simple::PullParserTextToken;
use strict;
use warnings;
use Pod::Simple::PullParserToken ();
our @ISA = ('Pod::Simple::PullParserToken');
our $VERSION = '3.45';

sub new {  # Class->new(text);
  my $class = shift;
  return bless ['text', @_], ref($class) || $class;
}

# Purely accessors:

sub text { (@_ == 2) ? ($_[0][1] = $_[1]) : $_[0][1] }

sub text_r { \ $_[0][1] }

1;

__END__

=head1 NAME

Pod::Simple::PullParserTextToken -- text-tokens from Pod::Simple::PullParser

=head1 SYNOPSIS

(See L)

=head1 DESCRIPTION

When you do $parser->get_token on a L, you might
get an object of this class.

This is a subclass of L and inherits all its methods,
and adds these methods:

=over

=item $token->text

This returns the text that this token holds.  For example, parsing
CZ<> will return a C start-token, a text-token, and a C end-token.  And
if you want to get the "foo" out of the text-token, call C<< $token->text >>

=item $token->text(I)

This changes the string that this token holds.  You probably won't need
to do this.

=item $token->text_r()

This returns a scalar reference to the string that this token holds.
This can be useful if you don't want to memory-copy the potentially
large text value (well, as large as a paragraph or a verbatim block)
as calling $token->text would do.

Or, if you want to alter the value, you can even do things like this:

  for ( ${  $token->text_r  } ) {  # Aliases it with $_ !!

    s/ The / the /g; # just for example

    if( 'A' eq chr(65) ) {  # (if in an ASCII world)
      tr/\xA0/ /;
      tr/\xAD//d;
    }

    ...or however you want to alter the value...
    (Note that starting with Perl v5.8, you can use, e.g.,

        my $nbsp = chr utf8::unicode_to_native(0xA0);
        s/$nbsp/ /g;

    to handle the above regardless if it's an ASCII world or not)
  }

=back

You're unlikely to ever need to construct an object of this class for
yourself, but if you want to, call
C<<
Pod::Simple::PullParserTextToken->new( I )
>>

=head1 SEE ALSO

L, L, L

=head1 SUPPORT

Questions or discussion about POD and Pod::Simple should be sent to the
pod-people@perl.org mail list. Send an empty email to
pod-people-subscribe@perl.org to subscribe.

This module is managed in an open GitHub repository,
L. Feel free to fork and contribute, or
to clone L and send patches!

Patches against Pod::Simple are welcome. Please send bug reports to
.

=head1 COPYRIGHT AND DISCLAIMERS

Copyright (c) 2002 Sean M. Burke.

This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

This program is distributed in the hope that it will be useful, but
without any warranty; without even the implied warranty of
merchantability or fitness for a particular purpose.

=head1 AUTHOR

Pod::Simple was created by Sean M. Burke .
But don't bother him, he's retired.

Pod::Simple is maintained by:

=over

=item * Allison Randal C

=item * Hans Dieter Pearcey C

=item * David E. Wheeler C

=back

=cut
Pod-Simple-3.45/lib/Pod/Simple/TextContent.pm0000644000175000017500000000470314427237107017133 0ustar  khwkhwpackage Pod::Simple::TextContent;
use strict;
use warnings;
use Carp ();
use Pod::Simple ();
our $VERSION = '3.45';
our @ISA = ('Pod::Simple');

sub new {
  my $self = shift;
  my $new = $self->SUPER::new(@_);
  $new->{'output_fh'} ||= *STDOUT{IO};
  $new->nix_X_codes(1);
  return $new;
}

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

sub _handle_element_start {
  print {$_[0]{'output_fh'}} "\n"  unless $_[1] =~ m/^[A-Z]$/s;
  return;
}

sub _handle_text {
  $_[1] =~ s/$Pod::Simple::shy//g;
  $_[1] =~ s/$Pod::Simple::nbsp/ /g;
  print {$_[0]{'output_fh'}} $_[1];
  return;
}

sub _handle_element_end {
  print {$_[0]{'output_fh'}} "\n"  unless $_[1] =~ m/^[A-Z]$/s;
  return;
}

#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
1;


__END__

=head1 NAME

Pod::Simple::TextContent -- get the text content of Pod

=head1 SYNOPSIS

 TODO

  perl -MPod::Simple::TextContent -e \
   "exit Pod::Simple::TextContent->filter(shift)->any_errata_seen" \
   thingy.pod

=head1 DESCRIPTION

This class is that parses Pod and dumps just the text content.  It is
mainly meant for use by the Pod::Simple test suite, but you may find
some other use for it.

This is a subclass of L and inherits all its methods.

=head1 SEE ALSO

L, L, L

=head1 SUPPORT

Questions or discussion about POD and Pod::Simple should be sent to the
pod-people@perl.org mail list. Send an empty email to
pod-people-subscribe@perl.org to subscribe.

This module is managed in an open GitHub repository,
L. Feel free to fork and contribute, or
to clone L and send patches!

Patches against Pod::Simple are welcome. Please send bug reports to
.

=head1 COPYRIGHT AND DISCLAIMERS

Copyright (c) 2002 Sean M. Burke.

This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

This program is distributed in the hope that it will be useful, but
without any warranty; without even the implied warranty of
merchantability or fitness for a particular purpose.

=head1 AUTHOR

Pod::Simple was created by Sean M. Burke .
But don't bother him, he's retired.

Pod::Simple is maintained by:

=over

=item * Allison Randal C

=item * Hans Dieter Pearcey C

=item * David E. Wheeler C

=back

=cut
Pod-Simple-3.45/lib/Pod/Simple/TranscodeSmart.pm0000644000175000017500000000126514427237107017605 0ustar  khwkhwuse 5.008;
## Anything before 5.8.0 is GIMPY!
## This module is to be use()'d only by Pod::Simple::Transcode

package Pod::Simple::TranscodeSmart;
use strict;
use warnings;
use Pod::Simple;
use Encode;
our $VERSION = '3.45';

sub is_dumb  {0}
sub is_smart {1}

sub all_encodings {
  return Encode::->encodings(':all');
}

sub encoding_is_available {
  return Encode::resolve_alias($_[1]);
}

sub encmodver {
  return "Encode.pm v" .($Encode::VERSION || '?');
}

sub make_transcoder {
  my $e = Encode::find_encoding($_[1]);
  die "WHAT ENCODING!?!?" unless $e;
  my $x;
  return sub {
    foreach $x (@_) {
      $x = $e->decode($x) unless Encode::is_utf8($x);
    }
    return;
  };
}


1;


Pod-Simple-3.45/lib/Pod/Simple/HTMLLegacy.pm0000644000175000017500000000525314427236532016547 0ustar  khwkhwpackage Pod::Simple::HTMLLegacy;
use strict;
use warnings;

use Getopt::Long;

our $VERSION = "5.01";

#--------------------------------------------------------------------------
#
# This class is meant to thinly emulate bad old Pod::Html
#
# TODO: some basic docs

sub pod2html {
  my @args = (@_);

  my( $verbose, $infile, $outfile, $title );
  my $index = 1;

  {
    my($help);

    my($netscape); # dummy
    local @ARGV = @args;
    GetOptions(
      "help"       => \$help,
      "verbose!"   => \$verbose,
      "infile=s"   => \$infile,
      "outfile=s"  => \$outfile,
      "title=s"    => \$title,
      "index!"     => \$index,

      "netscape!"   => \$netscape,
    ) or return bad_opts(@args);
    bad_opts(@args) if @ARGV; # it should be all switches!
    return help_message() if $help;
  }

  for($infile, $outfile) { $_ = undef unless defined and length }

  if($verbose) {
    warn sprintf "%s version %s\n", __PACKAGE__, $VERSION;
    warn "OK, processed args [@args] ...\n";
    warn sprintf
      " Verbose: %s\n Index: %s\n Infile: %s\n Outfile: %s\n Title: %s\n",
      map defined($_) ? $_ : "(nil)",
       $verbose,     $index,     $infile,     $outfile,     $title,
    ;
    *Pod::Simple::HTML::DEBUG = sub(){1};
  }
  require Pod::Simple::HTML;
  Pod::Simple::HTML->VERSION(3);

  die "No such input file as $infile\n"
   if defined $infile and ! -e $infile;


  my $pod = Pod::Simple::HTML->new;
  $pod->force_title($title) if defined $title;
  $pod->index($index);
  return $pod->parse_from_file($infile, $outfile);
}

#--------------------------------------------------------------------------

sub bad_opts     { die _help_message();         }
sub help_message { print STDOUT _help_message() }

#--------------------------------------------------------------------------

sub _help_message {

  join '',

"[", __PACKAGE__, " version ", $VERSION, qq~]
Usage:  pod2html --help --infile= --outfile=
   --verbose --index --noindex

Options:
  --help         - prints this message.
  --[no]index    - generate an index at the top of the resulting html
                   (default behavior).
  --infile       - filename for the pod to convert (input taken from stdin
                   by default).
  --outfile      - filename for the resulting html file (output sent to
                   stdout by default).
  --title        - title that will appear in resulting html file.
  --[no]verbose  - self-explanatory (off by default).

Note that pod2html is DEPRECATED, and this version implements only
 some of the options known to older versions.
For more information, see 'perldoc pod2html'.
~;

}

1;
__END__

OVER the underpass! UNDER the overpass! Around the FUTURE and BEYOND REPAIR!!

Pod-Simple-3.45/lib/Pod/Simple/BlackBox.pm0000644000175000017500000025116314427237107016345 0ustar  khwkhwpackage Pod::Simple::BlackBox;
#
# "What's in the box?"  "Pain."
#
###########################################################################
#
# This is where all the scary things happen: parsing lines into
#  paragraphs; and then into directives, verbatims, and then also
#  turning formatting sequences into treelets.
#
# Are you really sure you want to read this code?
#
#-----------------------------------------------------------------------------
#
# The basic work of this module Pod::Simple::BlackBox is doing the dirty work
# of parsing Pod into treelets (generally one per non-verbatim paragraph), and
# to call the proper callbacks on the treelets.
#
# Every node in a treelet is a ['name', {attrhash}, ...children...]

use integer; # vroom!
use strict;
use warnings;
use Carp ();
our $VERSION = '3.45';
#use constant DEBUG => 7;

sub my_qr ($$) {

    # $1 is a pattern to compile and return.  Older perls compile any
    # syntactically valid property, even if it isn't legal.  To cope with
    # this, return an empty string unless the compiled pattern also
    # successfully matches $2, which the caller furnishes.

    my ($input_re, $should_match) = @_;
    # XXX could have a third parameter $shouldnt_match for extra safety

    my $use_utf8 = ($] le 5.006002) ? 'use utf8;' : "";

    my $re = eval "no warnings; $use_utf8 qr/$input_re/";
    #print STDERR  __LINE__, ": $input_re: $@\n" if $@;
    return "" if $@;

    my $matches = eval "no warnings; $use_utf8 '$should_match' =~ /$re/";
    #print STDERR  __LINE__, ": $input_re: $@\n" if $@;
    return "" if $@;

    #print STDERR  __LINE__, ": SUCCESS: $re\n" if $matches;
    return $re if $matches;

    #print STDERR  __LINE__, ": $re: didn't match\n";
    return "";
}

BEGIN {
  require Pod::Simple;
  *DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG
}

# Matches a character iff the character will have a different meaning
# if we choose CP1252 vs UTF-8 if there is no =encoding line.
# This is broken for early Perls on non-ASCII platforms.
my $non_ascii_re = my_qr('[[:^ascii:]]', "\xB6");
$non_ascii_re = qr/[\x80-\xFF]/ unless $non_ascii_re;

# Use patterns understandable by Perl 5.6, if possible
my $cs_re = do { no warnings; my_qr('\p{IsCs}', "\x{D800}") };
my $cn_re = my_qr('\p{IsCn}', "\x{09E4}");  #  code point unlikely
                                            # to get assigned
my $rare_blocks_re = my_qr('[\p{InIPAExtensions}\p{InSpacingModifierLetters}]',
                           "\x{250}");
$rare_blocks_re = my_qr('[\x{0250}-\x{02FF}]', "\x{250}") unless $rare_blocks_re;

my $script_run_re = eval 'no warnings "experimental::script_run";
                          qr/(*script_run: ^ .* $ )/x';
my $latin_re = my_qr('[\p{IsLatin}\p{IsInherited}\p{IsCommon}]', "\x{100}");
unless ($latin_re) {
    # This was machine generated to be the ranges of the union of the above
    # three properties, with things that were undefined by Unicode 4.1 filling
    # gaps.  That is the version in use when Perl advanced enough to
    # successfully compile and execute the above pattern.
    $latin_re = my_qr('[\x00-\x{02E9}\x{02EC}-\x{0374}\x{037E}\x{0385}\x{0387}\x{0485}\x{0486}\x{0589}\x{060C}\x{061B}\x{061F}\x{0640}\x{064B}-\x{0655}\x{0670}\x{06DD}\x{0951}-\x{0954}\x{0964}\x{0965}\x{0E3F}\x{10FB}\x{16EB}-\x{16ED}\x{1735}\x{1736}\x{1802}\x{1803}\x{1805}\x{1D00}-\x{1D25}\x{1D2C}-\x{1D5C}\x{1D62}-\x{1D65}\x{1D6B}-\x{1D77}\x{1D79}-\x{1DBE}\x{1DC0}-\x{1EF9}\x{2000}-\x{2125}\x{2127}-\x{27FF}\x{2900}-\x{2B13}\x{2E00}-\x{2E1D}\x{2FF0}-\x{3004}\x{3006}\x{3008}-\x{3020}\x{302A}-\x{302D}\x{3030}-\x{3037}\x{303C}-\x{303F}\x{3099}-\x{309C}\x{30A0}\x{30FB}\x{30FC}\x{3190}-\x{319F}\x{31C0}-\x{31CF}\x{3220}-\x{325F}\x{327F}-\x{32CF}\x{3358}-\x{33FF}\x{4DC0}-\x{4DFF}\x{A700}-\x{A716}\x{FB00}-\x{FB06}\x{FD3E}\x{FD3F}\x{FE00}-\x{FE6B}\x{FEFF}-\x{FF65}\x{FF70}\x{FF9E}\x{FF9F}\x{FFE0}-\x{FFFD}\x{10100}-\x{1013F}\x{1D000}-\x{1D1DD}\x{1D300}-\x{1D7FF}]', "\x{100}");
}

my $every_char_is_latin_re = my_qr("^(?:$latin_re)*\\z", "A");

# Latin script code points not in the first release of Unicode
my $later_latin_re = my_qr('[^\P{IsLatin}\p{IsAge=1.1}]', "\x{1F6}");

# If this perl doesn't have the Deprecated property, there's only one code
# point in it that we need be concerned with.
my $deprecated_re = my_qr('\p{IsDeprecated}', "\x{149}");
$deprecated_re = qr/\x{149}/ unless $deprecated_re;

my $utf8_bom;
if (($] ge 5.007_003)) {
  $utf8_bom = "\x{FEFF}";
  utf8::encode($utf8_bom);
} else {
  $utf8_bom = "\xEF\xBB\xBF";   # No EBCDIC BOM detection for early Perls.
}

# This is used so that the 'content_seen' method doesn't return true on a
# file that just happens to have a line that matches /^=[a-zA-z]/.  Only if
# there is a valid =foo line will we return that content was seen.
my $seen_legal_directive = 0;

#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

sub parse_line { shift->parse_lines(@_) } # alias

# - - -  Turn back now!  Run away!  - - -

sub parse_lines {             # Usage: $parser->parse_lines(@lines)
  # an undef means end-of-stream
  my $self = shift;

  my $code_handler = $self->{'code_handler'};
  my $cut_handler  = $self->{'cut_handler'};
  my $wl_handler   = $self->{'whiteline_handler'};
  $self->{'line_count'} ||= 0;

  my $scratch;

  DEBUG > 4 and
   print STDERR "# Parsing starting at line ", $self->{'line_count'}, ".\n";

  DEBUG > 5 and
   print STDERR "#  About to parse lines: ",
     join(' ', map defined($_) ? "[$_]" : "EOF", @_), "\n";

  my $paras = ($self->{'paras'} ||= []);
   # paragraph buffer.  Because we need to defer processing of =over
   # directives and verbatim paragraphs.  We call _ponder_paragraph_buffer
   # to process this.

  $self->{'pod_para_count'} ||= 0;

  # An attempt to match the pod portions of a line.  This is not fool proof,
  # but is good enough to serve as part of the heuristic for guessing the pod
  # encoding if not specified.
  my $codes = join '', grep { / ^ [A-Za-z] $/x } sort keys %{$self->{accept_codes}};
  my $pod_chars_re = qr/ ^ = [A-Za-z]+ | [\Q$codes\E] < /x;

  my $line;
  foreach my $source_line (@_) {
    if( $self->{'source_dead'} ) {
      DEBUG > 4 and print STDERR "# Source is dead.\n";
      last;
    }

    unless( defined $source_line ) {
      DEBUG > 4 and print STDERR "# Undef-line seen.\n";

      push @$paras, ['~end', {'start_line' => $self->{'line_count'}}];
      push @$paras, $paras->[-1], $paras->[-1];
       # So that it definitely fills the buffer.
      $self->{'source_dead'} = 1;
      $self->_ponder_paragraph_buffer;
      next;
    }


    if( $self->{'line_count'}++ ) {
      ($line = $source_line) =~ tr/\n\r//d;
       # If we don't have two vars, we'll end up with that there
       # tr/// modding the (potentially read-only) original source line!

    } else {
      DEBUG > 2 and print STDERR "First line: [$source_line]\n";

      if( ($line = $source_line) =~ s/^$utf8_bom//s ) {
        DEBUG and print STDERR "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 ) {
        DEBUG and print STDERR "Big-endian UTF-16 BOM seen.  Aborting parsing.\n";
        $self->scream(
          $self->{'line_count'},
          "UTF16-BE Byte Encoding Mark found; but Pod::Simple v$Pod::Simple::VERSION doesn't implement UTF16 yet."
        );
        splice @_;
        push @_, undef;
        next;

        # TODO: implement somehow?

      } elsif( $line =~ s/^\xFF\xFE//s ) {
        DEBUG and print STDERR "Little-endian UTF-16 BOM seen.  Aborting parsing.\n";
        $self->scream(
          $self->{'line_count'},
          "UTF16-LE Byte Encoding Mark found; but Pod::Simple v$Pod::Simple::VERSION doesn't implement UTF16 yet."
        );
        splice @_;
        push @_, undef;
        next;

        # TODO: implement somehow?

      } else {
        DEBUG > 2 and print STDERR "First line is BOM-less.\n";
        ($line = $source_line) =~ tr/\n\r//d;
      }
    }

    if(!$self->{'parse_characters'} && !$self->{'encoding'}
      && ($self->{'in_pod'} || $line =~ /^=/s)
      && $line =~ /$non_ascii_re/
    ) {

      my $encoding;

      # No =encoding line, and we are at the first pod line in the input that
      # contains a non-ascii byte, that is, one whose meaning varies depending
      # on whether the file is encoded in UTF-8 or CP1252, which are the two
      # possibilities permitted by the pod spec.  (ASCII is assumed if the
      # file only contains ASCII bytes.)  In order to process this line, we
      # need to figure out what encoding we will use for the file.
      #
      # Strictly speaking ISO 8859-1 (Latin 1) refers to the code points
      # 160-255, but it is used here, as it often colloquially is, to refer to
      # the complete set of code points 0-255, including ASCII (0-127), the C1
      # controls (128-159), and strict Latin 1 (160-255).
      #
      # CP1252 is effectively a superset of Latin 1, because it differs only
      # from colloquial 8859-1 in the C1 controls, which are very unlikely to
      # actually be present in 8859-1 files, so can be used for other purposes
      # without conflict.  CP 1252 uses most of them for graphic characters.
      #
      # Note that all ASCII-range bytes represent their corresponding code
      # points in both CP1252 and UTF-8.  In ASCII platform UTF-8, all other
      # code points require multiple (non-ASCII) bytes to represent.  (A
      # separate paragraph for EBCDIC is below.)  The multi-byte
      # representation is quite structured.  If we find an isolated byte that
      # would require multiple bytes to represent in UTF-8, we know that the
      # encoding is not UTF-8.  If we find a sequence of bytes that violates
      # the UTF-8 structure, we also can presume the encoding isn't UTF-8, and
      # hence must be 1252.
      #
      # But there are ambiguous cases where we could guess wrong.  If so, the
      # user will end up having to supply an =encoding line.  We use all
      # readily available information to improve our chances of guessing
      # right.  The odds of something not being UTF-8, but still passing a
      # UTF-8 validity test go down very rapidly with increasing length of the
      # sequence.  Therefore we look at all non-ascii sequences on the line.
      # If any of the sequences can't be UTF-8, we quit there and choose
      # CP1252.  If all could be UTF-8, we see if any of the code points
      # represented are unlikely to be in pod.  If so, we guess CP1252.  If
      # not, we check if the line is all in the same script; if not guess
      # CP1252; otherwise UTF-8.  For perls that don't have convenient script
      # run testing, see if there is both Latin and non-Latin.  If so, CP1252,
      # otherwise UTF-8.
      #
      # On EBCDIC platforms, the situation is somewhat different.  In
      # UTF-EBCDIC, not only do ASCII-range bytes represent their code points,
      # but so do the bytes that are for the C1 controls.  Recall that these
      # correspond to the unused portion of 8859-1 that 1252 mostly takes
      # over.  That means that there are fewer code points that are
      # represented by multi-bytes.  But, note that the these controls are
      # very unlikely to be in pod text.  So if we encounter one of them, it
      # means that it is quite likely CP1252 and not UTF-8.  The net result is
      # the same code below is used for both platforms.
      #
      # XXX probably if the line has E that evaluates to illegal CP1252,
      # then it is UTF-8.  But we haven't processed E<> yet.

      goto set_1252 if $] lt 5.006_000;    # No UTF-8 on very early perls

      my $copy;

      no warnings 'utf8';

      if ($] ge 5.007_003) {
        $copy = $line;

        # On perls that have this function, we can use it to easily see if the
        # sequence is valid UTF-8 or not; if valid it turns on the UTF-8 flag
        # needed below for script run detection
        goto set_1252 if ! utf8::decode($copy);
      }
      elsif (ord("A") != 65) {  # Early EBCDIC, assume UTF-8.  What's a windows
                                # code page doing here anyway?
        goto set_utf8;
      }
      else { # ASCII, no decode(): do it ourselves using the fundamental
             # characteristics of UTF-8
        use if $] le 5.006002, 'utf8';

        my $char_ord;
        my $needed;         # How many continuation bytes to gobble up

        # Initialize the translated line with a dummy character that will be
        # deleted after everything else is done.  This dummy makes sure that
        # $copy will be in UTF-8.  Doing it now avoids the bugs in early perls
        # with upgrading in the middle
        $copy = chr(0x100);

        # Parse through the line
        for (my $i = 0; $i < length $line; $i++) {
          my $byte = substr($line, $i, 1);

          # ASCII bytes are trivially dealt with
          if ($byte !~ $non_ascii_re) {
            $copy .= $byte;
            next;
          }

          my $b_ord = ord $byte;

          # Now figure out what this code point would be if the input is
          # actually in UTF-8.  If, in the process, we discover that it isn't
          # well-formed UTF-8, we guess CP1252.
          #
          # Start the process.  If it is UTF-8, we are at the first, start
          # byte, of a multi-byte sequence.  We look at this byte to figure
          # out how many continuation bytes are needed, and to initialize the
          # code point accumulator with the data from this byte.
          #
          # Normally the minimum continuation byte is 0x80, but in certain
          # instances the minimum is a higher number.  So the code below
          # overrides this for those instances.
          my $min_cont = 0x80;

          if ($b_ord < 0xC2) { #  A start byte < C2 is malformed
            goto set_1252;
          }
          elsif ($b_ord <= 0xDF) {
            $needed = 1;
            $char_ord = $b_ord & 0x1F;
          }
          elsif ($b_ord <= 0xEF) {
            $min_cont = 0xA0 if $b_ord == 0xE0;
            $needed = 2;
            $char_ord = $b_ord & (0x1F >> 1);
          }
          elsif ($b_ord <= 0xF4) {
            $min_cont = 0x90 if $b_ord == 0xF0;
            $needed = 3;
            $char_ord = $b_ord & (0x1F >> 2);
          }
          else { # F4 is the highest start byte for legal Unicode; higher is
                 # unlikely to be in pod.
            goto set_1252;
          }

          # ? not enough continuation bytes available
          goto set_1252 if $i + $needed >= length $line;

          # Accumulate the ordinal of the character from the remaining
          # (continuation) bytes.
          while ($needed-- > 0) {
            my $cont = substr($line, ++$i, 1);
            $b_ord = ord $cont;
            goto set_1252 if $b_ord < $min_cont || $b_ord > 0xBF;

            # In all cases, any next continuation bytes all have the same
            # minimum legal value
            $min_cont = 0x80;

            # Accumulate this byte's contribution to the code point
            $char_ord <<= 6;
            $char_ord |= ($b_ord & 0x3F);
          }

          # Here, the sequence that formed this code point was valid UTF-8,
          # so add the completed character to the output
          $copy .= chr $char_ord;
        } # End of loop through line

        # Delete the dummy first character
        $copy = substr($copy, 1);
      }

      # Here, $copy is legal UTF-8.

      # If it can't be legal CP1252, no need to look further.  (These bytes
      # aren't valid in CP1252.)  This test could have been placed higher in
      # the code, but it seemed wrong to set the encoding to UTF-8 without
      # making sure that the very first instance is well-formed.  But what if
      # it isn't legal CP1252 either?  We have to choose one or the other, and
      # It seems safer to favor the single-byte encoding over the multi-byte.
      goto set_utf8 if ord("A") == 65 && $line =~ /[\x81\x8D\x8F\x90\x9D]/;

      # The C1 controls are not likely to appear in pod
      goto set_1252 if ord("A") == 65 && $copy =~ /[\x80-\x9F]/;

      # Nor are surrogates nor unassigned, nor deprecated.
      DEBUG > 8 and print STDERR __LINE__, ": $copy: surrogate\n" if $copy =~ $cs_re;
      goto set_1252 if $cs_re && $copy =~ $cs_re;
      DEBUG > 8 and print STDERR __LINE__, ": $copy: unassigned\n" if $cn_re && $copy =~ $cn_re;
      goto set_1252 if $cn_re && $copy =~ $cn_re;
      DEBUG > 8 and print STDERR __LINE__, ": $copy: deprecated\n" if $copy =~ $deprecated_re;
      goto set_1252 if $copy =~ $deprecated_re;

      # Nor are rare code points.  But this is hard to determine.  khw
      # believes that IPA characters and the modifier letters are unlikely to
      # be in pod (and certainly very unlikely to be the in the first line in
      # the pod containing non-ASCII)
      DEBUG > 8 and print STDERR __LINE__, ": $copy: rare\n" if $copy =~ $rare_blocks_re;
      goto set_1252 if $rare_blocks_re && $copy =~ $rare_blocks_re;

      # The first Unicode version included essentially every Latin character
      # in modern usage.  So, a Latin character not in the first release will
      # unlikely be in pod.
      DEBUG > 8 and print STDERR __LINE__, ": $copy: later_latin\n" if $later_latin_re && $copy =~ $later_latin_re;
      goto set_1252 if $later_latin_re && $copy =~ $later_latin_re;

      # On perls that handle script runs, if the UTF-8 interpretation yields
      # a single script, we guess UTF-8, otherwise just having a mixture of
      # scripts is suspicious, so guess CP1252.  We first strip off, as best
      # we can, the ASCII characters that look like they are pod directives,
      # as these would always show as mixed with non-Latin text.
      $copy =~ s/$pod_chars_re//g;

      if ($script_run_re) {
        goto set_utf8 if $copy =~ $script_run_re;
        DEBUG > 8 and print STDERR __LINE__, ":  not script run\n";
        goto set_1252;
      }

      # Even without script runs, but on recent enough perls and Unicodes, we
      # can check if there is a mixture of both Latin and non-Latin.  Again,
      # having a mixture of scripts is suspicious, so assume CP1252

      # If it's all non-Latin, there is no CP1252, as that is Latin
      # characters and punct, etc.
      DEBUG > 8 and print STDERR __LINE__, ": $copy: not latin\n" if $copy !~ $latin_re;
      goto set_utf8 if $copy !~ $latin_re;

      DEBUG > 8 and print STDERR __LINE__, ": $copy: all latin\n" if $copy =~ $every_char_is_latin_re;
      goto set_utf8 if $copy =~ $every_char_is_latin_re;

      DEBUG > 8 and print STDERR __LINE__, ": $copy: mixed\n";

     set_1252:
      DEBUG > 9 and print STDERR __LINE__, ": $copy: is 1252\n";
      $encoding = 'CP1252';
      goto done_set;

     set_utf8:
      DEBUG > 9 and print STDERR __LINE__, ": $copy: is UTF-8\n";
      $encoding = 'UTF-8';

     done_set:
      $self->_handle_encoding_line( "=encoding $encoding" );
      delete $self->{'_processed_encoding'};
      $self->{'_transcoder'} && $self->{'_transcoder'}->($line);

      my ($word) = $line =~ /(\S*$non_ascii_re\S*)/;

      $self->whine(
        $self->{'line_count'},
        "Non-ASCII character seen before =encoding in '$word'. Assuming $encoding"
      );
    }

    DEBUG > 5 and print STDERR "# Parsing line: [$line]\n";

    if(!$self->{'in_pod'}) {
      if($line =~ m/^=([a-zA-Z][a-zA-Z0-9]*)(?:\s|$)/s) {
        if($1 eq 'cut') {
          $self->scream(
            $self->{'line_count'},
            "=cut found outside a pod block.  Skipping to next block."
          );

          ## Before there were errata sections in the world, it was
          ## least-pessimal to abort processing the file.  But now we can
          ## just barrel on thru (but still not start a pod block).
          #splice @_;
          #push @_, undef;

          next;
        } else {
          $self->{'in_pod'} = $self->{'start_of_pod_block'}
                            = $self->{'last_was_blank'}     = 1;
          # And fall thru to the pod-mode block further down
        }
      } else {
        DEBUG > 5 and print STDERR "# It's a code-line.\n";
        $code_handler->(map $_, $line, $self->{'line_count'}, $self)
         if $code_handler;
        # Note: this may cause code to be processed out of order relative
        #  to pods, but in order relative to cuts.

        # Note also that we haven't yet applied the transcoding to $line
        #  by time we call $code_handler!

        if( $line =~ m/^#\s*line\s+(\d+)\s*(?:\s"([^"]+)")?\s*$/ ) {
          # That RE is from perlsyn, section "Plain Old Comments (Not!)",
          #$fname = $2 if defined $2;
          #DEBUG > 1 and defined $2 and print STDERR "# Setting fname to \"$fname\"\n";
          DEBUG > 1 and print STDERR "# Setting nextline to $1\n";
          $self->{'line_count'} = $1 - 1;
        }

        next;
      }
    }

    # . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
    # Else we're in pod mode:

    # Apply any necessary transcoding:
    $self->{'_transcoder'} && $self->{'_transcoder'}->($line);

    # HERE WE CATCH =encoding EARLY!
    if( $line =~ m/^=encoding\s+\S+\s*$/s ) {
      next if $self->parse_characters;   # Ignore this line
      $line = $self->_handle_encoding_line( $line );
    }

    if($line =~ m/^=cut/s) {
      # here ends the pod block, and therefore the previous pod para
      DEBUG > 1 and print STDERR "Noting =cut at line ${$self}{'line_count'}\n";
      $self->{'in_pod'} = 0;
      # ++$self->{'pod_para_count'};
      $self->_ponder_paragraph_buffer();
       # by now it's safe to consider the previous paragraph as done.
      DEBUG > 6 and print STDERR "Processing any cut handler, line ${$self}{'line_count'}\n";
      $cut_handler->(map $_, $line, $self->{'line_count'}, $self)
       if $cut_handler;

      # TODO: add to docs: Note: this may cause cuts to be processed out
      #  of order relative to pods, but in order relative to code.

    } elsif($line =~ m/^(\s*)$/s) {  # it's a blank line
      if (defined $1 and $1 =~ /[^\S\r\n]/) { # it's a white line
        $wl_handler->(map $_, $line, $self->{'line_count'}, $self)
          if $wl_handler;
      }

      if(!$self->{'start_of_pod_block'} and @$paras and $paras->[-1][0] eq '~Verbatim') {
        DEBUG > 1 and print STDERR "Saving blank line at line ${$self}{'line_count'}\n";
        push @{$paras->[-1]}, $line;
      }  # otherwise it's not interesting

      if(!$self->{'start_of_pod_block'} and !$self->{'last_was_blank'}) {
        DEBUG > 1 and print STDERR "Noting para ends with blank line at ${$self}{'line_count'}\n";
      }

      $self->{'last_was_blank'} = 1;

    } elsif($self->{'last_was_blank'}) {  # A non-blank line starting a new para...

      if($line =~ m/^(=[a-zA-Z][a-zA-Z0-9]*)(\s+|$)(.*)/s) {
        # THIS IS THE ONE PLACE WHERE WE CONSTRUCT NEW DIRECTIVE OBJECTS
        my $new = [$1, {'start_line' => $self->{'line_count'}}, $3];
        $new->[1]{'~orig_spacer'} = $2 if $2 && $2 ne " ";
         # Note that in "=head1 foo", the WS is lost.
         # Example: ['=head1', {'start_line' => 123}, ' foo']

        ++$self->{'pod_para_count'};

        $self->_ponder_paragraph_buffer();
         # by now it's safe to consider the previous paragraph as done.

        push @$paras, $new; # the new incipient paragraph
        DEBUG > 1 and print STDERR "Starting new ${$paras}[-1][0] para at line ${$self}{'line_count'}\n";

      } elsif($line =~ m/^\s/s) {

        if(!$self->{'start_of_pod_block'} and @$paras and $paras->[-1][0] eq '~Verbatim') {
          DEBUG > 1 and print STDERR "Resuming verbatim para at line ${$self}{'line_count'}\n";
          push @{$paras->[-1]}, $line;
        } else {
          ++$self->{'pod_para_count'};
          $self->_ponder_paragraph_buffer();
           # by now it's safe to consider the previous paragraph as done.
          DEBUG > 1 and print STDERR "Starting verbatim para at line ${$self}{'line_count'}\n";
          push @$paras, ['~Verbatim', {'start_line' => $self->{'line_count'}}, $line];
        }
      } else {
        ++$self->{'pod_para_count'};
        $self->_ponder_paragraph_buffer();
         # by now it's safe to consider the previous paragraph as done.
        push @$paras, ['~Para',  {'start_line' => $self->{'line_count'}}, $line];
        DEBUG > 1 and print STDERR "Starting plain para at line ${$self}{'line_count'}\n";
      }
      $self->{'last_was_blank'} = $self->{'start_of_pod_block'} = 0;

    } else {
      # It's a non-blank line /continuing/ the current para
      if(@$paras) {
        DEBUG > 2 and print STDERR "Line ${$self}{'line_count'} continues current paragraph\n";
        push @{$paras->[-1]}, $line;
      } else {
        # Unexpected case!
        die "Continuing a paragraph but \@\$paras is empty?";
      }
      $self->{'last_was_blank'} = $self->{'start_of_pod_block'} = 0;
    }

  } # ends the big while loop

  DEBUG > 1 and print STDERR (pretty(@$paras), "\n");
  return $self;
}

#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

sub _handle_encoding_line {
  my($self, $line) = @_;

  return if $self->parse_characters;

  # The point of this routine is to set $self->{'_transcoder'} as indicated.

  return $line unless $line =~ m/^=encoding\s+(\S+)\s*$/s;
  DEBUG > 1 and print STDERR "Found an encoding line \"=encoding $1\"\n";

  my $e    = $1;
  my $orig = $e;
  push @{ $self->{'encoding_command_reqs'} }, "=encoding $orig";

  my $enc_error;

  # Cf.   perldoc Encode   and   perldoc Encode::Supported

  require Pod::Simple::Transcode;

  if( $self->{'encoding'} ) {
    my $norm_current = $self->{'encoding'};
    my $norm_e = $e;
    foreach my $that ($norm_current, $norm_e) {
      $that =  lc($that);
      $that =~ s/[-_]//g;
    }
    if($norm_current eq $norm_e) {
      DEBUG > 1 and print STDERR "The '=encoding $orig' line is ",
       "redundant.  ($norm_current eq $norm_e).  Ignoring.\n";
      $enc_error = '';
       # But that doesn't necessarily mean that the earlier one went okay
    } else {
      $enc_error = "Encoding is already set to " . $self->{'encoding'};
      DEBUG > 1 and print STDERR $enc_error;
    }
  } elsif (
    # OK, let's turn on the encoding
    do {
      DEBUG > 1 and print STDERR " Setting encoding to $e\n";
      $self->{'encoding'} = $e;
      1;
    }
    and $e eq 'HACKRAW'
  ) {
    DEBUG and print STDERR " Putting in HACKRAW (no-op) encoding mode.\n";

  } elsif( Pod::Simple::Transcode::->encoding_is_available($e) ) {

    die($enc_error = "WHAT? _transcoder is already set?!")
     if $self->{'_transcoder'};   # should never happen
    require Pod::Simple::Transcode;
    $self->{'_transcoder'} = Pod::Simple::Transcode::->make_transcoder($e);
    eval {
      my @x = ('', "abc", "123");
      $self->{'_transcoder'}->(@x);
    };
    $@ && die( $enc_error =
      "Really unexpected error setting up encoding $e: $@\nAborting"
    );
    $self->{'detected_encoding'} = $e;

  } else {
    my @supported = Pod::Simple::Transcode::->all_encodings;

    # Note unsupported, and complain
    DEBUG and print STDERR " Encoding [$e] is unsupported.",
      "\nSupporteds: @supported\n";
    my $suggestion = '';

    # Look for a near match:
    my $norm = lc($e);
    $norm =~ tr[-_][]d;
    my $n;
    foreach my $enc (@supported) {
      $n = lc($enc);
      $n =~ tr[-_][]d;
      next unless $n eq $norm;
      $suggestion = "  (Maybe \"$e\" should be \"$enc\"?)";
      last;
    }
    my $encmodver = Pod::Simple::Transcode::->encmodver;
    $enc_error = join '' =>
      "This document probably does not appear as it should, because its ",
      "\"=encoding $e\" line calls for an unsupported encoding.",
      $suggestion, "  [$encmodver\'s supported encodings are: @supported]"
    ;

    $self->scream( $self->{'line_count'}, $enc_error );
  }
  push @{ $self->{'encoding_command_statuses'} }, $enc_error;
  if (defined($self->{'_processed_encoding'})) {
    # Double declaration.
    $self->scream( $self->{'line_count'}, 'Cannot have multiple =encoding directives');
  }
  $self->{'_processed_encoding'} = $orig;

  return $line;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

sub _handle_encoding_second_level {
  # By time this is called, the encoding (if well formed) will already
  #  have been acted on.
  my($self, $para) = @_;
  my @x = @$para;
  my $content = join ' ', splice @x, 2;
  $content =~ s/^\s+//s;
  $content =~ s/\s+$//s;

  DEBUG > 2 and print STDERR "Ogling encoding directive: =encoding $content\n";

  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 STDERR " CRAZY ERROR: It wasn't really handled?!\n";
    } elsif( $self->{'encoding_command_statuses'}[-1] ) {
      $self->whine( $para->[1]{'start_line'},
        sprintf "Couldn't do %s: %s",
          $self->{'encoding_command_reqs'  }[-1],
          $self->{'encoding_command_statuses'}[-1],
      );
    } else {
      DEBUG > 2 and print STDERR " (Yup, it was successfully handled already.)\n";
    }

  } else {
    # Otherwise it's a syntax error
    $self->whine( $para->[1]{'start_line'},
      "Invalid =encoding syntax: $content"
    );
  }

  return;
}

#~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`

{
my $m = -321;   # magic line number

sub _gen_errata {
  my $self = $_[0];
  # Return 0 or more fake-o paragraphs explaining the accumulated
  #  errors on this document.

  return() unless $self->{'errata'} and keys %{$self->{'errata'}};

  my @out;

  foreach my $line (sort {$a <=> $b} keys %{$self->{'errata'}}) {
    push @out,
      ['=item', {'start_line' => $m}, "Around line $line:"],
      map( ['~Para', {'start_line' => $m, '~cooked' => 1},
        #['~Top', {'start_line' => $m},
        $_
        #]
        ],
        @{$self->{'errata'}{$line}}
      )
    ;
  }

  # TODO: report of unknown entities? unrenderable characters?

  unshift @out,
    ['=head1', {'start_line' => $m, 'errata' => 1}, 'POD ERRORS'],
    ['~Para', {'start_line' => $m, '~cooked' => 1, 'errata' => 1},
     "Hey! ",
     ['B', {},
      'The above document had some coding errors, which are explained below:'
     ]
    ],
    ['=over',  {'start_line' => $m, 'errata' => 1}, ''],
  ;

  push @out,
    ['=back',  {'start_line' => $m, 'errata' => 1}, ''],
  ;

  DEBUG and print STDERR "\n<<\n", pretty(\@out), "\n>>\n\n";

  return @out;
}

}

#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

##############################################################################
##
##  stop reading now stop reading now stop reading now stop reading now stop
##
##                         HERE IT BECOMES REALLY SCARY
##
##  stop reading now stop reading now stop reading now stop reading now stop
##
##############################################################################

sub _ponder_paragraph_buffer {

  # Para-token types as found in the buffer.
  #   ~Verbatim, ~Para, ~end, =head1..4, =for, =begin, =end,
  #   =over, =back, =item
  #   and the null =pod (to be complained about if over one line)
  #
  # "~data" paragraphs are something we generate at this level, depending on
  # a currently open =over region

  # Events fired:  Begin and end for:
  #                   directivename (like head1 .. head4), item, extend,
  #                   for (from =begin...=end, =for),
  #                   over-bullet, over-number, over-text, over-block,
  #                   item-bullet, item-number, item-text,
  #                   Document,
  #                   Data, Para, Verbatim
  #                   B, C, longdirname (TODO -- wha?), etc. for all directives
  #

  my $self = $_[0];
  my $paras;
  return unless @{$paras = $self->{'paras'}};
  my $curr_open = ($self->{'curr_open'} ||= []);

  my $scratch;

  DEBUG > 10 and print STDERR "# Paragraph buffer: <<", pretty($paras), ">>\n";

  # We have something in our buffer.  So apparently the document has started.
  unless($self->{'doc_has_started'}) {
    $self->{'doc_has_started'} = 1;

    my $starting_contentless;
    $starting_contentless =
     (
       !@$curr_open
       and @$paras and ! grep $_->[0] ne '~end', @$paras
        # i.e., if the paras is all ~ends
     )
    ;
    DEBUG and print STDERR "# Starting ",
      $starting_contentless ? 'contentless' : 'contentful',
      " document\n"
    ;

    $self->_handle_element_start(
      ($scratch = 'Document'),
      {
        'start_line' => $paras->[0][1]{'start_line'},
        $starting_contentless ? ( 'contentless' => 1 ) : (),
      },
    );
  }

  my($para, $para_type);
  while(@$paras) {

    # If a directive, assume it's legal; subtract below if found not to be
    $seen_legal_directive++ if $paras->[0][0] =~ /^=/;

    last if      @$paras == 1
            and (    $paras->[0][0] eq '=over'
                 or  $paras->[0][0] eq '=item'
                 or ($paras->[0][0] eq '~Verbatim' and $self->{'in_pod'}));
    # Those're the three kinds of paragraphs that require lookahead.
    #   Actually, an "=item Foo" inside an  region
    #   and any =item inside an  region (rare)
    #   don't require any lookahead, but all others (bullets
    #   and numbers) do.
    # The verbatim is different from the other two, because those might be
    # like:
    #
    #   =item
    #   ...
    #   =cut
    #   ...
    #   =item
    #
    # The =cut here finishes the paragraph but doesn't terminate the =over
    # they should be in. (khw apologizes that he didn't comment at the time
    # why the 'in_pod' works, and no longer remembers why, and doesn't think
    # it is currently worth the effort to re-figure it out.)

# TODO: whinge about many kinds of directives in non-resolving =for regions?
# TODO: many?  like what?  =head1 etc?

    $para = shift @$paras;
    $para_type = $para->[0];

    DEBUG > 1 and print STDERR "Pondering a $para_type paragraph, given the stack: (",
      $self->_dump_curr_open(), ")\n";

    if($para_type eq '=for') {
      next if $self->_ponder_for($para,$curr_open,$paras);

    } elsif($para_type eq '=begin') {
      next if $self->_ponder_begin($para,$curr_open,$paras);

    } elsif($para_type eq '=end') {
      next if $self->_ponder_end($para,$curr_open,$paras);

    } elsif($para_type eq '~end') { # The virtual end-document signal
      next if $self->_ponder_doc_end($para,$curr_open,$paras);
    }


    # ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
    #~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
    if(grep $_->[1]{'~ignore'}, @$curr_open) {
      DEBUG > 1 and
       print STDERR "Skipping $para_type paragraph because in ignore mode.\n";
      next;
    }
    #~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
    # ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~

    if($para_type eq '=pod') {
      $self->_ponder_pod($para,$curr_open,$paras);

    } elsif($para_type eq '=over') {
      next if $self->_ponder_over($para,$curr_open,$paras);

    } elsif($para_type eq '=back') {
      next if $self->_ponder_back($para,$curr_open,$paras);

    } else {

      # All non-magical codes!!!

      # Here we start using $para_type for our own twisted purposes, to
      #  mean how it should get treated, not as what the element name
      #  should be.

      DEBUG > 1 and print STDERR "Pondering non-magical $para_type\n";

      my $i;

      # Enforce some =headN discipline
      if($para_type =~ m/^=head\d$/s
         and ! $self->{'accept_heads_anywhere'}
         and @$curr_open
         and $curr_open->[-1][0] eq '=over'
      ) {
        DEBUG > 2 and print STDERR "'=$para_type' inside an '=over'!\n";
        $self->whine(
          $para->[1]{'start_line'},
          "You forgot a '=back' before '$para_type'"
        );
        unshift @$paras, ['=back', {}, ''], $para;   # close the =over
        next;
      }


      if($para_type eq '=item') {

        my $over;
        unless(@$curr_open and
               $over = (grep { $_->[0] eq '=over' } @$curr_open)[-1]) {
          $self->whine(
            $para->[1]{'start_line'},
            "'=item' outside of any '=over'"
          );
          unshift @$paras,
            ['=over', {'start_line' => $para->[1]{'start_line'}}, ''],
            $para
          ;
          next;
        }


        my $over_type = $over->[1]{'~type'};

        if(!$over_type) {
          # Shouldn't happen1
          die "Typeless over in stack, starting at line "
           . $over->[1]{'start_line'};

        } elsif($over_type eq 'block') {
          unless($curr_open->[-1][1]{'~bitched_about'}) {
            $curr_open->[-1][1]{'~bitched_about'} = 1;
            $self->whine(
              $curr_open->[-1][1]{'start_line'},
              "You can't have =items (as at line "
              . $para->[1]{'start_line'}
              . ") unless the first thing after the =over is an =item"
            );
          }
          # Just turn it into a paragraph and reconsider it
          $para->[0] = '~Para';
          unshift @$paras, $para;
          next;

        } elsif($over_type eq 'text') {
          my $item_type = $self->_get_item_type($para);
            # That kills the content of the item if it's a number or bullet.
          DEBUG and print STDERR " Item is of type ", $para->[0], " under $over_type\n";

          if($item_type eq 'text') {
            # Nothing special needs doing for 'text'
          } elsif($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'};
             # Only a PROPER item-number element is allowed
             #  to have a number attribute.
          } else {
            die "Unhandled item type $item_type"; # should never happen
          }

          # =item-text thingies don't need any assimilation, it seems.

        } elsif($over_type eq 'number') {
          my $item_type = $self->_get_item_type($para);
            # That kills the content of the item if it's a number or bullet.
          DEBUG and print STDERR " Item is of type ", $para->[0], " under $over_type\n";

          my $expected_value = ++ $curr_open->[-1][1]{'~counter'};

          if($item_type eq 'bullet') {
            # Hm, it's not numeric.  Correct for this.
            $para->[1]{'number'} = $expected_value;
            $self->whine(
              $para->[1]{'start_line'},
              "Expected '=item $expected_value'"
            );
            push @$para, $para->[1]{'~orig_content'};
              # restore the bullet, blocking the assimilation of next para

          } elsif($item_type eq 'text') {
            # Hm, it's not numeric.  Correct for this.
            $para->[1]{'number'} = $expected_value;
            $self->whine(
              $para->[1]{'start_line'},
              "Expected '=item $expected_value'"
            );
            # Text content will still be there and will block next ~Para

          } elsif($item_type ne 'number') {
            die "Unknown item type $item_type"; # should never happen

          } elsif($expected_value == $para->[1]{'number'}) {
            DEBUG > 1 and print STDERR " Numeric item has the expected value of $expected_value\n";

          } else {
            DEBUG > 1 and print STDERR " Numeric item has ", $para->[1]{'number'},
             " instead of the expected value of $expected_value\n";
            $self->whine(
              $para->[1]{'start_line'},
              "You have '=item " . $para->[1]{'number'} .
              "' instead of the expected '=item $expected_value'"
            );
            $para->[1]{'number'} = $expected_value;  # correcting!!
          }

          if(@$para == 2) {
            # For the cases where we /didn't/ push to @$para
            if($paras->[0][0] eq '~Para') {
              DEBUG and print STDERR "Assimilating following ~Para content into $over_type item\n";
              push @$para, splice @{shift @$paras},2;
            } else {
              DEBUG and print STDERR "Can't assimilate following ", $paras->[0][0], "\n";
              push @$para, '';  # Just so it's not contentless
            }
          }


        } elsif($over_type eq 'bullet') {
          my $item_type = $self->_get_item_type($para);
            # That kills the content of the item if it's a number or bullet.
          DEBUG and print STDERR " Item is of type ", $para->[0], " under $over_type\n";

          if($item_type eq 'bullet') {
            # as expected!

            if( $para->[1]{'~_freaky_para_hack'} ) {
              DEBUG and print STDERR "Accomodating '=item * Foo' tolerance hack.\n";
              push @$para, $para->[1]{'~_freaky_para_hack'};
            }

          } elsif($item_type eq 'number') {
            $self->whine(
              $para->[1]{'start_line'},
              "Expected '=item *'"
            );
            push @$para, $para->[1]{'~orig_content'};
             # and block assimilation of the next paragraph
            delete $para->[1]{'number'};
             # Only a PROPER item-number element is allowed
             #  to have a number attribute.
          } elsif($item_type eq 'text') {
            $self->whine(
              $para->[1]{'start_line'},
              "Expected '=item *'"
            );
             # But doesn't need processing.  But it'll block assimilation
             #  of the next para.
          } else {
            die "Unhandled item type $item_type"; # should never happen
          }

          if(@$para == 2) {
            # For the cases where we /didn't/ push to @$para
            if($paras->[0][0] eq '~Para') {
              DEBUG and print STDERR "Assimilating following ~Para content into $over_type item\n";
              push @$para, splice @{shift @$paras},2;
            } else {
              DEBUG and print STDERR "Can't assimilate following ", $paras->[0][0], "\n";
              push @$para, '';  # Just so it's not contentless
            }
          }

        } else {
          die "Unhandled =over type \"$over_type\"?";
          # Shouldn't happen!
        }

        $para_type = 'Plain';
        $para->[0] .= '-' . $over_type;
        # Whew.  Now fall thru and process it.


      } elsif($para_type eq '=extend') {
        # Well, might as well implement it here.
        $self->_ponder_extend($para);
        next;  # and skip
      } elsif($para_type eq '=encoding') {
        # Not actually acted on here, but we catch errors here.
        $self->_handle_encoding_second_level($para);
        next unless $self->keep_encoding_directive;
        $para_type = 'Plain';
      } elsif($para_type eq '~Verbatim') {
        $para->[0] = 'Verbatim';
        $para_type = '?Verbatim';
      } elsif($para_type eq '~Para') {
        $para->[0] = 'Para';
        $para_type = '?Plain';
      } elsif($para_type eq 'Data') {
        $para->[0] = 'Data';
        $para_type = '?Data';
      } elsif( $para_type =~ s/^=//s
        and defined( $para_type = $self->{'accept_directives'}{$para_type} )
      ) {
        DEBUG > 1 and print STDERR " Pondering known directive ${$para}[0] as $para_type\n";
      } else {
        # An unknown directive!
        $seen_legal_directive--;
        DEBUG > 1 and printf STDERR "Unhandled directive %s (Handled: %s)\n",
         $para->[0], join(' ', sort keys %{$self->{'accept_directives'}} )
        ;
        $self->whine(
          $para->[1]{'start_line'},
          "Unknown directive: $para->[0]"
        );

        # And maybe treat it as text instead of just letting it go?
        next;
      }

      if($para_type =~ s/^\?//s) {
        if(! @$curr_open) {  # usual case
          DEBUG and print STDERR "Treating $para_type paragraph as such because stack is empty.\n";
        } else {
          my @fors = grep $_->[0] eq '=for', @$curr_open;
          DEBUG > 1 and print STDERR "Containing fors: ",
            join(',', map $_->[1]{'target'}, @fors), "\n";

          if(! @fors) {
            DEBUG and print STDERR "Treating $para_type paragraph as such because stack has no =for's\n";

          #} elsif(grep $_->[1]{'~resolve'}, @fors) {
          #} elsif(not grep !$_->[1]{'~resolve'}, @fors) {
          } elsif( $fors[-1][1]{'~resolve'} ) {
            # Look to the immediately containing for

            if($para_type eq 'Data') {
              DEBUG and print STDERR "Treating Data paragraph as Plain/Verbatim because the containing =for ($fors[-1][1]{'target'}) is a resolver\n";
              $para->[0] = 'Para';
              $para_type = 'Plain';
            } else {
              DEBUG and print STDERR "Treating $para_type paragraph as such because the containing =for ($fors[-1][1]{'target'}) is a resolver\n";
            }
          } else {
            DEBUG and print STDERR "Treating $para_type paragraph as Data because the containing =for ($fors[-1][1]{'target'}) is a non-resolver\n";
            $para->[0] = $para_type = 'Data';
          }
        }
      }

      #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      if($para_type eq 'Plain') {
        $self->_ponder_Plain($para);
      } elsif($para_type eq 'Verbatim') {
        $self->_ponder_Verbatim($para);
      } elsif($para_type eq 'Data') {
        $self->_ponder_Data($para);
      } else {
        die "\$para type is $para_type -- how did that happen?";
        # Shouldn't happen.
      }

      #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      $para->[0] =~ s/^[~=]//s;

      DEBUG and print STDERR "\n", pretty($para), "\n";

      # traverse the treelet (which might well be just one string scalar)
      $self->{'content_seen'} ||= 1 if   $seen_legal_directive
                                    && ! $self->{'~tried_gen_errata'};
      $self->_traverse_treelet_bit(@$para);
    }
  }

  return;
}

###########################################################################
# The sub-ponderers...



sub _ponder_for {
  my ($self,$para,$curr_open,$paras) = @_;

  # Fake it out as a begin/end
  my $target;

  if(grep $_->[1]{'~ignore'}, @$curr_open) {
    DEBUG > 1 and print STDERR "Ignoring ignorable =for\n";
    return 1;
  }

  for(my $i = 2; $i < @$para; ++$i) {
    if($para->[$i] =~ s/^\s*(\S+)\s*//s) {
      $target = $1;
      last;
    }
  }
  unless(defined $target) {
    $self->whine(
      $para->[1]{'start_line'},
      "=for without a target?"
    );
    return 1;
  }
  DEBUG > 1 and
   print STDERR "Faking out a =for $target as a =begin $target / =end $target\n";

  $para->[0] = 'Data';

  unshift @$paras,
    ['=begin',
      {'start_line' => $para->[1]{'start_line'}, '~really' => '=for'},
      $target,
    ],
    $para,
    ['=end',
      {'start_line' => $para->[1]{'start_line'}, '~really' => '=for'},
      $target,
    ],
  ;

  return 1;
}

sub _ponder_begin {
  my ($self,$para,$curr_open,$paras) = @_;
  my $content = join ' ', splice @$para, 2;
  $content =~ s/^\s+//s;
  $content =~ s/\s+$//s;
  unless(length($content)) {
    $self->whine(
      $para->[1]{'start_line'},
      "=begin without a target?"
    );
    DEBUG and print STDERR "Ignoring targetless =begin\n";
    return 1;
  }

  my ($target, $title) = $content =~ m/^(\S+)\s*(.*)$/;
  $para->[1]{'title'} = $title if ($title);
  $para->[1]{'target'} = $target;  # without any ':'
  $content = $target; # strip off the title

  $content =~ s/^:!/!:/s;
  my $neg;  # whether this is a negation-match
  $neg = 1        if $content =~ s/^!//s;
  my $to_resolve;  # whether to process formatting codes
  $to_resolve = 1 if $content =~ s/^://s;

  my $dont_ignore; # whether this target matches us

  foreach my $target_name (
    split(',', $content, -1),
    $neg ? () : '*'
  ) {
    DEBUG > 2 and
     print STDERR " Considering whether =begin $content matches $target_name\n";
    next unless $self->{'accept_targets'}{$target_name};

    DEBUG > 2 and
     print STDERR "  It DOES match the acceptable target $target_name!\n";
    $to_resolve = 1
      if $self->{'accept_targets'}{$target_name} eq 'force_resolve';
    $dont_ignore = 1;
    $para->[1]{'target_matching'} = $target_name;
    last; # stop looking at other target names
  }

  if($neg) {
    if( $dont_ignore ) {
      $dont_ignore = '';
      delete $para->[1]{'target_matching'};
      DEBUG > 2 and print STDERR " But the leading ! means that this is a NON-match!\n";
    } else {
      $dont_ignore = 1;
      $para->[1]{'target_matching'} = '!';
      DEBUG > 2 and print STDERR " But the leading ! means that this IS a match!\n";
    }
  }

  $para->[0] = '=for';  # Just what we happen to call these, internally
  $para->[1]{'~really'} ||= '=begin';
  $para->[1]{'~ignore'}   = (! $dont_ignore) || 0;
  $para->[1]{'~resolve'}  = $to_resolve || 0;

  DEBUG > 1 and print STDERR " Making note to ", $dont_ignore ? 'not ' : '',
    "ignore contents of this region\n";
  DEBUG > 1 and $dont_ignore and print STDERR " Making note to treat contents as ",
    ($to_resolve ? 'verbatim/plain' : 'data'), " paragraphs\n";
  DEBUG > 1 and print STDERR " (Stack now: ", $self->_dump_curr_open(), ")\n";

  push @$curr_open, $para;
  if(!$dont_ignore or scalar grep $_->[1]{'~ignore'}, @$curr_open) {
    DEBUG > 1 and print STDERR "Ignoring ignorable =begin\n";
  } else {
    $self->{'content_seen'} ||= 1 unless $self->{'~tried_gen_errata'};
    $self->_handle_element_start((my $scratch='for'), $para->[1]);
  }

  return 1;
}

sub _ponder_end {
  my ($self,$para,$curr_open,$paras) = @_;
  my $content = join ' ', splice @$para, 2;
  $content =~ s/^\s+//s;
  $content =~ s/\s+$//s;
  DEBUG and print STDERR "Ogling '=end $content' directive\n";

  unless(length($content)) {
    $self->whine(
      $para->[1]{'start_line'},
      "'=end' without a target?" . (
        ( @$curr_open and $curr_open->[-1][0] eq '=for' )
        ? ( " (Should be \"=end " . $curr_open->[-1][1]{'target'} . '")' )
        : ''
      )
    );
    DEBUG and print STDERR "Ignoring targetless =end\n";
    return 1;
  }

  unless($content =~ m/^\S+$/) {  # i.e., unless it's one word
    $self->whine(
      $para->[1]{'start_line'},
      "'=end $content' is invalid.  (Stack: "
      . $self->_dump_curr_open() . ')'
    );
    DEBUG and print STDERR "Ignoring mistargetted =end $content\n";
    return 1;
  }

  unless(@$curr_open and $curr_open->[-1][0] eq '=for') {
    $self->whine(
      $para->[1]{'start_line'},
      "=end $content without matching =begin.  (Stack: "
      . $self->_dump_curr_open() . ')'
    );
    DEBUG and print STDERR "Ignoring mistargetted =end $content\n";
    return 1;
  }

  unless($content eq $curr_open->[-1][1]{'target'}) {
    $self->whine(
      $para->[1]{'start_line'},
      "=end $content doesn't match =begin "
      . $curr_open->[-1][1]{'target'}
      . ".  (Stack: "
      . $self->_dump_curr_open() . ')'
    );
    DEBUG and print STDERR "Ignoring mistargetted =end $content at line $para->[1]{'start_line'}\n";
    return 1;
  }

  # Else it's okay to close...
  if(grep $_->[1]{'~ignore'}, @$curr_open) {
    DEBUG > 1 and print STDERR "Not firing any event for this =end $content because in an ignored region\n";
    # And that may be because of this to-be-closed =for region, or some
    #  other one, but it doesn't matter.
  } else {
    $curr_open->[-1][1]{'start_line'} = $para->[1]{'start_line'};
      # what's that for?

    $self->{'content_seen'} ||= 1 unless $self->{'~tried_gen_errata'};
    $self->_handle_element_end( my $scratch = 'for', $para->[1]);
  }
  DEBUG > 1 and print STDERR "Popping $curr_open->[-1][0] $curr_open->[-1][1]{'target'} because of =end $content\n";
  pop @$curr_open;

  return 1;
}

sub _ponder_doc_end {
  my ($self,$para,$curr_open,$paras) = @_;
  if(@$curr_open) { # Deal with things left open
    DEBUG and print STDERR "Stack is nonempty at end-document: (",
      $self->_dump_curr_open(), ")\n";

    DEBUG > 9 and print STDERR "Stack: ", pretty($curr_open), "\n";
    unshift @$paras, $self->_closers_for_all_curr_open;
    # Make sure there is exactly one ~end in the parastack, at the end:
    @$paras = grep $_->[0] ne '~end', @$paras;
    push @$paras, $para, $para;
     # We need two -- once for the next cycle where we
     #  generate errata, and then another to be at the end
     #  when that loop back around to process the errata.
    return 1;

  } else {
    DEBUG and print STDERR "Okay, stack is empty now.\n";
  }

  # Try generating errata section, if applicable
  unless($self->{'~tried_gen_errata'}) {
    $self->{'~tried_gen_errata'} = 1;
    my @extras = $self->_gen_errata();
    if(@extras) {
      unshift @$paras, @extras;
      DEBUG and print STDERR "Generated errata... relooping...\n";
      return 1;  # I.e., loop around again to process these fake-o paragraphs
    }
  }

  splice @$paras; # Well, that's that for this paragraph buffer.
  DEBUG and print STDERR "Throwing end-document event.\n";

  $self->_handle_element_end( my $scratch = 'Document' );
  return 1; # Hasta la byebye
}

sub _ponder_pod {
  my ($self,$para,$curr_open,$paras) = @_;
  $self->whine(
    $para->[1]{'start_line'},
    "=pod directives shouldn't be over one line long!  Ignoring all "
     . (@$para - 2) . " lines of content"
  ) if @$para > 3;

  # Content ignored unless 'pod_handler' is set
  if (my $pod_handler = $self->{'pod_handler'}) {
      my ($line_num, $line) = map $_, $para->[1]{'start_line'}, $para->[2];
      $line = $line eq '' ? "=pod" : "=pod $line"; # imitate cut_handler output
      $pod_handler->($line, $line_num, $self);
  }

  # The surrounding methods set content_seen, so let us remain consistent.
  # I do not know why it was not here before -- should it not be here?
  # $self->{'content_seen'} ||= 1 unless $self->{'~tried_gen_errata'};

  return;
}

sub _ponder_over {
  my ($self,$para,$curr_open,$paras) = @_;
  return 1 unless @$paras;
  my $list_type;

  if($paras->[0][0] eq '=item') { # most common case
    $list_type = $self->_get_initial_item_type($paras->[0]);

  } elsif($paras->[0][0] eq '=back') {
    # Ignore empty lists by default
    if ($self->{'parse_empty_lists'}) {
      $list_type = 'empty';
    } else {
      shift @$paras;
      return 1;
    }
  } elsif($paras->[0][0] eq '~end') {
    $self->whine(
      $para->[1]{'start_line'},
      "=over is the last thing in the document?!"
    );
    return 1; # But feh, ignore it.
  } else {
    $list_type = 'block';
  }
  $para->[1]{'~type'} = $list_type;
  push @$curr_open, $para;
   # yes, we reuse the paragraph as a stack item

  my $content = join ' ', splice @$para, 2;
  $para->[1]{'~orig_content'} = $content;
  my $overness;
  if($content =~ m/^\s*$/s) {
    $para->[1]{'indent'} = 4;
  } elsif($content =~ m/^\s*((?:\d*\.)?\d+)\s*$/s) {
    no integer;
    $para->[1]{'indent'} = $1;
    if($1 == 0) {
      $self->whine(
        $para->[1]{'start_line'},
        "Can't have a 0 in =over $content"
      );
      $para->[1]{'indent'} = 4;
    }
  } else {
    $self->whine(
      $para->[1]{'start_line'},
      "=over should be: '=over' or '=over positive_number'"
    );
    $para->[1]{'indent'} = 4;
  }
  DEBUG > 1 and print STDERR "=over found of type $list_type\n";

  $self->{'content_seen'} ||= 1 unless $self->{'~tried_gen_errata'};
  $self->_handle_element_start((my $scratch = 'over-' . $list_type), $para->[1]);

  return;
}

sub _ponder_back {
  my ($self,$para,$curr_open,$paras) = @_;
  # TODO: fire off  or  or  ??

  my $content = join ' ', splice @$para, 2;
  if($content =~ m/\S/) {
    $self->whine(
      $para->[1]{'start_line'},
      "=back doesn't take any parameters, but you said =back $content"
    );
  }

  if(@$curr_open and $curr_open->[-1][0] eq '=over') {
    DEBUG > 1 and print STDERR "=back happily closes matching =over\n";
    # Expected case: we're closing the most recently opened thing
    #my $over = pop @$curr_open;
    $self->{'content_seen'} ||= 1 unless $self->{'~tried_gen_errata'};
    $self->_handle_element_end( my $scratch =
      'over-' . ( (pop @$curr_open)->[1]{'~type'} ), $para->[1]
    );
  } else {
    DEBUG > 1 and print STDERR "=back found without a matching =over.  Stack: (",
        join(', ', map $_->[0], @$curr_open), ").\n";
    $self->whine(
      $para->[1]{'start_line'},
      '=back without =over'
    );
    return 1; # and ignore it
  }
}

sub _ponder_item {
  my ($self,$para,$curr_open,$paras) = @_;
  my $over;
  unless(@$curr_open and
         $over = (grep { $_->[0] eq '=over' } @$curr_open)[-1]) {
    $self->whine(
      $para->[1]{'start_line'},
      "'=item' outside of any '=over'"
    );
    unshift @$paras,
      ['=over', {'start_line' => $para->[1]{'start_line'}}, ''],
      $para
    ;
    return 1;
  }


  my $over_type = $over->[1]{'~type'};

  if(!$over_type) {
    # Shouldn't happen1
    die "Typeless over in stack, starting at line "
     . $over->[1]{'start_line'};

  } elsif($over_type eq 'block') {
    unless($curr_open->[-1][1]{'~bitched_about'}) {
      $curr_open->[-1][1]{'~bitched_about'} = 1;
      $self->whine(
        $curr_open->[-1][1]{'start_line'},
        "You can't have =items (as at line "
        . $para->[1]{'start_line'}
        . ") unless the first thing after the =over is an =item"
      );
    }
    # Just turn it into a paragraph and reconsider it
    $para->[0] = '~Para';
    unshift @$paras, $para;
    return 1;

  } elsif($over_type eq 'text') {
    my $item_type = $self->_get_item_type($para);
      # That kills the content of the item if it's a number or bullet.
    DEBUG and print STDERR " Item is of type ", $para->[0], " under $over_type\n";

    if($item_type eq 'text') {
      # Nothing special needs doing for 'text'
    } elsif($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'};
       # Only a PROPER item-number element is allowed
       #  to have a number attribute.
    } else {
      die "Unhandled item type $item_type"; # should never happen
    }

    # =item-text thingies don't need any assimilation, it seems.

  } elsif($over_type eq 'number') {
    my $item_type = $self->_get_item_type($para);
      # That kills the content of the item if it's a number or bullet.
    DEBUG and print STDERR " Item is of type ", $para->[0], " under $over_type\n";

    my $expected_value = ++ $curr_open->[-1][1]{'~counter'};

    if($item_type eq 'bullet') {
      # Hm, it's not numeric.  Correct for this.
      $para->[1]{'number'} = $expected_value;
      $self->whine(
        $para->[1]{'start_line'},
        "Expected '=item $expected_value'"
      );
      push @$para, $para->[1]{'~orig_content'};
        # restore the bullet, blocking the assimilation of next para

    } elsif($item_type eq 'text') {
      # Hm, it's not numeric.  Correct for this.
      $para->[1]{'number'} = $expected_value;
      $self->whine(
        $para->[1]{'start_line'},
        "Expected '=item $expected_value'"
      );
      # Text content will still be there and will block next ~Para

    } elsif($item_type ne 'number') {
      die "Unknown item type $item_type"; # should never happen

    } elsif($expected_value == $para->[1]{'number'}) {
      DEBUG > 1 and print STDERR " Numeric item has the expected value of $expected_value\n";

    } else {
      DEBUG > 1 and print STDERR " Numeric item has ", $para->[1]{'number'},
       " instead of the expected value of $expected_value\n";
      $self->whine(
        $para->[1]{'start_line'},
        "You have '=item " . $para->[1]{'number'} .
        "' instead of the expected '=item $expected_value'"
      );
      $para->[1]{'number'} = $expected_value;  # correcting!!
    }

    if(@$para == 2) {
      # For the cases where we /didn't/ push to @$para
      if($paras->[0][0] eq '~Para') {
        DEBUG and print STDERR "Assimilating following ~Para content into $over_type item\n";
        push @$para, splice @{shift @$paras},2;
      } else {
        DEBUG and print STDERR "Can't assimilate following ", $paras->[0][0], "\n";
        push @$para, '';  # Just so it's not contentless
      }
    }


  } elsif($over_type eq 'bullet') {
    my $item_type = $self->_get_item_type($para);
      # That kills the content of the item if it's a number or bullet.
    DEBUG and print STDERR " Item is of type ", $para->[0], " under $over_type\n";

    if($item_type eq 'bullet') {
      # as expected!

      if( $para->[1]{'~_freaky_para_hack'} ) {
        DEBUG and print STDERR "Accomodating '=item * Foo' tolerance hack.\n";
        push @$para, $para->[1]{'~_freaky_para_hack'};
      }

    } elsif($item_type eq 'number') {
      $self->whine(
        $para->[1]{'start_line'},
        "Expected '=item *'"
      );
      push @$para, $para->[1]{'~orig_content'};
       # and block assimilation of the next paragraph
      delete $para->[1]{'number'};
       # Only a PROPER item-number element is allowed
       #  to have a number attribute.
    } elsif($item_type eq 'text') {
      $self->whine(
        $para->[1]{'start_line'},
        "Expected '=item *'"
      );
       # But doesn't need processing.  But it'll block assimilation
       #  of the next para.
    } else {
      die "Unhandled item type $item_type"; # should never happen
    }

    if(@$para == 2) {
      # For the cases where we /didn't/ push to @$para
      if($paras->[0][0] eq '~Para') {
        DEBUG and print STDERR "Assimilating following ~Para content into $over_type item\n";
        push @$para, splice @{shift @$paras},2;
      } else {
        DEBUG and print STDERR "Can't assimilate following ", $paras->[0][0], "\n";
        push @$para, '';  # Just so it's not contentless
      }
    }

  } else {
    die "Unhandled =over type \"$over_type\"?";
    # Shouldn't happen!
  }
  $para->[0] .= '-' . $over_type;

  return;
}

sub _ponder_Plain {
  my ($self,$para) = @_;
  DEBUG and print STDERR " giving plain treatment...\n";
  unless( @$para == 2 or ( @$para == 3 and $para->[2] eq '' )
    or $para->[1]{'~cooked'}
  ) {
    push @$para,
    @{$self->_make_treelet(
      join("\n", splice(@$para, 2)),
      $para->[1]{'start_line'}
    )};
  }
  # Empty paragraphs don't need a treelet for any reason I can see.
  # And precooked paragraphs already have a treelet.
  return;
}

sub _ponder_Verbatim {
  my ($self,$para) = @_;
  DEBUG and print STDERR " giving verbatim treatment...\n";

  $para->[1]{'xml:space'} = 'preserve';

  unless ($self->{'_output_is_for_JustPod'}) {
    # Fix illegal settings for expand_verbatim_tabs()
    # This is because this module doesn't do input error checking, but khw
    # doesn't want to add yet another instance of that.
    my $tab_width = $self->expand_verbatim_tabs;
    $tab_width = $self->expand_verbatim_tabs(8)
        if ! defined $tab_width
        ||   $tab_width =~ /\D/;

    my $indent = $self->strip_verbatim_indent;
    if ($indent && ref $indent eq 'CODE') {
        my @shifted = (shift @{$para}, shift @{$para});
        $indent = $indent->($para);
        unshift @{$para}, @shifted;
    }

    for(my $i = 2; $i < @$para; $i++) {
      foreach my $line ($para->[$i]) { # just for aliasing
        # Strip indentation.
        $line =~ s/^\Q$indent// if $indent;
        next unless $tab_width;

            # This is commented out because of github issue #85, and the
            # current maintainers don't know why it was there in the first
            # place.
            #&& !($self->{accept_codes} && $self->{accept_codes}{VerbatimFormatted});
        while( $line =~
          # Sort of adapted from Text::Tabs.
          s/^([^\t]*)(\t+)/$1.(" " x ((length($2)
                                       * $tab_width)
                                       -(length($1) % $tab_width)))/e
        ) {}

        # TODO: whinge about (or otherwise treat) unindented or overlong lines

      }
    }
  }

  # Now the VerbatimFormatted hoodoo...
  if( $self->{'accept_codes'} and
      $self->{'accept_codes'}{'VerbatimFormatted'}
  ) {
    while(@$para > 3 and $para->[-1] !~ m/\S/) { pop @$para }
     # Kill any number of terminal newlines
    $self->_verbatim_format($para);
  } elsif ($self->{'codes_in_verbatim'}) {
    push @$para,
    @{$self->_make_treelet(
      join("\n", splice(@$para, 2)),
      $para->[1]{'start_line'}, $para->[1]{'xml:space'}
    )};
    $para->[-1] =~ s/\n+$//s; # Kill any number of terminal newlines
  } else {
    push @$para, join "\n", splice(@$para, 2) if @$para > 3;
    $para->[-1] =~ s/\n+$//s; # Kill any number of terminal newlines
  }
  return;
}

sub _ponder_Data {
  my ($self,$para) = @_;
  DEBUG and print STDERR " giving data treatment...\n";
  $para->[1]{'xml:space'} = 'preserve';
  push @$para, join "\n", splice(@$para, 2) if @$para > 3;
  return;
}




###########################################################################

sub _traverse_treelet_bit {  # for use only by the routine above
  my($self, $name) = splice @_,0,2;

  my $scratch;
  $self->_handle_element_start(($scratch=$name), shift @_);

  while (@_) {
    my $x = shift;
    if (ref($x)) {
      &_traverse_treelet_bit($self, @$x);
    } else {
      $x .= shift while @_ && !ref($_[0]);
      $self->_handle_text($x);
    }
  }

  $self->_handle_element_end($scratch=$name);
  return;
}

#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

sub _closers_for_all_curr_open {
  my $self = $_[0];
  my @closers;
  foreach my $still_open (@{  $self->{'curr_open'} || return  }) {
    my @copy = @$still_open;
    $copy[1] = {%{ $copy[1] }};
    #$copy[1]{'start_line'} = -1;
    if($copy[0] eq '=for') {
      $copy[0] = '=end';
    } elsif($copy[0] eq '=over') {
      $self->whine(
        $still_open->[1]{start_line} ,
        "=over without closing =back"
      );

      $copy[0] = '=back';
    } else {
      die "I don't know how to auto-close an open $copy[0] region";
    }

    unless( @copy > 2 ) {
      push @copy, $copy[1]{'target'};
      $copy[-1] = '' unless defined $copy[-1];
       # since =over's don't have targets
    }

    $copy[1]{'fake-closer'} = 1;

    DEBUG and print STDERR "Queuing up fake-o event: ", pretty(\@copy), "\n";
    unshift @closers, \@copy;
  }
  return @closers;
}

#--------------------------------------------------------------------------

sub _verbatim_format {
  my($it, $p) = @_;

  my $formatting;

  for(my $i = 2; $i < @$p; $i++) { # work backwards over the lines
    DEBUG and print STDERR "_verbatim_format appends a newline to $i: $p->[$i]\n";
    $p->[$i] .= "\n";
     # Unlike with simple Verbatim blocks, we don't end up just doing
     # a join("\n", ...) on the contents, so we have to append a
     # newline to every line, and then nix the last one later.
  }

  if( DEBUG > 4 ) {
    print STDERR "<<\n";
    for(my $i = $#$p; $i >= 2; $i--) { # work backwards over the lines
      print STDERR "_verbatim_format $i: $p->[$i]";
    }
    print STDERR ">>\n";
  }

  for(my $i = $#$p; $i > 2; $i--) {
    # work backwards over the lines, except the first (#2)

    #next unless $p->[$i]   =~ m{^#:([ \^\/\%]*)\n?$}s
    #        and $p->[$i-1] !~ m{^#:[ \^\/\%]*\n?$}s;
     # look at a formatty line preceding a nonformatty one
    DEBUG > 5 and print STDERR "Scrutinizing line $i: $$p[$i]\n";
    if($p->[$i]   =~ m{^#:([ \^\/\%]*)\n?$}s) {
      DEBUG > 5 and print STDERR "  It's a formatty line.  ",
       "Peeking at previous line ", $i-1, ": $$p[$i-1]: \n";

      if( $p->[$i-1] =~ m{^#:[ \^\/\%]*\n?$}s ) {
        DEBUG > 5 and print STDERR "  Previous line is formatty!  Skipping this one.\n";
        next;
      } else {
        DEBUG > 5 and print STDERR "  Previous line is non-formatty!  Yay!\n";
      }
    } else {
      DEBUG > 5 and print STDERR "  It's not a formatty line.  Ignoring\n";
      next;
    }

    # A formatty line has to have #: in the first two columns, and uses
    # "^" to mean bold, "/" to mean underline, and "%" to mean bold italic.
    # Example:
    #   What do you want?  i like pie. [or whatever]
    # #:^^^^^^^^^^^^^^^^^              /////////////


    DEBUG > 4 and print STDERR "_verbatim_format considers:\n<$p->[$i-1]>\n<$p->[$i]>\n";

    $formatting = '  ' . $1;
    $formatting =~ s/\s+$//s; # nix trailing whitespace
    unless(length $formatting and $p->[$i-1] =~ m/\S/) { # no-op
      splice @$p,$i,1; # remove this line
      $i--; # don't consider next line
      next;
    }

    if( length($formatting) >= length($p->[$i-1]) ) {
      $formatting = substr($formatting, 0, length($p->[$i-1]) - 1) . ' ';
    } else {
      $formatting .= ' ' x (length($p->[$i-1]) - length($formatting));
    }
    # Make $formatting and the previous line be exactly the same length,
    # with $formatting having a " " as the last character.

    DEBUG > 4 and print STDERR "Formatting <$formatting>    on <", $p->[$i-1], ">\n";


    my @new_line;
    while( $formatting =~ m{\G(( +)|(\^+)|(\/+)|(\%+))}g ) {
      #print STDERR "Format matches $1\n";

      if($2) {
        #print STDERR "SKIPPING <$2>\n";
        push @new_line,
          substr($p->[$i-1], pos($formatting)-length($1), length($1));
      } else {
        #print STDERR "SNARING $+\n";
        push @new_line, [
          (
            $3 ? 'VerbatimB'  :
            $4 ? 'VerbatimI'  :
            $5 ? 'VerbatimBI' : die("Should never get called")
          ), {},
          substr($p->[$i-1], pos($formatting)-length($1), length($1))
        ];
        #print STDERR "Formatting <$new_line[-1][-1]> as $new_line[-1][0]\n";
      }
    }
    my @nixed =
      splice @$p, $i-1, 2, @new_line; # replace myself and the next line
    DEBUG > 10 and print STDERR "Nixed count: ", scalar(@nixed), "\n";

    DEBUG > 6 and print STDERR "New version of the above line is these tokens (",
      scalar(@new_line), "):",
      map( ref($_)?"<@$_> ":"<$_>", @new_line ), "\n";
    $i--; # So the next line we scrutinize is the line before the one
          #  that we just went and formatted
  }

  $p->[0] = 'VerbatimFormatted';

  # Collapse adjacent text nodes, just for kicks.
  for( my $i = 2; $i > $#$p; $i++ ) { # work forwards over the tokens except for the last
    if( !ref($p->[$i]) and !ref($p->[$i + 1]) ) {
      DEBUG > 5 and print STDERR "_verbatim_format merges {$p->[$i]} and {$p->[$i+1]}\n";
      $p->[$i] .= splice @$p, $i+1, 1; # merge
      --$i;  # and back up
    }
  }

  # Now look for the last text token, and remove the terminal newline
  for( my $i = $#$p; $i >= 2; $i-- ) {
    # work backwards over the tokens, even the first
    if( !ref($p->[$i]) ) {
      if($p->[$i] =~ s/\n$//s) {
        DEBUG > 5 and print STDERR "_verbatim_format killed the terminal newline on #$i: {$p->[$i]}, after {$p->[$i-1]}\n";
      } else {
        DEBUG > 5 and print STDERR
         "No terminal newline on #$i: {$p->[$i]}, after {$p->[$i-1]} !?\n";
      }
      last; # we only want the next one
    }
  }

  return;
}


#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@


sub _treelet_from_formatting_codes {
  # Given a paragraph, returns a treelet.  Full of scary tokenizing code.
  #  Like [ '~Top', {'start_line' => $start_line},
  #            "I like ",
  #            [ 'B', {}, "pie" ],
  #            "!"
  #       ]
  # This illustrates the general format of a treelet.  It is an array:
  #     [0]       is a scalar indicating its type.  In the example above, the
  #               types are '~Top' and 'B'
  #     [1]       is a hash of various flags about it, possibly empty
  #     [2] - [N] are an ordered list of the subcomponents of the treelet.
  #               Scalars are literal text, refs are sub-treelets, to
  #               arbitrary levels.  Stringifying a treelet will recursively
  #               stringify the sub-treelets, concatentating everything
  #               together to form the exact text of the treelet.

  my($self, $para, $start_line, $preserve_space) = @_;

  my $treelet = ['~Top', {'start_line' => $start_line},];

  unless ($preserve_space || $self->{'preserve_whitespace'}) {
    $para =~ s/\s+/ /g; # collapse and trim all whitespace first.
    $para =~ s/ $//;
    $para =~ s/^ //;
  }

  # Only apparent problem the above code is that N<<  >> turns into
  # N<< >>.  But then, word wrapping does that too!  So don't do that!


  # As a Start-code is encountered, the number of opening bracket '<'
  # characters minus 1 is pushed onto @stack (so 0 means a single bracket,
  # etc).  When closing brackets are found in the text, at least this number
  # (plus the 1) will be required to mean the Start-code is terminated.  When
  # those are found, @stack is popped.
  my @stack;

  my @lineage = ($treelet);
  my $raw = ''; # raw content of L<> fcode before splitting/processing
    # XXX 'raw' is not 100% accurate: all surrounding whitespace is condensed
    # into just 1 ' '. Is this the regex's doing or 'raw's?  Answer is it's
    # the 'collapse and trim all whitespace first' lines just above.
  my $inL = 0;

  DEBUG > 4 and print STDERR "Paragraph:\n$para\n\n";

  # Here begins our frightening tokenizer RE.  The following regex matches
  # text in four main parts:
  #
  #  * Start-codes.  The first alternative matches C< or C<<, the latter
  #    followed by some whitespace.  $1 will hold the entire start code
  #    (including any space following a multiple-angle-bracket delimiter),
  #    and $2 will hold only the additional brackets past the first in a
  #    multiple-bracket delimiter.  length($2) + 1 will be the number of
  #    closing brackets we have to find.
  #
  #  * Closing brackets.  Match some amount of whitespace followed by
  #    multiple close brackets.  The logic to see if this closes anything
  #    is down below.  Note that in order to parse C<<  >> correctly, we
  #    have to use look-behind (?<=\s\s), since the match of the starting
  #    code will have consumed the whitespace.
  #
  #  * A single closing bracket, to close a simple code like C<>.
  #
  #  * Something that isn't a start or end code.  We have to be careful
  #    about accepting whitespace, since perlpodspec says that any whitespace
  #    before a multiple-bracket closing delimiter should be ignored.
  #
  while($para =~
    m/\G
      (?:
        # Match starting codes, including the whitespace following a
        # multiple-delimiter start code.  $1 gets the whole start code and
        # $2 gets all but one of the >, and all the white-space has been
        # gobbled up already, considered to be space after the opening
        # bracket.  In this case we use look-behind to verify that there are
        # at least 2 spaces in a row before the ">".)
        (\s+|(?<=\s\s))(>{2,})
        |
        (\s?>)          # $5: simple end-codes
        |
        (               # $6: stuff containing no start-codes or end-codes
          (?:
            [^A-Z\s>]
            |
            (?:
              [A-Z](?!<)
            )
            |
            # whitespace is ok, but we don't want to eat the whitespace before
            # a multiple-bracket end code.
            # NOTE: we may still have problems with e.g. S<<    >>
            (?:
              \s(?!\s*>{2,})
            )
          )+
        )
      )
    /xgo
  ) {
    DEBUG > 4 and print STDERR "\nParagraphic tokenstack = (@stack)\n";
    if(defined $1) {
      my $bracket_count;    # How many '<<<' in a row this has.  Needed for
                            # Pod::Simple::JustPod
      if(defined $2) {
        DEBUG > 3 and print STDERR "Found complex start-text code \"$1\"\n";
        $bracket_count = length($2) + 1;
        push @stack, $bracket_count; # length of the necessary complex
                                     # end-code string
      } else {
        DEBUG > 3 and print STDERR "Found simple start-text code \"$1\"\n";
        push @stack, 0;  # signal that we're looking for simple
        $bracket_count = 1;
      }
      my $code = substr($1,0,1);
      if ('L' eq $code) {
        if ($inL) {
            $raw .= $1;
            $self->scream( $start_line,
                           'Nested L<> are illegal.  Pretending inner one is '
                         . 'X<...> so can continue looking for other errors.');
            $code = "X";
        }
        else {
            $raw = ""; # reset raw content accumulator
            $inL = @stack;
        }
      } else {
        $raw .= $1 if $inL;
      }
      push @lineage, [ $code, {}, ];  # new node object

      # Tell Pod::Simple::JustPod how many brackets there were, but to save
      # space, not in the most usual case of there was just 1.  It can be
      # inferred by the absence of this element.  Similarly, if there is more
      # than one bracket, extract the white space between the final bracket
      # and the real beginning of the interior.  Save that if it isn't just a
      # single space
      if ($self->{'_output_is_for_JustPod'} && $bracket_count > 1) {
        $lineage[-1][1]{'~bracket_count'} = $bracket_count;
        my $lspacer = substr($1, 1 + $bracket_count);
        $lineage[-1][1]{'~lspacer'} = $lspacer if $lspacer ne " ";
      }
      push @{ $lineage[-2] }, $lineage[-1];
    } elsif(defined $4) {
      DEBUG > 3 and print STDERR "Found apparent complex end-text code \"$3$4\"\n";
      # This is where it gets messy...
      if(! @stack) {
        # We saw " >>>>" but needed nothing.  This is ALL just stuff then.
        DEBUG > 4 and print STDERR " But it's really just stuff.\n";
        push @{ $lineage[-1] }, $3, $4;
        next;
      } elsif(!$stack[-1]) {
        # We saw " >>>>" but needed only ">".  Back pos up.
        DEBUG > 4 and print STDERR " And that's more than we needed to close simple.\n";
        push @{ $lineage[-1] }, $3; # That was a for-real space, too.
        pos($para) = pos($para) - length($4) + 1;
      } elsif($stack[-1] == length($4)) {
        # We found " >>>>", and it was exactly what we needed.  Commonest case.
        DEBUG > 4 and print STDERR " And that's exactly what we needed to close complex.\n";
      } elsif($stack[-1] < length($4)) {
        # We saw " >>>>" but needed only " >>".  Back pos up.
        DEBUG > 4 and print STDERR " And that's more than we needed to close complex.\n";
        pos($para) = pos($para) - length($4) + $stack[-1];
      } else {
        # We saw " >>>>" but needed " >>>>>>".  So this is all just stuff!
        DEBUG > 4 and print STDERR " But it's really just stuff, because we needed more.\n";
        push @{ $lineage[-1] }, $3, $4;
        next;
      }
      #print STDERR "\nHOOBOY ", scalar(@{$lineage[-1]}), "!!!\n";

      if ($3 ne " " && $self->{'_output_is_for_JustPod'}) {
        if ($3 ne "") {
          $lineage[-1][1]{'~rspacer'} = $3;
        }
        elsif ($lineage[-1][1]{'~lspacer'} eq "  ") {

          # Here we had something like C<<  >> which was a false positive
          delete $lineage[-1][1]{'~lspacer'};
        }
        else {
          $lineage[-1][1]{'~rspacer'}
                                = substr($lineage[-1][1]{'~lspacer'}, -1, 1);
          chop $lineage[-1][1]{'~lspacer'};
        }
      }

      push @{ $lineage[-1] }, '' if 2 == @{ $lineage[-1] };
      # Keep the element from being childless

      if ($inL == @stack) {
        $lineage[-1][1]{'raw'} = $raw;
        $inL = 0;
      }

      pop @stack;
      pop @lineage;

      $raw .= $3.$4 if $inL;

    } elsif(defined $5) {
      DEBUG > 3 and print STDERR "Found apparent simple end-text code \"$5\"\n";

      if(@stack and ! $stack[-1]) {
        # We're indeed expecting a simple end-code
        DEBUG > 4 and print STDERR " It's indeed an end-code.\n";

        if(length($5) == 2) { # There was a space there: " >"
          push @{ $lineage[-1] }, ' ';
        } elsif( 2 == @{ $lineage[-1] } ) { # Closing a childless element
          push @{ $lineage[-1] }, ''; # keep it from being really childless
        }

        if ($inL == @stack) {
          $lineage[-1][1]{'raw'} = $raw;
          $inL = 0;
        }

        pop @stack;
        pop @lineage;
      } else {
        DEBUG > 4 and print STDERR " It's just stuff.\n";
        push @{ $lineage[-1] }, $5;
      }

      $raw .= $5 if $inL;

    } elsif(defined $6) {
      DEBUG > 3 and print STDERR "Found stuff \"$6\"\n";
      push @{ $lineage[-1] }, $6;
      $raw .= $6 if $inL;
        # XXX does not capture multiplace whitespaces -- 'raw' ends up with
        #     at most 1 leading/trailing whitespace, why not all of it?
        #     Answer, because we deliberately trimmed it above

    } else {
      # should never ever ever ever happen
      DEBUG and print STDERR "AYYAYAAAAA at line ", __LINE__, "\n";
      die "SPORK 512512!";
    }
  }

  if(@stack) { # Uhoh, some sequences weren't closed.
    my $x= "...";
    while(@stack) {
      push @{ $lineage[-1] }, '' if 2 == @{ $lineage[-1] };
      # Hmmmmm!

      my $code         = (pop @lineage)->[0];
      my $ender_length =  pop @stack;
      if($ender_length) {
        --$ender_length;
        $x = $code . ("<" x $ender_length) . " $x " . (">" x $ender_length);
      } else {
        $x = $code . "<$x>";
      }
    }
    DEBUG > 1 and print STDERR "Unterminated $x sequence\n";
    $self->whine($start_line,
      "Unterminated $x sequence",
    );
  }

  return $treelet;
}

#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

sub text_content_of_treelet {  # method: $parser->text_content_of_treelet($lol)
  return stringify_lol($_[1]);
}

sub stringify_lol {  # function: stringify_lol($lol)
  my $string_form = '';
  _stringify_lol( $_[0] => \$string_form );
  return $string_form;
}

sub _stringify_lol {  # the real recursor
  my($lol, $to) = @_;
  for(my $i = 2; $i < @$lol; ++$i) {
    if( ref($lol->[$i] || '') and UNIVERSAL::isa($lol->[$i], 'ARRAY') ) {
      _stringify_lol( $lol->[$i], $to);  # recurse!
    } else {
      $$to .= $lol->[$i];
    }
  }
  return;
}

#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

sub _dump_curr_open { # return a string representation of the stack
  my $curr_open = $_[0]{'curr_open'};

  return '[empty]' unless @$curr_open;
  return join '; ',
    map {;
           ($_->[0] eq '=for')
             ? ( ($_->[1]{'~really'} || '=over')
               . ' ' . $_->[1]{'target'})
             : $_->[0]
        }
    @$curr_open
  ;
}

###########################################################################
my %pretty_form = (
  "\a" => '\a', # ding!
  "\b" => '\b', # BS
  "\e" => '\e', # ESC
  "\f" => '\f', # FF
  "\t" => '\t', # tab
  "\cm" => '\cm',
  "\cj" => '\cj',
  "\n" => '\n', # probably overrides one of either \cm or \cj
  '"' => '\"',
  '\\' => '\\\\',
  '$' => '\\$',
  '@' => '\\@',
  '%' => '\\%',
  '#' => '\\#',
);

sub pretty { # adopted from Class::Classless
  # Not the most brilliant routine, but passable.
  # Don't give it a cyclic data structure!
  my @stuff = @_; # copy
  my $x;
  my $out =
    # join ",\n" .
    join ", ",
    map {;
    if(!defined($_)) {
      "undef";
    } elsif(ref($_) eq 'ARRAY' or ref($_) eq 'Pod::Simple::LinkSection') {
      $x = "[ " . pretty(@$_) . " ]" ;
      $x;
    } elsif(ref($_) eq 'SCALAR') {
      $x = "\\" . pretty($$_) ;
      $x;
    } elsif(ref($_) eq 'HASH') {
      my $hr = $_;
      $x = "{" . join(", ",
        map(pretty($_) . '=>' . pretty($hr->{$_}),
            sort keys %$hr ) ) . "}" ;
      $x;
    } elsif(!length($_)) { q{''} # empty string
    } elsif(
      $_ eq '0' # very common case
      or(
         m/^-?(?:[123456789]\d*|0)(?:\.\d+)?$/s
         and $_ ne '-0' # the strange case that RE lets thru
      )
    ) { $_;
    } else {
        # Yes, explicitly name every character desired. There are shorcuts one
        # could make, but I (Karl Williamson) was afraid that some Perl
        # releases would have bugs in some of them. For example [A-Z] works
        # even on EBCDIC platforms to match exactly the 26 uppercase English
        # letters, but I don't know if it has always worked without bugs. It
        # seemed safest just to list the characters.
        # s<([^\x20\x21\x23\x27-\x3F\x41-\x5B\x5D-\x7E])>
        s<([^ !"#'()*+,\-./0123456789:;\<=\>?ABCDEFGHIJKLMNOPQRSTUVWXYZ\[\]^_`abcdefghijklmnopqrstuvwxyz{|}~])>
         <$pretty_form{$1} || '\\x{'.sprintf("%x", ord($1)).'}'>eg;
         #<$pretty_form{$1} || '\\x'.(unpack("H2",$1))>eg;
      qq{"$_"};
    }
  } @stuff;
  # $out =~ s/\n */ /g if length($out) < 75;
  return $out;
}

#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

# A rather unsubtle method of blowing away all the state information
# from a parser object so it can be reused. Provided as a utility for
# backward compatibility in Pod::Man, etc. but not recommended for
# general use.

sub reinit {
  my $self = shift;
  foreach (qw(source_dead source_filename doc_has_started
start_of_pod_block content_seen last_was_blank paras curr_open
line_count pod_para_count in_pod ~tried_gen_errata all_errata errata errors_seen
Title)) {

    delete $self->{$_};
  }
}

#@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
1;

Pod-Simple-3.45/lib/Pod/Simple/RTF.pm0000644000175000017500000005564414427237107015321 0ustar  khwkhwpackage Pod::Simple::RTF;
use strict;
use warnings;

#sub DEBUG () {4};
#sub Pod::Simple::DEBUG () {4};
#sub Pod::Simple::PullParser::DEBUG () {4};

our $VERSION = '3.45';
use Pod::Simple::PullParser ();
our @ISA;
BEGIN {@ISA = ('Pod::Simple::PullParser')}

use Carp ();
BEGIN { *DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG }

sub to_uni ($) {    # Convert native code point to Unicode
    my $x = shift;

    # Broken for early EBCDICs
    $x = chr utf8::native_to_unicode(ord $x) if $] ge 5.007_003
                                             && ord("A") != 65;
    return $x;
}

# We escape out 'F' so that we can send RTF files thru the mail without the
# slightest worry that paragraphs beginning with "From" will get munged.
# We also escape '\', '{', '}', and '_'
my $map_to_self = ' !"#$%&\'()*+,-./0123456789:;<=>?@ABCDEGHIJKLMNOPQRSTUVWXYZ[]^`abcdefghijklmnopqrstuvwxyz|~';

our $WRAP;
$WRAP = 1 unless defined $WRAP;
our %Escape = (

  # Start with every character mapping to its hex equivalent
  map( (chr($_) => sprintf("\\'%02x", $_)), 0 .. 0xFF),

  # Override most ASCII printables with themselves (or on non-ASCII platforms,
  # their ASCII values.  This is because the output is UTF-16, which is always
  # based on Unicode code points)
  map( (   substr($map_to_self, $_, 1)
        => to_uni(substr($map_to_self, $_, 1))), 0 .. length($map_to_self) - 1),

  # And some refinements:
  "\r"  => "\n",
  "\cj"  => "\n",
  "\n"   => "\n\\line ",

  "\t"   => "\\tab ",     # Tabs (altho theoretically raw \t's are okay)
  "\f"   => "\n\\page\n", # Formfeed
  "-"    => "\\_",        # Turn plaintext '-' into a non-breaking hyphen
  $Pod::Simple::nbsp => "\\~",        # Latin-1 non-breaking space
  $Pod::Simple::shy => "\\-",        # Latin-1 soft (optional) hyphen

  # CRAZY HACKS:
  "\n" => "\\line\n",
  "\r" => "\n",
  "\cb" => "{\n\\cs21\\lang1024\\noproof ",  # \\cf1
  "\cc" => "}",
);

# Generate a string of all the characters in %Escape that don't map to
# themselves.  First, one without the hyphen, then one with.
my $escaped_sans_hyphen = "";
$escaped_sans_hyphen .= $_ for grep { $_ ne $Escape{$_} && $_ ne '-' }
                                                            sort keys %Escape;
my $escaped = "-$escaped_sans_hyphen";

# Then convert to patterns
$escaped_sans_hyphen = qr/[\Q$escaped_sans_hyphen \E]/;
$escaped= qr/[\Q$escaped\E]/;

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

sub _openclose {
 return map {;
   m/^([-A-Za-z]+)=(\w[^\=]*)$/s or die "what's <$_>?";
   ( $1,  "{\\$2\n",   "/$1",  "}" );
 } @_;
}

my @_to_accept;

our %Tagmap = (
 # 'foo=bar' means ('foo' => '{\bar'."\n", '/foo' => '}')
 _openclose(
  'B=cs18\b',
  'I=cs16\i',
  'C=cs19\f1\lang1024\noproof',
  'F=cs17\i\lang1024\noproof',

  'VerbatimI=cs26\i',
  'VerbatimB=cs27\b',
  'VerbatimBI=cs28\b\i',

  map {; m/^([-a-z]+)/s && push @_to_accept, $1; $_ }
   qw[
       underline=ul         smallcaps=scaps  shadow=shad
       superscript=super    subscript=sub    strikethrough=strike
       outline=outl         emboss=embo      engrave=impr
       dotted-underline=uld          dash-underline=uldash
       dot-dash-underline=uldashd    dot-dot-dash-underline=uldashdd
       double-underline=uldb         thick-underline=ulth
       word-underline=ulw            wave-underline=ulwave
   ]
   # But no double-strikethrough, because MSWord can't agree with the
   #  RTF spec on whether it's supposed to be \strikedl or \striked1 (!!!)
 ),

 # Bit of a hack here:
 'L=pod' => '{\cs22\i'."\n",
 'L=url' => '{\cs23\i'."\n",
 'L=man' => '{\cs24\i'."\n",
 '/L' => '}',

 'Data'  => "\n",
 '/Data' => "\n",

 'Verbatim'  => "\n{\\pard\\li#rtfindent##rtfkeep#\\plain\\s20\\sa180\\f1\\fs18\\lang1024\\noproof\n",
 '/Verbatim' => "\n\\par}\n",
 'VerbatimFormatted'  => "\n{\\pard\\li#rtfindent##rtfkeep#\\plain\\s20\\sa180\\f1\\fs18\\lang1024\\noproof\n",
 '/VerbatimFormatted' => "\n\\par}\n",
 'Para'    => "\n{\\pard\\li#rtfindent#\\sa180\n",
 '/Para'   => "\n\\par}\n",
 'head1'   => "\n{\\pard\\li#rtfindent#\\s31\\keepn\\sb90\\sa180\\f2\\fs#head1_halfpoint_size#\\ul{\n",
 '/head1'  => "\n}\\par}\n",
 'head2'   => "\n{\\pard\\li#rtfindent#\\s32\\keepn\\sb90\\sa180\\f2\\fs#head2_halfpoint_size#\\ul{\n",
 '/head2'  => "\n}\\par}\n",
 'head3'   => "\n{\\pard\\li#rtfindent#\\s33\\keepn\\sb90\\sa180\\f2\\fs#head3_halfpoint_size#\\ul{\n",
 '/head3'  => "\n}\\par}\n",
 'head4'   => "\n{\\pard\\li#rtfindent#\\s34\\keepn\\sb90\\sa180\\f2\\fs#head4_halfpoint_size#\\ul{\n",
 '/head4'  => "\n}\\par}\n",
   # wordpad borks on \tc\tcl1, or I'd put that in =head1 and =head2

 'item-bullet'  => "\n{\\pard\\li#rtfindent##rtfitemkeepn#\\sb60\\sa150\\fi-120\n",
 '/item-bullet' => "\n\\par}\n",
 'item-number'  => "\n{\\pard\\li#rtfindent##rtfitemkeepn#\\sb60\\sa150\\fi-120\n",
 '/item-number' => "\n\\par}\n",
 'item-text'    => "\n{\\pard\\li#rtfindent##rtfitemkeepn#\\sb60\\sa150\\fi-120\n",
 '/item-text'   => "\n\\par}\n",

 # we don't need any styles for over-* and /over-*
);


#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub new {
  my $new = shift->SUPER::new(@_);
  $new->nix_X_codes(1);
  $new->nbsp_for_S(1);
  $new->accept_targets( 'rtf', 'RTF' );

  $new->{'Tagmap'} = {%Tagmap};

  $new->accept_codes(@_to_accept);
  $new->accept_codes('VerbatimFormatted');
  DEBUG > 2 and print STDERR "To accept: ", join(' ',@_to_accept), "\n";
  $new->doc_lang(
    (  $ENV{'RTFDEFLANG'} || '') =~ m/^(\d{1,10})$/s ? $1
    : ($ENV{'RTFDEFLANG'} || '') =~ m/^0?x([a-fA-F0-9]{1,10})$/s ? hex($1)
                                      # yes, tolerate hex!
    : ($ENV{'RTFDEFLANG'} || '') =~ m/^([a-fA-F0-9]{4})$/s ? hex($1)
                                      # yes, tolerate even more hex!
    : '1033'
  );

  $new->head1_halfpoint_size(32);
  $new->head2_halfpoint_size(28);
  $new->head3_halfpoint_size(25);
  $new->head4_halfpoint_size(22);
  $new->codeblock_halfpoint_size(18);
  $new->header_halfpoint_size(17);
  $new->normal_halfpoint_size(25);

  return $new;
}

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

__PACKAGE__->_accessorize(
 'doc_lang',
 'head1_halfpoint_size',
 'head2_halfpoint_size',
 'head3_halfpoint_size',
 'head4_halfpoint_size',
 'codeblock_halfpoint_size',
 'header_halfpoint_size',
 'normal_halfpoint_size',
 'no_proofing_exemptions',
);


#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub run {
  my $self = $_[0];
  return $self->do_middle if $self->bare_output;
  return
   $self->do_beginning && $self->do_middle && $self->do_end;
}


#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

# Match something like an identifier.  Prefer XID if available, then plain ID,
# then just ASCII
my $id_re = Pod::Simple::BlackBox::my_qr('[\'_\p{XIDS}][\'\p{XIDC}]+', "ab");
$id_re    = Pod::Simple::BlackBox::my_qr('[\'_\p{IDS}][\'\p{IDC}]+', "ab")
                                                                  unless $id_re;
$id_re = qr/['_a-zA-Z]['a-zA-Z0-9_]+/ unless $id_re;

sub do_middle {      # the main work
  my $self = $_[0];
  my $fh = $self->{'output_fh'};

  my($token, $type, $tagname, $scratch);
  my @stack;
  my @indent_stack;
  $self->{'rtfindent'} = 0 unless defined $self->{'rtfindent'};

  while($token = $self->get_token) {

    if( ($type = $token->type) eq 'text' ) {
      if( $self->{'rtfverbatim'} ) {
        DEBUG > 1 and print STDERR "  $type " , $token->text, " in verbatim!\n";
        rtf_esc(0, $scratch = $token->text); # 0 => Don't escape hyphen
        print $fh $scratch;
        next;
      }

      DEBUG > 1 and print STDERR "  $type " , $token->text, "\n";

      $scratch = $token->text;
      $scratch =~ tr/\t\cb\cc/ /d;

      $self->{'no_proofing_exemptions'} or $scratch =~
       s/(?:
           ^
           |
           (?<=[\r\n\t "\[\<\(])
         )   # start on whitespace, sequence-start, or quote
         ( # something looking like a Perl token:
          (?:
           [\$\@\:\<\*\\_]\S+  # either starting with a sigil, etc.
          )
          |
          # or starting alpha, but containing anything strange:
          (?:
           ${id_re}[\$\@\:_<>\(\\\*]\S+
          )
         )
        /\cb$1\cc/xsg
      ;

      rtf_esc(1, $scratch);     # 1 => escape hyphen
      $scratch =~
         s/(
            [^\r\n]{65}        # Snare 65 characters from a line
            [^\r\n ]{0,50}     #  and finish any current word
           )
           (\ {1,10})(?![\r\n]) # capture some spaces not at line-end
          /$1$2\n/gx     # and put a NL before those spaces
        if $WRAP;
        # This may wrap at well past the 65th column, but not past the 120th.

      print $fh $scratch;

    } elsif( $type eq 'start' ) {
      DEBUG > 1 and print STDERR "  +$type ",$token->tagname,
        " (", map("<$_> ", %{$token->attr_hash}), ")\n";

      if( ($tagname = $token->tagname) eq 'Verbatim'
          or $tagname eq 'VerbatimFormatted'
      ) {
        ++$self->{'rtfverbatim'};
        my $next = $self->get_token;
        next unless defined $next;
        my $line_count = 1;
        if($next->type eq 'text') {
          my $t = $next->text_r;
          while( $$t =~ m/$/mg ) {
            last if  ++$line_count  > 15; # no point in counting further
          }
          DEBUG > 3 and print STDERR "    verbatim line count: $line_count\n";
        }
        $self->unget_token($next);
        $self->{'rtfkeep'} = ($line_count > 15) ? '' : '\keepn' ;

      } elsif( $tagname =~ m/^item-/s ) {
        my @to_unget;
        my $text_count_here = 0;
        $self->{'rtfitemkeepn'} = '';
        # Some heuristics to stop item-*'s functioning as subheadings
        #  from getting split from the things they're subheadings for.
        #
        # It's not terribly pretty, but it really does make things pretty.
        #
        while(1) {
          push @to_unget, $self->get_token;
          pop(@to_unget), last unless defined $to_unget[-1];
           # Erroneously used to be "unshift" instead of pop!  Adds instead
           # of removes, and operates on the beginning instead of the end!

          if($to_unget[-1]->type eq 'text') {
            if( ($text_count_here += length ${$to_unget[-1]->text_r}) > 150 ){
              DEBUG > 1 and print STDERR "    item-* is too long to be keepn'd.\n";
              last;
            }
          } elsif (@to_unget > 1 and
            $to_unget[-2]->type eq 'end' and
            $to_unget[-2]->tagname =~ m/^item-/s
          ) {
            # Bail out here, after setting rtfitemkeepn yea or nay.
            $self->{'rtfitemkeepn'} = '\keepn' if
              $to_unget[-1]->type eq 'start' and
              $to_unget[-1]->tagname eq 'Para';

            DEBUG > 1 and printf STDERR "    item-* before %s(%s) %s keepn'd.\n",
              $to_unget[-1]->type,
              $to_unget[-1]->can('tagname') ? $to_unget[-1]->tagname : '',
              $self->{'rtfitemkeepn'} ? "gets" : "doesn't get";
            last;
          } elsif (@to_unget > 40) {
            DEBUG > 1 and print STDERR "    item-* now has too many tokens (",
              scalar(@to_unget),
              (DEBUG > 4) ? (q<: >, map($_->dump, @to_unget)) : (),
              ") to be keepn'd.\n";
            last; # give up
          }
          # else keep while'ing along
        }
        # Now put it aaaaall back...
        $self->unget_token(@to_unget);

      } elsif( $tagname =~ m/^over-/s ) {
        push @stack, $1;
        push @indent_stack,
         int($token->attr('indent') * 4 * $self->normal_halfpoint_size);
        DEBUG and print STDERR "Indenting over $indent_stack[-1] twips.\n";
        $self->{'rtfindent'} += $indent_stack[-1];

      } elsif ($tagname eq 'L') {
        $tagname .= '=' . ($token->attr('type') || 'pod');

      } elsif ($tagname eq 'Data') {
        my $next = $self->get_token;
        next unless defined $next;
        unless( $next->type eq 'text' ) {
          $self->unget_token($next);
          next;
        }
        DEBUG and print STDERR "    raw text ", $next->text, "\n";
        printf $fh "\n" . $next->text . "\n";
        next;
      }

      defined($scratch = $self->{'Tagmap'}{$tagname}) or next;
      $scratch =~ s/\#([^\#]+)\#/${$self}{$1}/g; # interpolate
      print $fh $scratch;

      if ($tagname eq 'item-number') {
        print $fh $token->attr('number'), ". \n";
      } elsif ($tagname eq 'item-bullet') {
        print $fh "\\'", ord("_"), "\n";
        #for funky testing: print $fh '', rtf_esc(1, "\x{4E4B}\x{9053}");
      }

    } elsif( $type eq 'end' ) {
      DEBUG > 1 and print STDERR "  -$type ",$token->tagname,"\n";
      if( ($tagname = $token->tagname) =~ m/^over-/s ) {
        DEBUG and print STDERR "Indenting back $indent_stack[-1] twips.\n";
        $self->{'rtfindent'} -= pop @indent_stack;
        pop @stack;
      } elsif( $tagname eq 'Verbatim' or $tagname eq 'VerbatimFormatted') {
        --$self->{'rtfverbatim'};
      }
      defined($scratch = $self->{'Tagmap'}{"/$tagname"}) or next;
      $scratch =~ s/\#([^\#]+)\#/${$self}{$1}/g; # interpolate
      print $fh $scratch;
    }
  }
  return 1;
}

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub do_beginning {
  my $self = $_[0];
  my $fh = $self->{'output_fh'};
  return print $fh join '',
    $self->doc_init,
    $self->font_table,
    $self->stylesheet,
    $self->color_table,
    $self->doc_info,
    $self->doc_start,
    "\n"
  ;
}

sub do_end {
  my $self = $_[0];
  my $fh = $self->{'output_fh'};
  return print $fh '}'; # that should do it
}

###########################################################################

sub stylesheet {
  return sprintf <<'END',
{\stylesheet
{\snext0 Normal;}
{\*\cs10 \additive Default Paragraph Font;}
{\*\cs16 \additive \i \sbasedon10 pod-I;}
{\*\cs17 \additive \i\lang1024\noproof \sbasedon10 pod-F;}
{\*\cs18 \additive \b \sbasedon10 pod-B;}
{\*\cs19 \additive \f1\lang1024\noproof\sbasedon10 pod-C;}
{\s20\ql \li0\ri0\sa180\widctlpar\f1\fs%s\lang1024\noproof\sbasedon0 \snext0 pod-codeblock;}
{\*\cs21 \additive \lang1024\noproof \sbasedon10 pod-computerese;}
{\*\cs22 \additive \i\lang1024\noproof\sbasedon10 pod-L-pod;}
{\*\cs23 \additive \i\lang1024\noproof\sbasedon10 pod-L-url;}
{\*\cs24 \additive \i\lang1024\noproof\sbasedon10 pod-L-man;}

{\*\cs25 \additive \f1\lang1024\noproof\sbasedon0 pod-codelbock-plain;}
{\*\cs26 \additive \f1\lang1024\noproof\sbasedon25 pod-codelbock-ital;}
{\*\cs27 \additive \f1\lang1024\noproof\sbasedon25 pod-codelbock-bold;}
{\*\cs28 \additive \f1\lang1024\noproof\sbasedon25 pod-codelbock-bold-ital;}

{\s31\ql \keepn\sb90\sa180\f2\fs%s\ul\sbasedon0 \snext0 pod-head1;}
{\s32\ql \keepn\sb90\sa180\f2\fs%s\ul\sbasedon0 \snext0 pod-head2;}
{\s33\ql \keepn\sb90\sa180\f2\fs%s\ul\sbasedon0 \snext0 pod-head3;}
{\s34\ql \keepn\sb90\sa180\f2\fs%s\ul\sbasedon0 \snext0 pod-head4;}
}

END

   $_[0]->codeblock_halfpoint_size(),
   $_[0]->head1_halfpoint_size(),
   $_[0]->head2_halfpoint_size(),
   $_[0]->head3_halfpoint_size(),
   $_[0]->head4_halfpoint_size(),
  ;
}

###########################################################################
# Override these as necessary for further customization

sub font_table {
  return <<'END';  # text font, code font, heading font
{\fonttbl
{\f0\froman Times New Roman;}
{\f1\fmodern Courier New;}
{\f2\fswiss Arial;}
}

END
}

sub doc_init {
   return <<'END';
{\rtf1\ansi\deff0

END
}

sub color_table {
   return <<'END';
{\colortbl;\red255\green0\blue0;\red0\green0\blue255;}
END
}


sub doc_info {
   my $self = $_[0];

   my $class = ref($self) || $self;

   my $tag = __PACKAGE__ . ' ' . $VERSION;

   unless($class eq __PACKAGE__) {
     $tag = " ($tag)";
     $tag = " v" . $self->VERSION . $tag   if   defined $self->VERSION;
     $tag = $class . $tag;
   }

   return sprintf <<'END',
{\info{\doccomm
%s
 using %s v%s
 under Perl v%s at %s GMT}
{\author [see doc]}{\company [see doc]}{\operator [see doc]}
}

END

  # None of the following things should need escaping, I dare say!
    $tag,
    $ISA[0], $ISA[0]->VERSION(),
    $], scalar(gmtime($ENV{SOURCE_DATE_EPOCH} || time)),
  ;
}

sub doc_start {
  my $self = $_[0];
  my $title = $self->get_short_title();
  DEBUG and print STDERR "Short Title: <$title>\n";
  $title .= ' ' if length $title;

  $title =~ s/ *$/ /s;
  $title =~ s/^ //s;
  $title =~ s/ $/, /s;
   # make sure it ends in a comma and a space, unless it's 0-length

  my $is_obviously_module_name;
  $is_obviously_module_name = 1
   if $title =~ m/^\S+$/s and $title =~ m/::/s;
    # catches the most common case, at least

  DEBUG and print STDERR "Title0: <$title>\n";
  $title = rtf_esc(1, $title);  # 1 => escape hyphen
  DEBUG and print STDERR "Title1: <$title>\n";
  $title = '\lang1024\noproof ' . $title
   if $is_obviously_module_name;

  return sprintf <<'END',
\deflang%s\plain\lang%s\widowctrl
{\header\pard\qr\plain\f2\fs%s
%s
p.\chpgn\par}
\fs%s

END
    ($self->doc_lang) x 2,
    $self->header_halfpoint_size,
    $title,
    $self->normal_halfpoint_size,
  ;
}

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#-------------------------------------------------------------------------

use integer;

my $question_mark_code_points =
        Pod::Simple::BlackBox::my_qr('([^\x00-\x{D7FF}\x{E000}-\x{10FFFF}])',
                                     "\x{110000}");
my $plane0 =
        Pod::Simple::BlackBox::my_qr('([\x{100}-\x{FFFF}])', "\x{100}");
my $other_unicode =
        Pod::Simple::BlackBox::my_qr('([\x{10000}-\x{10FFFF}])', "\x{10000}");

sub esc_uni($) {
    use if $] le 5.006002, 'utf8';

    my $x = shift;

    # The output is expected to be UTF-16.  Surrogates and above-Unicode get
    # mapped to '?'
    $x =~ s/$question_mark_code_points/?/g if $question_mark_code_points;

    # Non-surrogate Plane 0 characters get mapped to their code points.  But
    # the standard calls for a 16bit SIGNED value.
    $x =~ s/$plane0/'\\uc1\\u'.((ord($1)<32768)?ord($1):(ord($1)-65536)).'?'/eg
                                                                    if $plane0;

    # Use surrogate pairs for the rest
    $x =~ s/$other_unicode/'\\uc1\\u' . ((ord($1) >> 10) + 0xD7C0 - 65536) . '\\u' . (((ord$1) & 0x03FF) + 0xDC00 - 65536) . '?'/eg if $other_unicode;

    return $x;
}

sub rtf_esc ($$) {
  # The parameter is true if we should escape hyphens
  my $escape_re = ((shift) ? $escaped : $escaped_sans_hyphen);

  # When false, it doesn't change "-" to hard-hyphen.
  #  We don't want to change the "-" to hard-hyphen, because we want to
  #  be able to paste this into a file and run it without there being
  #  dire screaming about the mysterious hard-hyphen character (which
  #  looks just like a normal dash character).
  # XXX The comments used to claim that when false it didn't apply computerese
  #     style-smarts, but khw didn't see this actually

  my $x; # scratch
  if(!defined wantarray) { # void context: alter in-place!
    for(@_) {
      s/($escape_re)/$Escape{$1}/g;  # ESCAPER
      $_ = esc_uni($_);
    }
    return;
  } elsif(wantarray) {  # return an array
    return map {; ($x = $_) =~
      s/($escape_re)/$Escape{$1}/g;  # ESCAPER
      $x = esc_uni($x);
      $x;
    } @_;
  } else { # return a single scalar
    ($x = ((@_ == 1) ? $_[0] : join '', @_)
    ) =~ s/($escape_re)/$Escape{$1}/g;  # ESCAPER
             # Escape \, {, }, -, control chars, and 7f-ff.
    $x = esc_uni($x);
    return $x;
  }
}

1;

__END__

=head1 NAME

Pod::Simple::RTF -- format Pod as RTF

=head1 SYNOPSIS

  perl -MPod::Simple::RTF -e \
   "exit Pod::Simple::RTF->filter(shift)->any_errata_seen" \
   thingy.pod > thingy.rtf

=head1 DESCRIPTION

This class is a formatter that takes Pod and renders it as RTF, good for
viewing/printing in MSWord, WordPad/write.exe, TextEdit, etc.

This is a subclass of L and inherits all its methods.

=head1 FORMAT CONTROL ATTRIBUTES

You can set these attributes on the parser object before you
call C (or a similar method) on it:

=over

=item $parser->head1_halfpoint_size( I );

=item $parser->head2_halfpoint_size( I );

=item $parser->head3_halfpoint_size( I );

=item $parser->head4_halfpoint_size( I );

These methods set the size (in half-points, like 52 for 26-point)
that these heading levels will appear as.

=item $parser->codeblock_halfpoint_size( I );

This method sets the size (in half-points, like 21 for 10.5-point)
that codeblocks ("verbatim sections") will appear as.

=item $parser->header_halfpoint_size( I );

This method sets the size (in half-points, like 15 for 7.5-point)
that the header on each page will appear in.  The header
is usually just "I p. I".

=item $parser->normal_halfpoint_size( I );

This method sets the size (in half-points, like 26 for 13-point)
that normal paragraphic text will appear in.

=item $parser->no_proofing_exemptions( I );

Set this value to true if you don't want the formatter to try
putting a hidden code on all Perl symbols (as best as it can
notice them) that labels them as being not in English, and
so not worth spellchecking.

=item $parser->doc_lang( I )

This sets the language code to tag this document as being in. By
default, it is currently the value of the environment variable
C, or if that's not set, then the value
1033 (for US English).

Setting this appropriately is useful if you want to use the RTF
to spellcheck, and/or if you want it to hyphenate right.

Here are some notable values:

  1033  US English
  2057  UK English
  3081  Australia English
  4105  Canada English
  1034  Spain Spanish
  2058  Mexico Spanish
  1031  Germany German
  1036  France French
  3084  Canada French
  1035  Finnish
  1044  Norwegian (Bokmal)
  2068  Norwegian (Nynorsk)

=back

If you are particularly interested in customizing this module's output
even more, see the source and/or write to me.

=head1 SEE ALSO

L, L, L, L,
L

=head1 SUPPORT

Questions or discussion about POD and Pod::Simple should be sent to the
pod-people@perl.org mail list. Send an empty email to
pod-people-subscribe@perl.org to subscribe.

This module is managed in an open GitHub repository,
L. Feel free to fork and contribute, or
to clone L and send patches!

Patches against Pod::Simple are welcome. Please send bug reports to
.

=head1 COPYRIGHT AND DISCLAIMERS

Copyright (c) 2002 Sean M. Burke.

This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

This program is distributed in the hope that it will be useful, but
without any warranty; without even the implied warranty of
merchantability or fitness for a particular purpose.

=head1 AUTHOR

Pod::Simple was created by Sean M. Burke .
But don't bother him, he's retired.

Pod::Simple is maintained by:

=over

=item * Allison Randal C

=item * Hans Dieter Pearcey C

=item * David E. Wheeler C

=back

=cut
Pod-Simple-3.45/lib/Pod/Simple/LinkSection.pm0000644000175000017500000001027214427237107017074 0ustar  khwkhwpackage Pod::Simple::LinkSection;
  # Based somewhat dimly on Array::Autojoin

use strict;
use warnings;
use Pod::Simple::BlackBox;
our $VERSION = '3.45';

use overload( # So it'll stringify nice
  '""'   => \&Pod::Simple::BlackBox::stringify_lol,
  'bool' => \&Pod::Simple::BlackBox::stringify_lol,
  # '.='   => \&tack_on,  # grudgingly support

  'fallback' => 1,         # turn on cleverness
);

sub tack_on {
  $_[0] = ['', {}, "$_[0]" ];
  return $_[0][2] .= $_[1];
}

sub as_string {
  goto &Pod::Simple::BlackBox::stringify_lol;
}
sub stringify {
  goto &Pod::Simple::BlackBox::stringify_lol;
}

sub new {
  my $class = shift;
  $class = ref($class) || $class;
  my $new;
  if(@_ == 1) {
    if (!ref($_[0] || '')) { # most common case: one bare string
      return bless ['', {}, $_[0] ], $class;
    } elsif( ref($_[0] || '') eq 'ARRAY') {
      $new = [ @{ $_[0] } ];
    } else {
      Carp::croak( "$class new() doesn't know to clone $new" );
    }
  } else { # misc stuff
    $new = [ '', {}, @_ ];
  }

  # By now it's a treelet:  [ 'foo', {}, ... ]
  foreach my $x (@$new) {
    if(ref($x || '') eq 'ARRAY') {
      $x = $class->new($x); # recurse
    } elsif(ref($x || '') eq 'HASH') {
      $x = { %$x };
    }
     # otherwise leave it.
  }

  return bless $new, $class;
}

# Not much in this class is likely to be link-section specific --
# but it just so happens that link-sections are about the only treelets
# that are exposed to the user.

1;

__END__

# TODO: let it be an option whether a given subclass even wants little treelets?


__END__

=head1 NAME

Pod::Simple::LinkSection -- represent "section" attributes of L codes

=head1 SYNOPSIS

 # a long story

=head1 DESCRIPTION

This class is not of interest to general users.

Pod::Simple uses this class for representing the value of the
"section" attribute of "L" start-element events.  Most applications
can just use the normal stringification of objects of this class;
they stringify to just the text content of the section,
such as "foo" for
C<< LZ<> >>, and "bar" for
C<< LZ<>> >>.

However, anyone particularly interested in getting the full value of
the treelet, can just traverse the content of the treeleet
@$treelet_object.  To wit:


  % perl -MData::Dumper -e
    "use base qw(Pod::Simple::Methody);
     sub start_L { print Dumper($_[1]{'section'} ) }
     __PACKAGE__->new->parse_string_document('=head1 Lbaz>>')
    "
Output:
  $VAR1 = bless( [
                   '',
                   {},
                   'b',
                   bless( [
                            'I',
                            {},
                            'ar'
                          ], 'Pod::Simple::LinkSection' ),
                   'baz'
                 ], 'Pod::Simple::LinkSection' );

But stringify it and you get just the text content:

  % perl -MData::Dumper -e
    "use base qw(Pod::Simple::Methody);
     sub start_L { print Dumper( '' . $_[1]{'section'} ) }
     __PACKAGE__->new->parse_string_document('=head1 Lbaz>>')
    "
Output:
  $VAR1 = 'barbaz';


=head1 SEE ALSO

L

=head1 SUPPORT

Questions or discussion about POD and Pod::Simple should be sent to the
pod-people@perl.org mail list. Send an empty email to
pod-people-subscribe@perl.org to subscribe.

This module is managed in an open GitHub repository,
L. Feel free to fork and contribute, or
to clone L and send patches!

Patches against Pod::Simple are welcome. Please send bug reports to
.

=head1 COPYRIGHT AND DISCLAIMERS

Copyright (c) 2004 Sean M. Burke.

This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

This program is distributed in the hope that it will be useful, but
without any warranty; without even the implied warranty of
merchantability or fitness for a particular purpose.

=head1 AUTHOR

Pod::Simple was created by Sean M. Burke .
But don't bother him, he's retired.

Pod::Simple is maintained by:

=over

=item * Allison Randal C

=item * Hans Dieter Pearcey C

=item * David E. Wheeler C

=back

=cut
Pod-Simple-3.45/lib/Pod/Simple/HTMLBatch.pm0000644000175000017500000011710214427237107016360 0ustar  khwkhwpackage Pod::Simple::HTMLBatch;
use strict;
our $VERSION = '3.45';
our @ISA = ();  # Yup, we're NOT a subclass of Pod::Simple::HTML!

# TODO: nocontents stylesheets. Strike some of the color variations?

use Pod::Simple::HTML ();
BEGIN {*esc = \&Pod::Simple::HTML::esc }
use File::Spec ();

use Pod::Simple::Search;
our $SEARCH_CLASS ||= 'Pod::Simple::Search';

BEGIN {
  if(defined &DEBUG) { } # no-op
  elsif( defined &Pod::Simple::DEBUG ) { *DEBUG = \&Pod::Simple::DEBUG }
  else { *DEBUG = sub () {0}; }
}

our $SLEEPY;
$SLEEPY = 1 if !defined $SLEEPY and $^O =~ /mswin|mac/i;
# flag to occasionally sleep for $SLEEPY - 1 seconds.

our $HTML_RENDER_CLASS ||= "Pod::Simple::HTML";
our $HTML_EXTENSION;

#
# Methods beginning with "_" are particularly internal and possibly ugly.
#

Pod::Simple::_accessorize( __PACKAGE__,
 'verbose', # how verbose to be during batch conversion
 'html_render_class', # what class to use to render
 'search_class', # what to use to search for POD documents
 'contents_file', # If set, should be the name of a file (in current directory)
                  # to write the list of all modules to
 'index', # will set $htmlpage->index(...) to this (true or false)
 'progress', # progress object
 'contents_page_start',  'contents_page_end',

 'css_flurry', '_css_wad', 'javascript_flurry', '_javascript_wad',
 'no_contents_links', # set to true to suppress automatic adding of << links.
 '_contents',
);

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Just so we can run from the command line more easily
sub go {
  @ARGV == 2 or die sprintf(
    "Usage: perl -M%s -e %s:go indirs outdir\n  (or use \"\@INC\" for indirs)\n",
    __PACKAGE__, __PACKAGE__,
  );

  if(defined($ARGV[1]) and length($ARGV[1])) {
    my $d = $ARGV[1];
    -e $d or die "I see no output directory named \"$d\"\nAborting";
    -d $d or die "But \"$d\" isn't a directory!\nAborting";
    -w $d or die "Directory \"$d\" isn't writeable!\nAborting";
  }

  __PACKAGE__->batch_convert(@ARGV);
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -


sub new {
  my $new = bless {}, ref($_[0]) || $_[0];
  $new->html_render_class($HTML_RENDER_CLASS);
  $new->search_class($SEARCH_CLASS);
  $new->verbose(1 + DEBUG);
  $new->_contents([]);

  $new->index(1);

  $new->       _css_wad([]);         $new->css_flurry(1);
  $new->_javascript_wad([]);  $new->javascript_flurry(1);

  $new->contents_file(
    'index' . ($HTML_EXTENSION || $Pod::Simple::HTML::HTML_EXTENSION)
  );

  $new->contents_page_start( join "\n", grep $_,
    $Pod::Simple::HTML::Doctype_decl,
    "",
    "Perl Documentation",
    $Pod::Simple::HTML::Content_decl,
    "",
    "\n\n
    Perl Documentation
    \n"
  ); # override if you need a different title


  $new->contents_page_end( sprintf(
    "\n\n
    Generated by %s v%s under Perl v%s\n
    At %s GMT.
    \n\n\n",
    esc(
      ref($new),
      eval {$new->VERSION} || $VERSION,
      $], scalar(gmtime($ENV{SOURCE_DATE_EPOCH} || time)),
  )));

  return $new;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

sub muse {
  my $self = shift;
  if($self->verbose) {
    print 'T+', int(time() - $self->{'_batch_start_time'}), "s: ", @_, "\n";
  }
  return 1;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

sub batch_convert {
  my($self, $dirs, $outdir) = @_;
  $self ||= __PACKAGE__; # tolerate being called as an optionless function
  $self = $self->new unless ref $self; # tolerate being used as a class method

  if(!defined($dirs)  or  $dirs eq ''  or  $dirs eq '@INC' ) {
    $dirs = '';
  } elsif(ref $dirs) {
    # OK, it's an explicit set of dirs to scan, specified as an arrayref.
  } else {
    # OK, it's an explicit set of dirs to scan, specified as a
    #  string like "/thing:/also:/whatever/perl" (":"-delim, as usual)
    #  or, under MSWin, like "c:/thing;d:/also;c:/whatever/perl" (";"-delim!)
    require Config;
    my $ps = quotemeta( $Config::Config{'path_sep'} || ":" );
    $dirs = [ grep length($_), split qr/$ps/, $dirs ];
  }

  $outdir = $self->filespecsys->curdir
   unless defined $outdir and length $outdir;

  $self->_batch_convert_main($dirs, $outdir);
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

sub _batch_convert_main {
  my($self, $dirs, $outdir) = @_;
  # $dirs is either false, or an arrayref.
  # $outdir is a pathspec.

  $self->{'_batch_start_time'} ||= time();

  $self->muse( "= ", scalar(localtime) );
  $self->muse( "Starting batch conversion to \"$outdir\"" );

  my $progress = $self->progress;
  if(!$progress and $self->verbose > 0 and $self->verbose() <= 5) {
    require Pod::Simple::Progress;
    $progress = Pod::Simple::Progress->new(
        ($self->verbose  < 2) ? () # Default omission-delay
      : ($self->verbose == 2) ? 1  # Reduce the omission-delay
                              : 0  # Eliminate the omission-delay
    );
    $self->progress($progress);
  }

  if($dirs) {
    $self->muse(scalar(@$dirs), " dirs to scan: @$dirs");
  } else {
    $self->muse("Scanning \@INC.  This could take a minute or two.");
  }
  my $mod2path = $self->find_all_pods($dirs ? $dirs : ());
  $self->muse("Done scanning.");

  my $total = keys %$mod2path;
  unless($total) {
    $self->muse("No pod found.  Aborting batch conversion.\n");
    return $self;
  }

  $progress and $progress->goal($total);
  $self->muse("Now converting pod files to HTML.",
    ($total > 25) ? "  This will take a while more." : ()
  );

  $self->_spray_css(        $outdir );
  $self->_spray_javascript( $outdir );

  $self->_do_all_batch_conversions($mod2path, $outdir);

  $progress and $progress->done(sprintf (
    "Done converting %d files.",  $self->{"__batch_conv_page_count"}
  ));
  return $self->_batch_convert_finish($outdir);
  return $self;
}


sub _do_all_batch_conversions {
  my($self, $mod2path, $outdir) = @_;
  $self->{"__batch_conv_page_count"} = 0;

  foreach my $module (sort {lc($a) cmp lc($b)} keys %$mod2path) {
    $self->_do_one_batch_conversion($module, $mod2path, $outdir);
    sleep($SLEEPY - 1) if $SLEEPY;
  }

  return;
}

sub _batch_convert_finish {
  my($self, $outdir) = @_;
  $self->write_contents_file($outdir);
  $self->muse("Done with batch conversion.  $$self{'__batch_conv_page_count'} files done.");
  $self->muse( "= ", scalar(localtime) );
  $self->progress and $self->progress->done("All done!");
  return;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

sub _do_one_batch_conversion {
  my($self, $module, $mod2path, $outdir, $outfile) = @_;

  my $retval;
  my $total    = scalar keys %$mod2path;
  my $infile   = $mod2path->{$module};
  my @namelets = grep m/\S/, split "::", $module;
        # this can stick around in the contents LoL
  my $depth    = scalar @namelets;
  die "Contentless thingie?! $module $infile" unless @namelets; #sanity

  $outfile  ||= do {
    my @n = @namelets;
    $n[-1] .= $HTML_EXTENSION || $Pod::Simple::HTML::HTML_EXTENSION;
    $self->filespecsys->catfile( $outdir, @n );
  };

  my $progress = $self->progress;

  my $page = $self->html_render_class->new;
  if(DEBUG > 5) {
    $self->muse($self->{"__batch_conv_page_count"} + 1, "/$total: ",
      ref($page), " render ($depth) $module => $outfile");
  } elsif(DEBUG > 2) {
    $self->muse($self->{"__batch_conv_page_count"} + 1, "/$total: $module => $outfile")
  }

  # Give each class a chance to init the converter:
  $page->batch_mode_page_object_init($self, $module, $infile, $outfile, $depth)
   if $page->can('batch_mode_page_object_init');
  # Init for the index (TOC), too.
  $self->batch_mode_page_object_init($page, $module, $infile, $outfile, $depth)
   if $self->can('batch_mode_page_object_init');

  # Now get busy...
  $self->makepath($outdir => \@namelets);

  $progress and $progress->reach($self->{"__batch_conv_page_count"}, "Rendering $module");

  if( $retval = $page->parse_from_file($infile, $outfile) ) {
    ++ $self->{"__batch_conv_page_count"} ;
    $self->note_for_contents_file( \@namelets, $infile, $outfile );
  } else {
    $self->muse("Odd, parse_from_file(\"$infile\", \"$outfile\") returned false.");
  }

  $page->batch_mode_page_object_kill($self, $module, $infile, $outfile, $depth)
   if $page->can('batch_mode_page_object_kill');
  # The following isn't a typo.  Note that it switches $self and $page.
  $self->batch_mode_page_object_kill($page, $module, $infile, $outfile, $depth)
   if $self->can('batch_mode_page_object_kill');

  DEBUG > 4 and printf STDERR "%s %sb < $infile %s %sb\n",
     $outfile, -s $outfile, $infile, -s $infile
  ;

  undef($page);
  return $retval;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub filespecsys { $_[0]{'_filespecsys'} || 'File::Spec' }

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

sub note_for_contents_file {
  my($self, $namelets, $infile, $outfile) = @_;

  # I think the infile and outfile parts are never used. -- SMB
  # But it's handy to have them around for debugging.

  if( $self->contents_file ) {
    my $c = $self->_contents();
    push @$c,
     [ join("::", @$namelets), $infile, $outfile, $namelets ]
     #            0               1         2         3
    ;
    DEBUG > 3 and print STDERR "Noting @$c[-1]\n";
  }
  return;
}

#_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-

sub write_contents_file {
  my($self, $outdir) = @_;
  my $outfile  = $self->_contents_filespec($outdir) || return;

  $self->muse("Preparing list of modules for ToC");

  my($toplevel,           # maps  toplevelbit => [all submodules]
     $toplevel_form_freq, # ends up being  'foo' => 'Foo'
    ) = $self->_prep_contents_breakdown;

  my $Contents = eval { $self->_wopen($outfile) };
  if( $Contents ) {
    $self->muse( "Writing contents file $outfile" );
  } else {
    warn "Couldn't write-open contents file $outfile: $!\nAbort writing to $outfile at all";
    return;
  }

  $self->_write_contents_start(  $Contents, $outfile, );
  $self->_write_contents_middle( $Contents, $outfile, $toplevel, $toplevel_form_freq );
  $self->_write_contents_end(    $Contents, $outfile, );
  return $outfile;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

sub _write_contents_start {
  my($self, $Contents, $outfile) = @_;
  my $starter = $self->contents_page_start || '';

  {
    my $css_wad = $self->_css_wad_to_markup(1);
    if( $css_wad ) {
      $starter =~ s{()}{\n$css_wad\n$1}i;  # otherwise nevermind
    }

    my $javascript_wad = $self->_javascript_wad_to_markup(1);
    if( $javascript_wad ) {
      $starter =~ s{()}{\n$javascript_wad\n$1}i;   # otherwise nevermind
    }
  }

  unless(print $Contents $starter, "    \n",
      $self->contents_page_end || '',
  ) {
    warn "Couldn't write to $outfile: $!";
  }
  close($Contents) or warn "Couldn't close $outfile: $!";
  return 1;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

sub _prep_contents_breakdown {
  my($self) = @_;
  my $contents = $self->_contents;
  my %toplevel; # maps  lctoplevelbit => [all submodules]
  my %toplevel_form_freq; # ends up being  'foo' => 'Foo'
                               # (mapping anycase forms to most freq form)

  foreach my $entry (@$contents) {
    my $toplevel =
      $entry->[0] =~ m/^perl\w*$/ ? 'perl_core_docs'
          # group all the perlwhatever docs together
      : $entry->[3][0] # normal case
    ;
    ++$toplevel_form_freq{ lc $toplevel }{ $toplevel };
    push @{ $toplevel{ lc $toplevel } }, $entry;
    push @$entry, lc($entry->[0]); # add a sort-order key to the end
  }

  foreach my $toplevel (sort keys %toplevel) {
    my $fgroup = $toplevel_form_freq{$toplevel};
    $toplevel_form_freq{$toplevel} =
    (
      sort { $fgroup->{$b} <=> $fgroup->{$a}  or  $a cmp $b }
        keys %$fgroup
      # This hash is extremely unlikely to have more than 4 members, so this
      # sort isn't so very wasteful
    )[0];
  }

  return(\%toplevel, \%toplevel_form_freq) if wantarray;
  return \%toplevel;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

sub _contents_filespec {
  my($self, $outdir) = @_;
  my $outfile = $self->contents_file;
  return unless $outfile;
  return $self->filespecsys->catfile( $outdir, $outfile );
}

#_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-

sub makepath {
  my($self, $outdir, $namelets) = @_;
  return unless @$namelets > 1;
  for my $i (0 .. ($#$namelets - 1)) {
    my $dir = $self->filespecsys->catdir( $outdir, @$namelets[0 .. $i] );
    if(-e $dir) {
      die "$dir exists but not as a directory!?" unless -d $dir;
      next;
    }
    DEBUG > 3 and print STDERR "  Making $dir\n";
    mkdir $dir, 0777
     or die "Can't mkdir $dir: $!\nAborting"
    ;
  }
  return;
}

#_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-

sub batch_mode_page_object_init {
  my $self = shift;
  my($page, $module, $infile, $outfile, $depth) = @_;

  # TODO: any further options to percolate onto this new object here?

  $page->default_title($module);
  $page->index( $self->index );

  $page->html_css(        $self->       _css_wad_to_markup($depth) );
  $page->html_javascript( $self->_javascript_wad_to_markup($depth) );

  $self->add_header_backlink($page, $module, $infile, $outfile, $depth);
  $self->add_footer_backlink($page, $module, $infile, $outfile, $depth);


  return $self;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

sub add_header_backlink {
  my $self = shift;
  return if $self->no_contents_links;
  my($page, $module, $infile, $outfile, $depth) = @_;
  $page->html_header_after_title( join '',
    $page->html_header_after_title || '',

    qq[
    <<
    \n],
  )
   if $self->contents_file
  ;
  return;
}

sub add_footer_backlink {
  my $self = shift;
  return if $self->no_contents_links;
  my($page, $module, $infile, $outfile, $depth) = @_;
  $page->html_footer( join '',
    qq[
    <<
    \n],

    $page->html_footer || '',
  )
   if $self->contents_file
  ;
  return;
}

sub url_up_to_contents {
  my($self, $depth) = @_;
  --$depth;
  return join '/', ('..') x $depth, esc($self->contents_file);
}

#_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-

sub find_all_pods {
  my($self, $dirs) = @_;
  # You can override find_all_pods in a subclass if you want to
  #  do extra filtering or whatnot.  But for the moment, we just
  #  pass to modnames2paths:
  return $self->modnames2paths($dirs);
}

#_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-

sub modnames2paths { # return a hashref mapping modulenames => paths
  my($self, $dirs) = @_;

  my $m2p;
  {
    my $search = $self->search_class->new;
    DEBUG and print STDERR "Searching via $search\n";
    $search->verbose(1) if DEBUG > 10;
    $search->progress( $self->progress->copy->goal(0) ) if $self->progress;
    $search->shadows(0);  # don't bother noting shadowed files
    $search->inc(     $dirs ? 0      :  1 );
    $search->survey(  $dirs ? @$dirs : () );
    $m2p = $search->name2path;
    die "What, no name2path?!" unless $m2p;
  }

  $self->muse("That's odd... no modules found!") unless keys %$m2p;
  if( DEBUG > 4 ) {
    print STDERR "Modules found (name => path):\n";
    foreach my $m (sort {lc($a) cmp lc($b)} keys %$m2p) {
      print STDERR "  $m  $$m2p{$m}\n";
    }
    print STDERR "(total ",     scalar(keys %$m2p), ")\n\n";
  } elsif( DEBUG ) {
    print STDERR      "Found ", scalar(keys %$m2p), " modules.\n";
  }
  $self->muse( "Found ", scalar(keys %$m2p), " modules." );

  # return the Foo::Bar => /whatever/Foo/Bar.pod|pm hashref
  return $m2p;
}

#===========================================================================

sub _wopen {
  # this is abstracted out so that the daemon class can override it
  my($self, $outpath) = @_;
  require Symbol;
  my $out_fh = Symbol::gensym();
  DEBUG > 5 and print STDERR "Write-opening to $outpath\n";
  return $out_fh if open($out_fh, "> $outpath");
  require Carp;
  Carp::croak("Can't write-open $outpath: $!");
}

#==========================================================================

sub add_css {
  my($self, $url, $is_default, $name, $content_type, $media, $_code) = @_;
  return unless $url;
  unless($name) {
    # cook up a reasonable name based on the URL
    $name = $url;
    if( $name !~ m/\?/ and $name =~ m{([^/]+)$}s ) {
      $name = $1;
      $name =~ s/\.css//i;
    }
  }
  $media        ||= 'all';
  $content_type ||= 'text/css';

  my $bunch = [$url, $name, $content_type, $media, $_code];
  if($is_default) { unshift @{ $self->_css_wad }, $bunch }
  else            { push    @{ $self->_css_wad }, $bunch }
  return;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

sub _spray_css {
  my($self, $outdir) = @_;

  return unless $self->css_flurry();
  $self->_gen_css_wad();

  my $lol = $self->_css_wad;
  foreach my $chunk (@$lol) {
    my $url = $chunk->[0];
    my $outfile;
    if( ref($chunk->[-1]) and $url =~ m{^(_[-a-z0-9_]+\.css$)} ) {
      $outfile = $self->filespecsys->catfile( $outdir, "$1" );
      DEBUG > 5 and print STDERR "Noting $$chunk[0] as a file I'll create.\n";
    } else {
      DEBUG > 5 and print STDERR "OK, noting $$chunk[0] as an external CSS.\n";
      # Requires no further attention.
      next;
    }

    #$self->muse( "Writing autogenerated CSS file $outfile" );
    my $Cssout = $self->_wopen($outfile);
    print $Cssout ${$chunk->[-1]}
     or warn "Couldn't print to $outfile: $!\nAbort writing to $outfile at all";
    close($Cssout);
    DEBUG > 5 and print STDERR "Wrote $outfile\n";
  }

  return;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

sub _css_wad_to_markup {
  my($self, $depth) = @_;

  my @css  = @{ $self->_css_wad || return '' };
  return '' unless @css;

  my $rel = 'stylesheet';
  my $out = '';

  --$depth;
  my $uplink = $depth ? ('../' x $depth) : '';

  foreach my $chunk (@css) {
    next unless $chunk and @$chunk;

    my( $url1, $url2, $title, $type, $media) = (
      $self->_maybe_uplink( $chunk->[0], $uplink ),
      esc(grep !ref($_), @$chunk)
    );

    $out .= qq{\n};

    $rel = 'alternate stylesheet'; # alternates = all non-first iterations
  }
  return $out;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub _maybe_uplink {
  # if the given URL looks relative, return the given uplink string --
  # otherwise return emptystring
  my($self, $url, $uplink) = @_;
  ($url =~ m{^\./} or $url !~ m{[/\:]} )
    ? $uplink
    : ''
    # qualify it, if/as needed
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub _gen_css_wad {
  my $self = $_[0];
  my $css_template = $self->_css_template;
  foreach my $variation (

   # Commented out for sake of concision:
   #
   #  011n=black_with_red_on_white
   #  001n=black_with_yellow_on_white
   #  101n=black_with_green_on_white
   #  110=white_with_yellow_on_black
   #  010=white_with_green_on_black
   #  011=white_with_blue_on_black
   #  100=white_with_red_on_black
    '110n=blkbluw',  # black_with_blue_on_white
    '010n=blkmagw',  # black_with_magenta_on_white
    '100n=blkcynw',  # black_with_cyan_on_white
    '101=whtprpk',   # white_with_purple_on_black
    '001=whtnavk',   # white_with_navy_blue_on_black
    '010a=grygrnk',  # grey_with_green_on_black
    '010b=whtgrng',  # white_with_green_on_grey
    '101an=blkgrng', # black_with_green_on_grey
    '101bn=grygrnw', # grey_with_green_on_white
  ) {

    my $outname = $variation;
    my($flipmode, @swap) = ( ($4 || ''), $1,$2,$3)
      if $outname =~ s/^([012])([012])([[012])([a-z]*)=?//s;
    @swap = () if '010' eq join '', @swap; # 010 is a swop-no-op!

    my $this_css =
      "/* This file is autogenerated.  Do not edit.  $variation */\n\n"
      . $css_template;

    # Only look at three-digitty colors, for now at least.
    if( $flipmode =~ m/n/ ) {
      $this_css =~ s/(#[0-9a-fA-F]{3})\b/_color_negate($1)/eg;
      $this_css =~ s/\bthin\b/medium/g;
    }
    $this_css =~ s<#([0-9a-fA-F])([0-9a-fA-F])([0-9a-fA-F])\b>
                  < join '', '#', ($1,$2,$3)[@swap] >eg   if @swap;

    if(   $flipmode =~ m/a/)
       { $this_css =~ s/#fff\b/#999/gi } # black -> dark grey
    elsif($flipmode =~ m/b/)
       { $this_css =~ s/#000\b/#666/gi } # white -> light grey

    my $name = $outname;
    $name =~ tr/-_/  /;
    $self->add_css( "_$outname.css", 0, $name, 0, 0, \$this_css);
  }

  # Now a few indexless variations:
  for (my ($outfile, $variation) = each %{{
      blkbluw => 'black_with_blue_on_white',
      whtpurk => 'white_with_purple_on_black',
      whtgrng => 'white_with_green_on_grey',
      grygrnw => 'grey_with_green_on_white',
  }}) {
    my $this_css = join "\n",
      "/* This file is autogenerated.  Do not edit.  $outfile */\n",
      "\@import url(\"./_$variation.css\");",
      ".indexgroup { display: none; }",
      "\n",
    ;
    my $name = $outfile;
    $name =~ tr/-_/  /;
    $self->add_css( "_$outfile.css", 0, $name, 0, 0, \$this_css);
  }

  return;
}

sub _color_negate {
  my $x = lc $_[0];
  $x =~ tr[0123456789abcdef]
          [fedcba9876543210];
  return $x;
}

#===========================================================================

sub add_javascript {
  my($self, $url, $content_type, $_code) = @_;
  return unless $url;
  push  @{ $self->_javascript_wad }, [
    $url, $content_type || 'text/javascript', $_code
  ];
  return;
}

sub _spray_javascript {
  my($self, $outdir) = @_;
  return unless $self->javascript_flurry();
  $self->_gen_javascript_wad();

  my $lol = $self->_javascript_wad;
  foreach my $script (@$lol) {
    my $url = $script->[0];
    my $outfile;

    if( ref($script->[-1]) and $url =~ m{^(_[-a-z0-9_]+\.js$)} ) {
      $outfile = $self->filespecsys->catfile( $outdir, "$1" );
      DEBUG > 5 and print STDERR "Noting $$script[0] as a file I'll create.\n";
    } else {
      DEBUG > 5 and print STDERR "OK, noting $$script[0] as an external JavaScript.\n";
      next;
    }

    #$self->muse( "Writing JavaScript file $outfile" );
    my $Jsout = $self->_wopen($outfile);

    print $Jsout ${$script->[-1]}
     or warn "Couldn't print to $outfile: $!\nAbort writing to $outfile at all";
    close($Jsout);
    DEBUG > 5 and print STDERR "Wrote $outfile\n";
  }

  return;
}

sub _gen_javascript_wad {
  my $self = $_[0];
  my $js_code = $self->_javascript || return;
  $self->add_javascript( "_podly.js", 0, \$js_code);
  return;
}

sub _javascript_wad_to_markup {
  my($self, $depth) = @_;

  my @scripts  = @{ $self->_javascript_wad || return '' };
  return '' unless @scripts;

  my $out = '';

  --$depth;
  my $uplink = $depth ? ('../' x $depth) : '';

  foreach my $s (@scripts) {
    next unless $s and @$s;

    my( $url1, $url2, $type, $media) = (
      $self->_maybe_uplink( $s->[0], $uplink ),
      esc(grep !ref($_), @$s)
    );

    $out .= qq{\n};
  }
  return $out;
}

#===========================================================================

our $CSS = <<'EOCSS';
/* For accessibility reasons, never specify text sizes in px/pt/pc/in/cm/mm */

@media all { .hide { display: none; } }

@media print {
  .noprint, div.indexgroup, .backlinktop, .backlinkbottom { display: none }

  * {
    border-color: black !important;
    color: black !important;
    background-color: transparent !important;
    background-image: none !important;
  }

  dl.superindex > dd  {
    word-spacing: .6em;
  }
}

@media aural, braille, embossed {
  div.indexgroup  { display: none; }  /* Too noisy, don't you think? */
  dl.superindex > dt:before { content: "Group ";  }
  dl.superindex > dt:after  { content: " contains:"; }
  .backlinktop    a:before  { content: "Back to contents"; }
  .backlinkbottom a:before  { content: "Back to contents"; }
}

@media aural {
  dl.superindex > dt  { pause-before: 600ms; }
}

@media screen, tty, tv, projection {
  .noscreen { display: none; }

  a:link    { color: #7070ff; text-decoration: underline; }
  a:visited { color: #e030ff; text-decoration: underline; }
  a:active  { color: #800000; text-decoration: underline; }
  body.contentspage a            { text-decoration: none; }
  a.u { color: #fff !important; text-decoration: none; }

  body.pod {
    margin: 0 5px;
    color:            #fff;
    background-color: #000;
  }

  body.pod h1, body.pod h2, body.pod h3,
  body.pod h4, body.pod h5, body.pod h6  {
    font-family: Tahoma, Verdana, Helvetica, Arial, sans-serif;
    font-weight: normal;
    margin-top: 1.2em;
    margin-bottom: .1em;
    border-top: thin solid transparent;
    /* margin-left: -5px;  border-left: 2px #7070ff solid;  padding-left: 3px; */
  }

  body.pod h1  { border-top-color: #0a0; }
  body.pod h2  { border-top-color: #080; }
  body.pod h3  { border-top-color: #040; }
  body.pod h4  { border-top-color: #010; }
  body.pod h5  { border-top-color: #010; }
  body.pod h6  { border-top-color: #010; }

  p.backlinktop + h1 { border-top: none; margin-top: 0em;  }
  p.backlinktop + h2 { border-top: none; margin-top: 0em;  }
  p.backlinktop + h3 { border-top: none; margin-top: 0em;  }
  p.backlinktop + h4 { border-top: none; margin-top: 0em;  }
  p.backlinktop + h5 { border-top: none; margin-top: 0em;  }
  p.backlinktop + h6 { border-top: none; margin-top: 0em;  }

  body.pod dt {
    font-size: 105%; /* just a wee bit more than normal */
  }

  .indexgroup { font-size: 80%; }

  .backlinktop,   .backlinkbottom    {
    margin-left:  -5px;
    margin-right: -5px;
    background-color:         #040;
    border-top:    thin solid #050;
    border-bottom: thin solid #050;
  }

  .backlinktop a, .backlinkbottom a  {
    text-decoration: none;
    color: #080;
    background-color:  #000;
    border: thin solid #0d0;
  }
  .backlinkbottom { margin-bottom: 0; padding-bottom: 0; }
  .backlinktop    { margin-top:    0; padding-top:    0; }

  body.contentspage {
    color:            #fff;
    background-color: #000;
  }

  body.contentspage h1  {
    color:            #0d0;
    margin-left: 1em;
    margin-right: 1em;
    text-indent: -.9em;
    font-family: Tahoma, Verdana, Helvetica, Arial, sans-serif;
    font-weight: normal;
    border-top:    thin solid #fff;
    border-bottom: thin solid #fff;
    text-align: center;
  }

  dl.superindex > dt  {
    font-family: Tahoma, Verdana, Helvetica, Arial, sans-serif;
    font-weight: normal;
    font-size: 90%;
    margin-top: .45em;
    /* margin-bottom: -.15em; */
  }
  dl.superindex > dd  {
    word-spacing: .6em;    /* most important rule here! */
  }
  dl.superindex > a:link  {
    text-decoration: none;
    color: #fff;
  }

  .contentsfooty {
    border-top: thin solid #999;
    font-size: 90%;
  }

}

/* The End */

EOCSS

#==========================================================================

our $JAVASCRIPT = <<'EOJAVASCRIPT';

// From http://www.alistapart.com/articles/alternate/

function setActiveStyleSheet(title) {
  var i, a, main;
  for(i=0  ;  (a = document.getElementsByTagName("link")[i])  ;  i++) {
    if(a.getAttribute("rel").indexOf("style") != -1 && a.getAttribute("title")) {
      a.disabled = true;
      if(a.getAttribute("title") == title) a.disabled = false;
    }
  }
}

function getActiveStyleSheet() {
  var i, a;
  for(i=0  ;  (a = document.getElementsByTagName("link")[i])  ;  i++) {
    if(   a.getAttribute("rel").indexOf("style") != -1
       && a.getAttribute("title")
       && !a.disabled
       ) return a.getAttribute("title");
  }
  return null;
}

function getPreferredStyleSheet() {
  var i, a;
  for(i=0  ;  (a = document.getElementsByTagName("link")[i])  ;  i++) {
    if(   a.getAttribute("rel").indexOf("style") != -1
       && a.getAttribute("rel").indexOf("alt") == -1
       && a.getAttribute("title")
       ) return a.getAttribute("title");
  }
  return null;
}

function createCookie(name,value,days) {
  if (days) {
    var date = new Date();
    date.setTime(date.getTime()+(days*24*60*60*1000));
    var expires = "; expires="+date.toGMTString();
  }
  else expires = "";
  document.cookie = name+"="+value+expires+"; path=/";
}

function readCookie(name) {
  var nameEQ = name + "=";
  var ca = document.cookie.split(';');
  for(var i=0  ;  i < ca.length  ;  i++) {
    var c = ca[i];
    while (c.charAt(0)==' ') c = c.substring(1,c.length);
    if (c.indexOf(nameEQ) == 0) return c.substring(nameEQ.length,c.length);
  }
  return null;
}

window.onload = function(e) {
  var cookie = readCookie("style");
  var title = cookie ? cookie : getPreferredStyleSheet();
  setActiveStyleSheet(title);
}

window.onunload = function(e) {
  var title = getActiveStyleSheet();
  createCookie("style", title, 365);
}

var cookie = readCookie("style");
var title = cookie ? cookie : getPreferredStyleSheet();
setActiveStyleSheet(title);

// The End

EOJAVASCRIPT

sub _css_template { return $CSS }
sub _javascript   { return $JAVASCRIPT }

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1;
__END__


=head1 NAME

Pod::Simple::HTMLBatch - convert several Pod files to several HTML files

=head1 SYNOPSIS

  perl -MPod::Simple::HTMLBatch -e 'Pod::Simple::HTMLBatch::go' in out


=head1 DESCRIPTION

This module is used for running batch-conversions of a lot of HTML
documents

This class is NOT a subclass of Pod::Simple::HTML
(nor of bad old Pod::Html) -- although it uses
Pod::Simple::HTML for doing the conversion of each document.

The normal use of this class is like so:

  use Pod::Simple::HTMLBatch;
  my $batchconv = Pod::Simple::HTMLBatch->new;
  $batchconv->some_option( some_value );
  $batchconv->some_other_option( some_other_value );
  $batchconv->batch_convert( \@search_dirs, $output_dir );

=head2 FROM THE COMMAND LINE

Note that this class also provides
(but does not export) the function Pod::Simple::HTMLBatch::go.
This is basically just a shortcut for C<<
Pod::Simple::HTMLBatch->batch_convert(@ARGV) >>.
It's meant to be handy for calling from the command line.

However, the shortcut requires that you specify exactly two command-line
arguments, C and C.

Example:

  % mkdir out_html
  % perl -MPod::Simple::HTMLBatch -e Pod::Simple::HTMLBatch::go @INC out_html
      (to convert the pod from Perl's @INC
       files under the directory ./out_html)

(Note that the command line there contains a literal atsign-I-N-C.  This
is handled as a special case by batch_convert, in order to save you having
to enter the odd-looking "" as the first command-line parameter when you
mean "just use whatever's in @INC".)

Example:

  % mkdir ../seekrut
  % chmod og-rx ../seekrut
  % 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)

Example:

  % perl -MPod::Simple::HTMLBatch -e Pod::Simple::HTMLBatch::go happydocs .
      (to convert all pod from happydocs into the current directory)



=head1 MAIN METHODS

=over

=item $batchconv = Pod::Simple::HTMLBatch->new;

This creates a new batch converter.  The method doesn't take parameters.
To change the converter's attributes, use the L<"/ACCESSOR METHODS">
below.

=item $batchconv->batch_convert( I, I );

This searches the directories given in I and writes
HTML files for each of these to a corresponding directory
in I.  The directory I must exist.

=item $batchconv->batch_convert( undef    , ...);

=item $batchconv->batch_convert( q{@INC}, ...);

These two values for I specify that the normal Perl @INC

=item $batchconv->batch_convert( \@dirs , ...);

This specifies that the input directories are the items in
the arrayref C<\@dirs>.

=item $batchconv->batch_convert( "somedir" , ...);

This specifies that the director "somedir" is the input.
(This can be an absolute or relative path, it doesn't matter.)

A common value you might want would be just "." for the current
directory:

     $batchconv->batch_convert( "." , ...);


=item $batchconv->batch_convert( 'somedir:someother:also' , ...);

This specifies that you want the dirs "somedir", "someother", and "also"
scanned, just as if you'd passed the arrayref
C<[qw( somedir someother also)]>.  Note that a ":"-separator is normal
under Unix, but Under MSWin, you'll need C<'somedir;someother;also'>
instead, since the pathsep on MSWin is ";" instead of ":".  (And
I is because ":" often comes up in paths, like
C<"c:/perl/lib">.)

(Exactly what separator character should be used, is gotten from
C<$Config::Config{'path_sep'}>, via the L module.)

=item $batchconv->batch_convert( ... , undef );

This specifies that you want the HTML output to go into the current
directory.

(Note that a missing or undefined value means a different thing in
the first slot than in the second.  That's so that C
with no arguments (or undef arguments) means "go from @INC, into
the current directory.)

=item $batchconv->batch_convert( ... , 'somedir' );

This specifies that you want the HTML output to go into the
directory 'somedir'.
(This can be an absolute or relative path, it doesn't matter.)

=back


Note that you can also call C as a class method,
like so:

  Pod::Simple::HTMLBatch->batch_convert( ... );

That is just short for this:

  Pod::Simple::HTMLBatch-> new-> batch_convert(...);

That is, it runs a conversion with default options, for
whatever inputdirs and output dir you specify.


=head2 ACCESSOR METHODS

The following are all accessor methods -- that is, they don't do anything
on their own, but just alter the contents of the conversion object,
which comprises the options for this particular batch conversion.

We show the "put" form of the accessors below (i.e., the syntax you use
for setting the accessor to a specific value).  But you can also
call each method with no parameters to get its current value.  For
example, C<< $self->contents_file() >> returns the current value of
the contents_file attribute.

=over


=item $batchconv->verbose( I );

This controls how verbose to be during batch conversion, as far as
notes to STDOUT (or whatever is C
    \n" ) {
    warn "Couldn't print to $outfile: $!\nAbort writing to $outfile at all";
    close($Contents);
    return 0;
  }
  return 1;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

sub _write_contents_middle {
  my($self, $Contents, $outfile, $toplevel2submodules, $toplevel_form_freq) = @_;

  foreach my $t (sort keys %$toplevel2submodules) {
    my @downlines = sort {$a->[-1] cmp $b->[-1]}
                          @{ $toplevel2submodules->{$t} };

    printf $Contents qq[
    %s
    \n
    \n],
      esc( $t, $toplevel_form_freq->{$t} )
    ;

    my($path, $name);
    foreach my $e (@downlines) {
      $name = $e->[0];
      $path = join( "/", '.', esc( @{$e->[3]} ) )
        . ($HTML_EXTENSION || $Pod::Simple::HTML::HTML_EXTENSION);
      print $Contents qq{  }, esc($name), "  \n";
    }
    print $Contents "
    \n\n";
  }
  return 1;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

sub _write_contents_end {
  my($self, $Contents, $outfile) = @_;
  unless(
    print $Contents "

    ]+>This\s+is\s+a\s+heading