├── .github └── workflows │ └── testsuite.yml ├── .gitignore ├── ChangeLog ├── MANIFEST.SKIP ├── Makefile.PL ├── README ├── lib └── Pod │ ├── Simple.pm │ ├── Simple.pod │ └── Simple │ ├── BlackBox.pm │ ├── Checker.pm │ ├── Debug.pm │ ├── DumpAsText.pm │ ├── DumpAsXML.pm │ ├── HTML.pm │ ├── HTMLBatch.pm │ ├── HTMLLegacy.pm │ ├── JustPod.pm │ ├── LinkSection.pm │ ├── Methody.pm │ ├── Progress.pm │ ├── PullParser.pm │ ├── PullParserEndToken.pm │ ├── PullParserStartToken.pm │ ├── PullParserTextToken.pm │ ├── PullParserToken.pm │ ├── RTF.pm │ ├── Search.pm │ ├── SimpleTree.pm │ ├── Subclassing.pod │ ├── Text.pm │ ├── TextContent.pm │ ├── TiedOutFH.pm │ ├── Transcode.pm │ ├── TranscodeDumb.pm │ ├── TranscodeSmart.pm │ ├── XHTML.pm │ └── XMLOutStream.pm └── t ├── 00about.t ├── JustPod01.t ├── JustPod02.t ├── JustPod_corpus.t ├── ac_d.t ├── accept01.t ├── accept05.t ├── ascii_order.pl ├── basic.t ├── begin.t ├── cbacks.t ├── chunking.t ├── closeys.t ├── content_seen.t ├── corpus.t ├── corpus ├── 2202jp.txt ├── 2202jp.xml ├── 2202jpx.txt ├── 2202jpx.xml ├── 2202jpy.txt ├── 2202jpy.xml ├── 2202jpz.txt ├── 2202jpz.xml ├── 8859_7.pod ├── 8859_7.xml ├── cp1256.txt ├── cp1256.xml ├── enc_char_directive.txt ├── enc_char_directive.xml ├── enc_char_wrong_directive.txt ├── enc_char_wrong_directive.xml ├── encwarn01.txt ├── encwarn01.xml ├── encwarn02.txt ├── encwarn02.xml ├── encwarn03.txt ├── encwarn03.xml ├── encwarn04.txt ├── encwarn04.xml ├── fet_cont.txt ├── fet_cont.xml ├── fet_dup.txt ├── fet_dup.xml ├── iso6.txt ├── iso6.xml ├── koi8r.txt ├── koi8r.xml ├── laozi38.txt ├── laozi38.xml ├── laozi38b.txt ├── laozi38b.xml ├── laozi38p.pod ├── laozi38p.xml ├── lat1fr.txt ├── lat1fr.xml ├── lat1frim.txt ├── lat1frim.xml ├── nonesuch.txt ├── nonesuch.xml ├── pasternak_cp1251.txt ├── pasternak_cp1251.xml ├── plain.txt ├── plain.xml ├── plain_explicit.txt ├── plain_explicit.xml ├── plain_latin1.txt ├── plain_latin1.xml ├── plain_utf8.txt ├── plain_utf8.xml ├── polish_utf8.txt ├── polish_utf8.xml ├── s2763_sjis.txt ├── s2763_sjis.xml ├── thai_iso11.txt └── thai_iso11.xml ├── corpus2 ├── README ├── fiqhakbar_iso6.txt ├── fiqhakbar_iso6.xml ├── polish_implicit_utf8.txt ├── polish_utf16be_bom.txt ├── polish_utf16le_bom.txt ├── polish_utf8_bom.txt ├── polish_utf8_bom.xml ├── polish_utf8_bom2.txt └── polish_utf8_bom2.xml ├── emptylists.t ├── enc-chars.t ├── encod01.t ├── encod02.t ├── encod03.t ├── encod04.t ├── end_over.t ├── eol.t ├── eol2.t ├── fake-closers.t ├── fcodes.t ├── fcodes_e.t ├── fcodes_l.t ├── fcodes_s.t ├── filter-html.t ├── filter.t ├── for.t ├── fornot.t ├── github_issue_79.t ├── heads.t ├── html01.t ├── html02.t ├── html03.t ├── htmlbat.t ├── items.t ├── items02.t ├── itemstar.t ├── junk1.pod ├── junk1o.txt ├── junk2.pod ├── junk2o.txt ├── lib └── helpers.pm ├── linkclas.t ├── output.t ├── perlcyg.pod ├── perlcygo.txt ├── perlfaq.pod ├── perlfaqo.txt ├── perlvar.pod ├── perlvaro.txt ├── puller.t ├── pulltitl.t ├── reinit.t ├── render.t ├── rtf_utf8.t ├── search05.t ├── search10.t ├── search12.t ├── search20.t ├── search22.t ├── search25.t ├── search26.t ├── search27.t ├── search28.t ├── search29.t ├── search50.t ├── search60.t ├── search60 ├── A │ └── x.pod └── B │ └── X.pod ├── stree.t ├── strpvbtm.t ├── testlib1 ├── Blorm.pm ├── Zonk │ ├── Fiddle.txt │ ├── Pronk.pm │ └── Veng.pm ├── hinkhonk │ ├── Glunk.pod │ ├── Vliff.pm │ └── readme.txt ├── pod │ ├── perlflif.pod │ └── perlthng.pod ├── squaa.pm ├── squaa │ ├── Glunk.pod │ └── Vliff.pm └── zikzik.pod ├── testlib2 ├── Suzzle.pm ├── hinkhonk │ ├── Glunk.pod │ ├── Vliff.pm │ └── readme.txt ├── pod │ ├── perlthng.pod │ └── perlzuk.pod ├── pods │ └── perlzoned.pod └── squaa │ ├── Vliff.pm │ └── Wowo.pod ├── testlib3 └── squaa │ └── Vliff.pm ├── tiedfh.t ├── verb_fmt.t ├── verbatim.t ├── whine.t ├── x_nixer.t ├── xhtml-bkb.t ├── xhtml01.t ├── xhtml05.t ├── xhtml10.t ├── xhtml15.t ├── xhtml20.t └── xhtml25.t /.github/workflows/testsuite.yml: -------------------------------------------------------------------------------- 1 | name: testsuite 2 | 3 | on: 4 | push: 5 | branches: 6 | - "*" 7 | tags-ignore: 8 | - "*" 9 | pull_request: 10 | 11 | jobs: 12 | ubuntu: 13 | env: 14 | PERL_USE_UNSAFE_INC: 0 15 | AUTHOR_TESTING: 1 16 | AUTOMATED_TESTING: 1 17 | RELEASE_TESTING: 1 18 | 19 | runs-on: ubuntu-latest 20 | 21 | steps: 22 | - uses: actions/checkout@v4 23 | - name: perl -V 24 | run: perl -V 25 | - name: install dependencies 26 | uses: perl-actions/install-with-cpm@v1 27 | with: 28 | install: | 29 | Pod::Escapes 30 | Text::Wrap 31 | - name: Makefile.PL 32 | run: perl -I$(pwd) Makefile.PL 33 | - name: make test 34 | run: make test 35 | 36 | linux: 37 | name: "linux ${{ matrix.perl-version }}" 38 | needs: [ubuntu] 39 | env: 40 | PERL_USE_UNSAFE_INC: 0 41 | AUTHOR_TESTING: 1 42 | AUTOMATED_TESTING: 1 43 | RELEASE_TESTING: 1 44 | 45 | runs-on: ubuntu-latest 46 | 47 | strategy: 48 | fail-fast: false 49 | matrix: 50 | perl-version: 51 | [ 52 | "5.40", 53 | "5.38", 54 | "5.36", 55 | "5.34", 56 | "5.32", 57 | "5.30", 58 | "5.28", 59 | "5.26", 60 | "5.24-buster", 61 | "5.22-buster", 62 | "5.20-buster", 63 | "5.18-buster", 64 | "5.16-buster", 65 | "5.14-buster", 66 | "5.12-buster", 67 | "5.10-buster", 68 | "5.8-buster", 69 | ] 70 | 71 | container: 72 | image: perl:${{ matrix.perl-version }} 73 | 74 | steps: 75 | - uses: actions/checkout@v4 76 | - name: perl -V 77 | run: perl -V 78 | - name: install dependencies 79 | uses: perl-actions/install-with-cpm@v1 80 | with: 81 | sudo: false 82 | install: | 83 | ExtUtils::MakeMaker 84 | Pod::Escapes 85 | Text::Wrap 86 | - name: Makefile.PL 87 | run: perl -I$(pwd) Makefile.PL 88 | - name: make test 89 | run: make test 90 | 91 | macOS: 92 | needs: [ubuntu] 93 | env: 94 | PERL_USE_UNSAFE_INC: 0 95 | AUTHOR_TESTING: 1 96 | AUTOMATED_TESTING: 1 97 | RELEASE_TESTING: 1 98 | 99 | runs-on: macOS-latest 100 | 101 | strategy: 102 | fail-fast: false 103 | matrix: 104 | perl-version: [latest] 105 | 106 | steps: 107 | - uses: actions/checkout@v4 108 | - name: perl -V 109 | run: perl -V 110 | - name: install dependencies 111 | uses: perl-actions/install-with-cpm@v1 112 | with: 113 | install: | 114 | Pod::Escapes 115 | Text::Wrap 116 | - name: Makefile.PL 117 | run: perl -I$(pwd) Makefile.PL 118 | - name: make test 119 | run: make test 120 | 121 | windows: 122 | needs: [ubuntu] 123 | env: 124 | PERL_USE_UNSAFE_INC: 0 125 | AUTHOR_TESTING: 0 126 | AUTOMATED_TESTING: 1 127 | RELEASE_TESTING: 0 128 | 129 | runs-on: windows-latest 130 | 131 | strategy: 132 | fail-fast: false 133 | matrix: 134 | perl-version: [latest] 135 | 136 | steps: 137 | - uses: actions/checkout@v4 138 | - name: Set up Perl 139 | run: | 140 | choco install strawberryperl 141 | echo "C:\strawberry\c\bin;C:\strawberry\perl\site\bin;C:\strawberry\perl\bin" >> $GITHUB_PATH 142 | - name: perl -V 143 | run: perl -V 144 | - name: install dependencies 145 | uses: perl-actions/install-with-cpm@v1 146 | with: 147 | sudo: false 148 | install: | 149 | Pod::Escapes 150 | Text::Wrap 151 | - run: prove -vl t/*.t 152 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | blib 3 | Pod-Simple-* 4 | MANIFEST 5 | MANIFEST.bak 6 | *META.* 7 | Build 8 | Makefile 9 | Makefile.old 10 | pm_to_blib 11 | *.swp 12 | -------------------------------------------------------------------------------- /MANIFEST.SKIP: -------------------------------------------------------------------------------- 1 | #!start included /usr/local/lib/perl5/5.10.1/ExtUtils/MANIFEST.SKIP 2 | # Avoid version control files. 3 | \bRCS\b 4 | \bCVS\b 5 | \bSCCS\b 6 | ,v$ 7 | \B\.svn\b 8 | \B\.git\b 9 | \B\.github\b 10 | \B\.gitignore\b 11 | \b_darcs\b 12 | \B\.cvsignore$ 13 | 14 | # Avoid VMS specific MakeMaker generated files 15 | \bDescrip.MMS$ 16 | \bDESCRIP.MMS$ 17 | \bdescrip.mms$ 18 | 19 | # Avoid Makemaker generated and utility files. 20 | \bMANIFEST\.bak 21 | \bMakefile$ 22 | \bblib/ 23 | \bMakeMaker-\d 24 | \bpm_to_blib\.ts$ 25 | \bpm_to_blib$ 26 | \bblibdirs\.ts$ # 6.18 through 6.25 generated this 27 | 28 | # Avoid Module::Build generated and utility files. 29 | \bBuild$ 30 | \b_build/ 31 | \bBuild.bat$ 32 | \bBuild.COM$ 33 | \bBUILD.COM$ 34 | \bbuild.com$ 35 | 36 | # Avoid temp and backup files. 37 | ~$ 38 | \.old$ 39 | \#$ 40 | \b\.# 41 | \.bak$ 42 | \.tmp$ 43 | \.# 44 | \.rej$ 45 | 46 | # Avoid OS-specific files/dirs 47 | # Mac OSX metadata 48 | \B\.DS_Store 49 | # Mac OSX SMB mount metadata files 50 | \B\._ 51 | 52 | # Avoid Devel::Cover files. 53 | \bcover_db\b 54 | #!end included /usr/local/lib/perl5/5.10.1/ExtUtils/MANIFEST.SKIP 55 | 56 | ^Pod-Simple 57 | ^[-_a-zA-Z0-9]+[0-9]+\.[0-9]+(?:_[0-9]+)?$ 58 | \.out$ 59 | delme 60 | \.rej$ 61 | \..*\.sw.?$ 62 | ~ 63 | 64 | ^MYMETA\.yml$ 65 | ^MYMETA\.json$ 66 | 67 | # Avoid git-related files 68 | .git/ 69 | .github/ 70 | 71 | -------------------------------------------------------------------------------- /Makefile.PL: -------------------------------------------------------------------------------- 1 | # This -*- perl -*- script writes the Makefile for Pod::Simple 2 | # 3 | 4 | use strict; 5 | use ExtUtils::MakeMaker; 6 | 7 | my %WriteMakefileArgs = ( 8 | NAME => 'Pod::Simple', 9 | VERSION_FROM => 'lib/Pod/Simple.pm', 10 | ABSTRACT_FROM => 'lib/Pod/Simple.pod', 11 | TEST_REQUIRES => { 12 | 'Test::More' => '0.88' 13 | }, 14 | PREREQ_PM => { 15 | 'Carp' => 0, 16 | 'Config' => 0, 17 | 'Cwd' => 0, 18 | 'File::Basename' => 0, 19 | 'File::Find' => 0, 20 | 'File::Spec' => 0, 21 | 'Pod::Escapes' => '1.04', 22 | 'Symbol' => 0, 23 | 'Text::Wrap' => '98.112902', 24 | 'if' => 0, 25 | 'integer' => 0, 26 | 'overload' => 0, 27 | 'strict' => 0, 28 | 'warnings' => 0, 29 | }, 30 | 31 | INSTALLDIRS => $] >= 5.009003 && $] <= 5.011000 ? 'perl' : 'site', 32 | 33 | LICENSE => 'perl', 34 | AUTHOR => 'Allison Randal ', 35 | META_MERGE => { 36 | "meta-spec" => { version => 2 }, 37 | resources => { 38 | homepage => 'https://metacpan.org/pod/Pod::Simple', 39 | license => 'http://dev.perl.org/licenses/', 40 | repository => { 41 | url => 'https://github.com/perl-pod/pod-simple.git', 42 | web => 'https://github.com/perl-pod/pod-simple', 43 | type => 'git', 44 | }, 45 | bugtracker => { 46 | web => 'https://github.com/perl-pod/pod-simple/issues', 47 | mailto => 'bug-pod-simple@rt.cpan.org', 48 | }, 49 | x_MailingList => 'https://lists.perl.org/list/pod-people.html', 50 | }, 51 | prereqs => { 52 | runtime => { 53 | recommends => { 54 | 'Encode' => 55 | '2.78', # Pod::Simple's new default code page (1252) is 56 | # pre-compiled in 2.78, which improves performance. 57 | }, 58 | }, 59 | }, 60 | }, 61 | 62 | ); 63 | 64 | unless ( eval { ExtUtils::MakeMaker->VERSION('6.63_03') } ) { 65 | $WriteMakefileArgs{BUILD_REQUIRES} = { 66 | %{ delete $WriteMakefileArgs{TEST_REQUIRES} || {} }, 67 | %{ $WriteMakefileArgs{BUILD_REQUIRES} || {} }, 68 | }; 69 | } 70 | 71 | unless ( eval { ExtUtils::MakeMaker->VERSION('6.55_01') } ) { 72 | $WriteMakefileArgs{PREREQ_PM} = { 73 | %{ delete $WriteMakefileArgs{BUILD_REQUIRES} || {} }, 74 | %{ $WriteMakefileArgs{PREREQ_PM} || {} }, 75 | }; 76 | } 77 | 78 | WriteMakefile(%WriteMakefileArgs); 79 | 80 | package MY; 81 | 82 | sub libscan { # Determine things that should *not* be installed 83 | my ( $self, $path ) = @_; 84 | return '' if $path =~ m/~/; 85 | $path; 86 | } 87 | 88 | __END__ 89 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | Pod::Simple 2 | 3 | Pod::Simple is a Perl library for parsing text in the Pod ("plain old 4 | documentation") markup language that is typically used for writing 5 | documentation for Perl and for Perl modules. The Pod format is explained 6 | in the file shipped with Perl5; the most common formatter is called 7 | . 8 | 9 | Pod formatters can use Pod::Simple to parse Pod documents and render them into 10 | plain text, HTML, or any number of other formats. 11 | 12 | Installation 13 | 14 | To install this module, type the following: 15 | 16 | perl Makefile.PL 17 | make 18 | make test 19 | make install 20 | 21 | Support 22 | 23 | Questions or discussion about POD and Pod::Simple should be sent to the 24 | pod-people@perl.org mail list. Send an empty email to 25 | pod-people-subscribe@perl.org to subscribe. 26 | 27 | This module is managed in an open GitHub repository, 28 | . Feel free to fork and contribute, or 29 | to clone it and send patches! 30 | 31 | Patches against Pod::Simple are welcome. Please send bug reports to 32 | . 33 | 34 | Copyright and Disclaimers 35 | 36 | Copyright (c) 2002 Sean M. Burke. All rights reserved. 37 | 38 | This library is free software; you can redistribute it and/or modify it 39 | under the same terms as Perl itself. 40 | 41 | This program is distributed in the hope that it will be useful, but 42 | without any warranty; without even the implied warranty of 43 | merchantability or fitness for a particular purpose. 44 | 45 | Author 46 | 47 | Pod::Simple was created by Sean M. Burke . 48 | But don't bother him, he's retired. 49 | 50 | Pod::Simple is maintained by: 51 | 52 | * Allison Randal 53 | 54 | * Hans Dieter Pearcey 55 | 56 | * David E. Wheeler 57 | 58 | * Marc Green 59 | -------------------------------------------------------------------------------- /lib/Pod/Simple/HTMLLegacy.pm: -------------------------------------------------------------------------------- 1 | package Pod::Simple::HTMLLegacy; 2 | use strict; 3 | use warnings; 4 | 5 | use Getopt::Long; 6 | 7 | our $VERSION = "5.02"; 8 | 9 | #-------------------------------------------------------------------------- 10 | # 11 | # This class is meant to thinly emulate bad old Pod::Html 12 | # 13 | # TODO: some basic docs 14 | 15 | sub pod2html { 16 | my @args = (@_); 17 | 18 | my( $verbose, $infile, $outfile, $title ); 19 | my $index = 1; 20 | 21 | { 22 | my($help); 23 | 24 | my($netscape); # dummy 25 | local @ARGV = @args; 26 | GetOptions( 27 | "help" => \$help, 28 | "verbose!" => \$verbose, 29 | "infile=s" => \$infile, 30 | "outfile=s" => \$outfile, 31 | "title=s" => \$title, 32 | "index!" => \$index, 33 | 34 | "netscape!" => \$netscape, 35 | ) or return bad_opts(@args); 36 | bad_opts(@args) if @ARGV; # it should be all switches! 37 | return help_message() if $help; 38 | } 39 | 40 | for($infile, $outfile) { $_ = undef unless defined and length } 41 | 42 | if($verbose) { 43 | warn sprintf "%s version %s\n", __PACKAGE__, $VERSION; 44 | warn "OK, processed args [@args] ...\n"; 45 | warn sprintf 46 | " Verbose: %s\n Index: %s\n Infile: %s\n Outfile: %s\n Title: %s\n", 47 | map defined($_) ? $_ : "(nil)", 48 | $verbose, $index, $infile, $outfile, $title, 49 | ; 50 | *Pod::Simple::HTML::DEBUG = sub(){1}; 51 | } 52 | require Pod::Simple::HTML; 53 | Pod::Simple::HTML->VERSION(3); 54 | 55 | die "No such input file as $infile\n" 56 | if defined $infile and ! -e $infile; 57 | 58 | 59 | my $pod = Pod::Simple::HTML->new; 60 | $pod->force_title($title) if defined $title; 61 | $pod->index($index); 62 | return $pod->parse_from_file($infile, $outfile); 63 | } 64 | 65 | #-------------------------------------------------------------------------- 66 | 67 | sub bad_opts { die _help_message(); } 68 | sub help_message { print STDOUT _help_message() } 69 | 70 | #-------------------------------------------------------------------------- 71 | 72 | sub _help_message { 73 | 74 | join '', 75 | 76 | "[", __PACKAGE__, " version ", $VERSION, qq~] 77 | Usage: pod2html --help --infile= --outfile= 78 | --verbose --index --noindex 79 | 80 | Options: 81 | --help - prints this message. 82 | --[no]index - generate an index at the top of the resulting html 83 | (default behavior). 84 | --infile - filename for the pod to convert (input taken from stdin 85 | by default). 86 | --outfile - filename for the resulting html file (output sent to 87 | stdout by default). 88 | --title - title that will appear in resulting html file. 89 | --[no]verbose - self-explanatory (off by default). 90 | 91 | Note that pod2html is DEPRECATED, and this version implements only 92 | some of the options known to older versions. 93 | For more information, see 'perldoc pod2html'. 94 | ~; 95 | 96 | } 97 | 98 | 1; 99 | __END__ 100 | 101 | OVER the underpass! UNDER the overpass! Around the FUTURE and BEYOND REPAIR!! 102 | 103 | -------------------------------------------------------------------------------- /lib/Pod/Simple/Methody.pm: -------------------------------------------------------------------------------- 1 | package Pod::Simple::Methody; 2 | use strict; 3 | use warnings; 4 | use Pod::Simple (); 5 | our $VERSION = '3.47'; 6 | our @ISA = ('Pod::Simple'); 7 | 8 | # Yes, we could use named variables, but I want this to be impose 9 | # as little an additional performance hit as possible. 10 | 11 | sub _handle_element_start { 12 | $_[1] =~ tr/-:./__/; 13 | ( $_[0]->can( 'start_' . $_[1] ) 14 | || return 15 | )->( 16 | $_[0], $_[2] 17 | ); 18 | } 19 | 20 | sub _handle_text { 21 | ( $_[0]->can( 'handle_text' ) 22 | || return 23 | )->( 24 | @_ 25 | ); 26 | } 27 | 28 | sub _handle_element_end { 29 | $_[1] =~ tr/-:./__/; 30 | ( $_[0]->can( 'end_' . $_[1] ) 31 | || return 32 | )->( 33 | $_[0], $_[2] 34 | ); 35 | } 36 | 37 | 1; 38 | 39 | 40 | __END__ 41 | 42 | =head1 NAME 43 | 44 | Pod::Simple::Methody -- turn Pod::Simple events into method calls 45 | 46 | =head1 SYNOPSIS 47 | 48 | require 5; 49 | use strict; 50 | package SomePodFormatter; 51 | use base qw(Pod::Simple::Methody); 52 | 53 | sub handle_text { 54 | my($self, $text) = @_; 55 | ... 56 | } 57 | 58 | sub start_head1 { 59 | my($self, $attrs) = @_; 60 | ... 61 | } 62 | sub end_head1 { 63 | my($self) = @_; 64 | ... 65 | } 66 | 67 | ...and start_/end_ methods for whatever other events you want to catch. 68 | 69 | =head1 DESCRIPTION 70 | 71 | This class is of 72 | interest to people writing Pod formatters based on Pod::Simple. 73 | 74 | This class (which is very small -- read the source) overrides 75 | Pod::Simple's _handle_element_start, _handle_text, and 76 | _handle_element_end methods so that parser events are turned into method 77 | calls. (Otherwise, this is a subclass of L and inherits all 78 | its methods.) 79 | 80 | You can use this class as the base class for a Pod formatter/processor. 81 | 82 | =head1 METHOD CALLING 83 | 84 | When Pod::Simple sees a "=head1 Hi there", for example, it basically does 85 | this: 86 | 87 | $parser->_handle_element_start( "head1", \%attributes ); 88 | $parser->_handle_text( "Hi there" ); 89 | $parser->_handle_element_end( "head1" ); 90 | 91 | But if you subclass Pod::Simple::Methody, it will instead do this 92 | when it sees a "=head1 Hi there": 93 | 94 | $parser->start_head1( \%attributes ) if $parser->can('start_head1'); 95 | $parser->handle_text( "Hi there" ) if $parser->can('handle_text'); 96 | $parser->end_head1() if $parser->can('end_head1'); 97 | 98 | If Pod::Simple sends an event where the element name has a dash, 99 | period, or colon, the corresponding method name will have a underscore 100 | in its place. For example, "foo.bar:baz" becomes start_foo_bar_baz 101 | and end_foo_bar_baz. 102 | 103 | See the source for Pod::Simple::Text for an example of using this class. 104 | 105 | =head1 SEE ALSO 106 | 107 | L, L 108 | 109 | =head1 SUPPORT 110 | 111 | Questions or discussion about POD and Pod::Simple should be sent to the 112 | pod-people@perl.org mail list. Send an empty email to 113 | pod-people-subscribe@perl.org to subscribe. 114 | 115 | This module is managed in an open GitHub repository, 116 | L. Feel free to fork and contribute, or 117 | to clone L and send patches! 118 | 119 | Patches against Pod::Simple are welcome. Please send bug reports to 120 | . 121 | 122 | =head1 COPYRIGHT AND DISCLAIMERS 123 | 124 | Copyright (c) 2002 Sean M. Burke. 125 | 126 | This library is free software; you can redistribute it and/or modify it 127 | under the same terms as Perl itself. 128 | 129 | This program is distributed in the hope that it will be useful, but 130 | without any warranty; without even the implied warranty of 131 | merchantability or fitness for a particular purpose. 132 | 133 | =head1 AUTHOR 134 | 135 | Pod::Simple was created by Sean M. Burke . 136 | But don't bother him, he's retired. 137 | 138 | Pod::Simple is maintained by: 139 | 140 | =over 141 | 142 | =item * Allison Randal C 143 | 144 | =item * Hans Dieter Pearcey C 145 | 146 | =item * David E. Wheeler C 147 | 148 | =back 149 | 150 | =cut 151 | -------------------------------------------------------------------------------- /lib/Pod/Simple/Progress.pm: -------------------------------------------------------------------------------- 1 | package Pod::Simple::Progress; 2 | use strict; 3 | use warnings; 4 | 5 | our $VERSION = '3.47'; 6 | 7 | # Objects of this class are used for noting progress of an 8 | # operation every so often. Messages delivered more often than that 9 | # are suppressed. 10 | # 11 | # There's actually nothing in here that's specific to Pod processing; 12 | # but it's ad-hoc enough that I'm not willing to give it a name that 13 | # implies that it's generally useful, like "IO::Progress" or something. 14 | # 15 | # -- sburke 16 | # 17 | #-------------------------------------------------------------------------- 18 | 19 | sub new { 20 | my($class,$delay) = @_; 21 | my $self = bless {'quiet_until' => 1}, ref($class) || $class; 22 | $self->to(*STDOUT{IO}); 23 | $self->delay(defined($delay) ? $delay : 5); 24 | return $self; 25 | } 26 | 27 | sub copy { 28 | my $orig = shift; 29 | bless {%$orig, 'quiet_until' => 1}, ref($orig); 30 | } 31 | #-------------------------------------------------------------------------- 32 | 33 | sub reach { 34 | my($self, $point, $note) = @_; 35 | if( (my $now = time) >= $self->{'quiet_until'}) { 36 | my $goal; 37 | my $to = $self->{'to'}; 38 | print $to join('', 39 | ($self->{'quiet_until'} == 1) ? () : '... ', 40 | (defined $point) ? ( 41 | '#', 42 | ($goal = $self->{'goal'}) ? ( 43 | ' ' x (length($goal) - length($point)), 44 | $point, '/', $goal, 45 | ) : $point, 46 | $note ? ': ' : (), 47 | ) : (), 48 | $note || '', 49 | "\n" 50 | ); 51 | $self->{'quiet_until'} = $now + $self->{'delay'}; 52 | } 53 | return $self; 54 | } 55 | 56 | #-------------------------------------------------------------------------- 57 | 58 | sub done { 59 | my($self, $note) = @_; 60 | $self->{'quiet_until'} = 1; 61 | return $self->reach( undef, $note ); 62 | } 63 | 64 | #-------------------------------------------------------------------------- 65 | # Simple accessors: 66 | 67 | sub delay { 68 | return $_[0]{'delay'} if @_ == 1; $_[0]{'delay'} = $_[1]; return $_[0] } 69 | sub goal { 70 | return $_[0]{'goal' } if @_ == 1; $_[0]{'goal' } = $_[1]; return $_[0] } 71 | sub to { 72 | return $_[0]{'to' } if @_ == 1; $_[0]{'to' } = $_[1]; return $_[0] } 73 | 74 | #-------------------------------------------------------------------------- 75 | 76 | unless(caller) { # Simple self-test: 77 | my $p = __PACKAGE__->new->goal(5); 78 | $p->reach(1, "Primus!"); 79 | sleep 1; 80 | $p->reach(2, "Secundus!"); 81 | sleep 3; 82 | $p->reach(3, "Tertius!"); 83 | sleep 5; 84 | $p->reach(4); 85 | $p->reach(5, "Quintus!"); 86 | sleep 1; 87 | $p->done("All done"); 88 | } 89 | 90 | #-------------------------------------------------------------------------- 91 | 1; 92 | __END__ 93 | 94 | -------------------------------------------------------------------------------- /lib/Pod/Simple/PullParserEndToken.pm: -------------------------------------------------------------------------------- 1 | package Pod::Simple::PullParserEndToken; 2 | use strict; 3 | use warnings; 4 | use Pod::Simple::PullParserToken (); 5 | our @ISA = ('Pod::Simple::PullParserToken'); 6 | our $VERSION = '3.47'; 7 | 8 | sub new { # Class->new(tagname); 9 | my $class = shift; 10 | return bless ['end', @_], ref($class) || $class; 11 | } 12 | 13 | # Purely accessors: 14 | 15 | sub tagname { (@_ == 2) ? ($_[0][1] = $_[1]) : $_[0][1] } 16 | sub tag { shift->tagname(@_) } 17 | 18 | # shortcut: 19 | sub is_tagname { $_[0][1] eq $_[1] } 20 | sub is_tag { shift->is_tagname(@_) } 21 | 22 | 1; 23 | 24 | 25 | __END__ 26 | 27 | =head1 NAME 28 | 29 | Pod::Simple::PullParserEndToken -- end-tokens from Pod::Simple::PullParser 30 | 31 | =head1 SYNOPSIS 32 | 33 | (See L) 34 | 35 | =head1 DESCRIPTION 36 | 37 | When you do $parser->get_token on a L, you might 38 | get an object of this class. 39 | 40 | This is a subclass of L and inherits all its methods, 41 | and adds these methods: 42 | 43 | =over 44 | 45 | =item $token->tagname 46 | 47 | This returns the tagname for this end-token object. 48 | For example, parsing a "=head1 ..." line will give you 49 | a start-token with the tagname of "head1", token(s) for its 50 | content, and then an end-token with the tagname of "head1". 51 | 52 | =item $token->tagname(I) 53 | 54 | This changes the tagname for this end-token object. 55 | You probably won't need to do this. 56 | 57 | =item $token->tag(...) 58 | 59 | A shortcut for $token->tagname(...) 60 | 61 | =item $token->is_tag(I) or $token->is_tagname(I) 62 | 63 | These are shortcuts for C<< $token->tag() eq I >> 64 | 65 | =back 66 | 67 | You're unlikely to ever need to construct an object of this class for 68 | yourself, but if you want to, call 69 | C<< 70 | Pod::Simple::PullParserEndToken->new( I ) 71 | >> 72 | 73 | =head1 SEE ALSO 74 | 75 | L, L, L 76 | 77 | =head1 SUPPORT 78 | 79 | Questions or discussion about POD and Pod::Simple should be sent to the 80 | pod-people@perl.org mail list. Send an empty email to 81 | pod-people-subscribe@perl.org to subscribe. 82 | 83 | This module is managed in an open GitHub repository, 84 | L. Feel free to fork and contribute, or 85 | to clone L and send patches! 86 | 87 | Patches against Pod::Simple are welcome. Please send bug reports to 88 | . 89 | 90 | =head1 COPYRIGHT AND DISCLAIMERS 91 | 92 | Copyright (c) 2002 Sean M. Burke. 93 | 94 | This library is free software; you can redistribute it and/or modify it 95 | under the same terms as Perl itself. 96 | 97 | This program is distributed in the hope that it will be useful, but 98 | without any warranty; without even the implied warranty of 99 | merchantability or fitness for a particular purpose. 100 | 101 | =head1 AUTHOR 102 | 103 | Pod::Simple was created by Sean M. Burke . 104 | But don't bother him, he's retired. 105 | 106 | Pod::Simple is maintained by: 107 | 108 | =over 109 | 110 | =item * Allison Randal C 111 | 112 | =item * Hans Dieter Pearcey C 113 | 114 | =item * David E. Wheeler C 115 | 116 | =back 117 | 118 | =cut 119 | -------------------------------------------------------------------------------- /lib/Pod/Simple/PullParserTextToken.pm: -------------------------------------------------------------------------------- 1 | package Pod::Simple::PullParserTextToken; 2 | use strict; 3 | use warnings; 4 | use Pod::Simple::PullParserToken (); 5 | our @ISA = ('Pod::Simple::PullParserToken'); 6 | our $VERSION = '3.47'; 7 | 8 | sub new { # Class->new(text); 9 | my $class = shift; 10 | return bless ['text', @_], ref($class) || $class; 11 | } 12 | 13 | # Purely accessors: 14 | 15 | sub text { (@_ == 2) ? ($_[0][1] = $_[1]) : $_[0][1] } 16 | 17 | sub text_r { \ $_[0][1] } 18 | 19 | 1; 20 | 21 | __END__ 22 | 23 | =head1 NAME 24 | 25 | Pod::Simple::PullParserTextToken -- text-tokens from Pod::Simple::PullParser 26 | 27 | =head1 SYNOPSIS 28 | 29 | (See L) 30 | 31 | =head1 DESCRIPTION 32 | 33 | When you do $parser->get_token on a L, you might 34 | get an object of this class. 35 | 36 | This is a subclass of L and inherits all its methods, 37 | and adds these methods: 38 | 39 | =over 40 | 41 | =item $token->text 42 | 43 | This returns the text that this token holds. For example, parsing 44 | CZ<> will return a C start-token, a text-token, and a C end-token. And 45 | if you want to get the "foo" out of the text-token, call C<< $token->text >> 46 | 47 | =item $token->text(I) 48 | 49 | This changes the string that this token holds. You probably won't need 50 | to do this. 51 | 52 | =item $token->text_r() 53 | 54 | This returns a scalar reference to the string that this token holds. 55 | This can be useful if you don't want to memory-copy the potentially 56 | large text value (well, as large as a paragraph or a verbatim block) 57 | as calling $token->text would do. 58 | 59 | Or, if you want to alter the value, you can even do things like this: 60 | 61 | for ( ${ $token->text_r } ) { # Aliases it with $_ !! 62 | 63 | s/ The / the /g; # just for example 64 | 65 | if( 'A' eq chr(65) ) { # (if in an ASCII world) 66 | tr/\xA0/ /; 67 | tr/\xAD//d; 68 | } 69 | 70 | ...or however you want to alter the value... 71 | (Note that starting with Perl v5.8, you can use, e.g., 72 | 73 | my $nbsp = chr utf8::unicode_to_native(0xA0); 74 | s/$nbsp/ /g; 75 | 76 | to handle the above regardless if it's an ASCII world or not) 77 | } 78 | 79 | =back 80 | 81 | You're unlikely to ever need to construct an object of this class for 82 | yourself, but if you want to, call 83 | C<< 84 | Pod::Simple::PullParserTextToken->new( I ) 85 | >> 86 | 87 | =head1 SEE ALSO 88 | 89 | L, L, L 90 | 91 | =head1 SUPPORT 92 | 93 | Questions or discussion about POD and Pod::Simple should be sent to the 94 | pod-people@perl.org mail list. Send an empty email to 95 | pod-people-subscribe@perl.org to subscribe. 96 | 97 | This module is managed in an open GitHub repository, 98 | L. Feel free to fork and contribute, or 99 | to clone L and send patches! 100 | 101 | Patches against Pod::Simple are welcome. Please send bug reports to 102 | . 103 | 104 | =head1 COPYRIGHT AND DISCLAIMERS 105 | 106 | Copyright (c) 2002 Sean M. Burke. 107 | 108 | This library is free software; you can redistribute it and/or modify it 109 | under the same terms as Perl itself. 110 | 111 | This program is distributed in the hope that it will be useful, but 112 | without any warranty; without even the implied warranty of 113 | merchantability or fitness for a particular purpose. 114 | 115 | =head1 AUTHOR 116 | 117 | Pod::Simple was created by Sean M. Burke . 118 | But don't bother him, he's retired. 119 | 120 | Pod::Simple is maintained by: 121 | 122 | =over 123 | 124 | =item * Allison Randal C 125 | 126 | =item * Hans Dieter Pearcey C 127 | 128 | =item * David E. Wheeler C 129 | 130 | =back 131 | 132 | =cut 133 | -------------------------------------------------------------------------------- /lib/Pod/Simple/TextContent.pm: -------------------------------------------------------------------------------- 1 | package Pod::Simple::TextContent; 2 | use strict; 3 | use warnings; 4 | use Carp (); 5 | use Pod::Simple (); 6 | our $VERSION = '3.47'; 7 | our @ISA = ('Pod::Simple'); 8 | 9 | sub new { 10 | my $self = shift; 11 | my $new = $self->SUPER::new(@_); 12 | $new->{'output_fh'} ||= *STDOUT{IO}; 13 | $new->nix_X_codes(1); 14 | return $new; 15 | } 16 | 17 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 18 | 19 | sub _handle_element_start { 20 | print {$_[0]{'output_fh'}} "\n" unless $_[1] =~ m/^[A-Z]$/s; 21 | return; 22 | } 23 | 24 | sub _handle_text { 25 | $_[1] =~ s/$Pod::Simple::shy//g; 26 | $_[1] =~ s/$Pod::Simple::nbsp/ /g; 27 | print {$_[0]{'output_fh'}} $_[1]; 28 | return; 29 | } 30 | 31 | sub _handle_element_end { 32 | print {$_[0]{'output_fh'}} "\n" unless $_[1] =~ m/^[A-Z]$/s; 33 | return; 34 | } 35 | 36 | #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 37 | 1; 38 | 39 | 40 | __END__ 41 | 42 | =head1 NAME 43 | 44 | Pod::Simple::TextContent -- get the text content of Pod 45 | 46 | =head1 SYNOPSIS 47 | 48 | TODO 49 | 50 | perl -MPod::Simple::TextContent -e \ 51 | "exit Pod::Simple::TextContent->filter(shift)->any_errata_seen" \ 52 | thingy.pod 53 | 54 | =head1 DESCRIPTION 55 | 56 | This class is that parses Pod and dumps just the text content. It is 57 | mainly meant for use by the Pod::Simple test suite, but you may find 58 | some other use for it. 59 | 60 | This is a subclass of L and inherits all its methods. 61 | 62 | =head1 SEE ALSO 63 | 64 | L, L, L 65 | 66 | =head1 SUPPORT 67 | 68 | Questions or discussion about POD and Pod::Simple should be sent to the 69 | pod-people@perl.org mail list. Send an empty email to 70 | pod-people-subscribe@perl.org to subscribe. 71 | 72 | This module is managed in an open GitHub repository, 73 | L. Feel free to fork and contribute, or 74 | to clone L and send patches! 75 | 76 | Patches against Pod::Simple are welcome. Please send bug reports to 77 | . 78 | 79 | =head1 COPYRIGHT AND DISCLAIMERS 80 | 81 | Copyright (c) 2002 Sean M. Burke. 82 | 83 | This library is free software; you can redistribute it and/or modify it 84 | under the same terms as Perl itself. 85 | 86 | This program is distributed in the hope that it will be useful, but 87 | without any warranty; without even the implied warranty of 88 | merchantability or fitness for a particular purpose. 89 | 90 | =head1 AUTHOR 91 | 92 | Pod::Simple was created by Sean M. Burke . 93 | But don't bother him, he's retired. 94 | 95 | Pod::Simple is maintained by: 96 | 97 | =over 98 | 99 | =item * Allison Randal C 100 | 101 | =item * Hans Dieter Pearcey C 102 | 103 | =item * David E. Wheeler C 104 | 105 | =back 106 | 107 | =cut 108 | -------------------------------------------------------------------------------- /lib/Pod/Simple/TiedOutFH.pm: -------------------------------------------------------------------------------- 1 | package Pod::Simple::TiedOutFH; 2 | use strict; 3 | use warnings; 4 | use Symbol ('gensym'); 5 | use Carp (); 6 | our $VERSION = '3.47'; 7 | 8 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 9 | 10 | sub handle_on { # some horrible frightening things are encapsulated in here 11 | my $class = shift; 12 | $class = ref($class) || $class; 13 | 14 | Carp::croak "Usage: ${class}->handle_on(\$somescalar)" unless @_; 15 | 16 | my $x = (defined($_[0]) and ref($_[0])) 17 | ? $_[0] 18 | : ( \( $_[0] ) )[0] 19 | ; 20 | $$x = '' unless defined $$x; 21 | 22 | #Pod::Simple::DEBUG and print STDERR "New $class handle on $x = \"$$x\"\n"; 23 | 24 | my $new = gensym(); 25 | tie *$new, $class, $x; 26 | return $new; 27 | } 28 | 29 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 30 | 31 | sub TIEHANDLE { # Ties to just a scalar ref 32 | my($class, $scalar_ref) = @_; 33 | $$scalar_ref = '' unless defined $$scalar_ref; 34 | return bless \$scalar_ref, ref($class) || $class; 35 | } 36 | 37 | sub PRINT { 38 | my $it = shift; 39 | foreach my $x (@_) { $$$it .= $x } 40 | 41 | #Pod::Simple::DEBUG > 10 and print STDERR " appended to $$it = \"$$$it\"\n"; 42 | 43 | return 1; 44 | } 45 | 46 | sub FETCH { 47 | return ${$_[0]}; 48 | } 49 | 50 | sub PRINTF { 51 | my $it = shift; 52 | my $format = shift; 53 | $$$it .= sprintf $format, @_; 54 | return 1; 55 | } 56 | 57 | sub FILENO { ${ $_[0] } + 100 } # just to produce SOME number 58 | 59 | sub CLOSE { 1 } 60 | 61 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 62 | 1; 63 | __END__ 64 | 65 | Chole 66 | 67 | * 1 large red onion 68 | * 2 tomatillos 69 | * 4 or 5 roma tomatoes (optionally with the pulp discarded) 70 | * 1 tablespoons chopped ginger root (or more, to taste) 71 | * 2 tablespoons canola oil (or vegetable oil) 72 | 73 | * 1 tablespoon garam masala 74 | * 1/2 teaspoon red chili powder, or to taste 75 | * Salt, to taste (probably quite a bit) 76 | * 2 (15-ounce) cans chick peas or garbanzo beans, drained and rinsed 77 | * juice of one smallish lime 78 | * a dash of balsamic vinegar (to taste) 79 | * cooked rice, preferably long-grain white rice (whether plain, 80 | basmati rice, jasmine rice, or even a mild pilaf) 81 | 82 | In a blender or food processor, puree the onions, tomatoes, tomatillos, 83 | and ginger root. You can even do it with a Braun hand "mixer", if you 84 | chop things finer to start with, and work at it. 85 | 86 | In a saucepan set over moderate heat, warm the oil until hot. 87 | 88 | Add the puree and the balsamic vinegar, and cook, stirring occasionally, 89 | for 20 to 40 minutes. (Cooking it longer will make it sweeter.) 90 | 91 | Add the Garam Masala, chili powder, and cook, stirring occasionally, for 92 | 5 minutes. 93 | 94 | Add the salt and chick peas and cook, stirring, until heated through. 95 | 96 | Stir in the lime juice, and optionally one or two teaspoons of tahini. 97 | You can let it simmer longer, depending on how much softer you want the 98 | garbanzos to get. 99 | 100 | Serve over rice, like a curry. 101 | 102 | Yields 5 to 7 servings. 103 | 104 | 105 | -------------------------------------------------------------------------------- /lib/Pod/Simple/Transcode.pm: -------------------------------------------------------------------------------- 1 | package Pod::Simple::Transcode; 2 | use strict; 3 | our $VERSION = '3.47'; 4 | 5 | BEGIN { 6 | if(defined &DEBUG) {;} # Okay 7 | elsif( defined &Pod::Simple::DEBUG ) { *DEBUG = \&Pod::Simple::DEBUG; } 8 | else { *DEBUG = sub () {0}; } 9 | } 10 | 11 | our @ISA; 12 | foreach my $class ( 13 | 'Pod::Simple::TranscodeSmart', 14 | 'Pod::Simple::TranscodeDumb', 15 | '', 16 | ) { 17 | $class or die "Couldn't load any encoding classes"; 18 | DEBUG and print STDERR "About to try loading $class...\n"; 19 | eval "require $class;"; 20 | if($@) { 21 | DEBUG and print STDERR "Couldn't load $class: $@\n"; 22 | } else { 23 | DEBUG and print STDERR "OK, loaded $class.\n"; 24 | @ISA = ($class); 25 | last; 26 | } 27 | } 28 | 29 | sub _blorp { return; } # just to avoid any "empty class" warning 30 | 31 | 1; 32 | __END__ 33 | 34 | 35 | -------------------------------------------------------------------------------- /lib/Pod/Simple/TranscodeDumb.pm: -------------------------------------------------------------------------------- 1 | package Pod::Simple::TranscodeDumb; 2 | use strict; 3 | our $VERSION = '3.47'; 4 | # This module basically pretends it knows how to transcode, except 5 | # only for null-transcodings! We use this when Encode isn't 6 | # available. 7 | 8 | our %Supported = ( 9 | 'ascii' => 1, 10 | 'ascii-ctrl' => 1, 11 | 'iso-8859-1' => 1, 12 | 'cp1252' => 1, 13 | 'null' => 1, 14 | 'latin1' => 1, 15 | 'latin-1' => 1, 16 | %Supported, 17 | ); 18 | 19 | sub is_dumb {1} 20 | sub is_smart {0} 21 | 22 | sub all_encodings { 23 | return sort keys %Supported; 24 | } 25 | 26 | sub encoding_is_available { 27 | return exists $Supported{lc $_[1]}; 28 | } 29 | 30 | sub encmodver { 31 | return __PACKAGE__ . " v" .($VERSION || '?'); 32 | } 33 | 34 | sub make_transcoder { 35 | my ($e) = $_[1]; 36 | die "WHAT ENCODING!?!?" unless $e; 37 | # No-op for all but CP1252. 38 | return sub {;} if $e !~ /^cp-?1252$/i; 39 | 40 | # Replace CP1252 nerbles with their ASCII equivalents. 41 | return sub { 42 | # Copied from Encode::ZapCP1252. 43 | my %ascii_for = ( 44 | # http://en.wikipedia.org/wiki/Windows-1252 45 | "\x80" => 'e', # EURO SIGN 46 | "\x82" => ',', # SINGLE LOW-9 QUOTATION MARK 47 | "\x83" => 'f', # LATIN SMALL LETTER F WITH HOOK 48 | "\x84" => ',,', # DOUBLE LOW-9 QUOTATION MARK 49 | "\x85" => '...', # HORIZONTAL ELLIPSIS 50 | "\x86" => '+', # DAGGER 51 | "\x87" => '++', # DOUBLE DAGGER 52 | "\x88" => '^', # MODIFIER LETTER CIRCUMFLEX ACCENT 53 | "\x89" => '%', # PER MILLE SIGN 54 | "\x8a" => 'S', # LATIN CAPITAL LETTER S WITH CARON 55 | "\x8b" => '<', # SINGLE LEFT-POINTING ANGLE QUOTATION MARK 56 | "\x8c" => 'OE', # LATIN CAPITAL LIGATURE OE 57 | "\x8e" => 'Z', # LATIN CAPITAL LETTER Z WITH CARON 58 | "\x91" => "'", # LEFT SINGLE QUOTATION MARK 59 | "\x92" => "'", # RIGHT SINGLE QUOTATION MARK 60 | "\x93" => '"', # LEFT DOUBLE QUOTATION MARK 61 | "\x94" => '"', # RIGHT DOUBLE QUOTATION MARK 62 | "\x95" => '*', # BULLET 63 | "\x96" => '-', # EN DASH 64 | "\x97" => '--', # EM DASH 65 | "\x98" => '~', # SMALL TILDE 66 | "\x99" => '(tm)', # TRADE MARK SIGN 67 | "\x9a" => 's', # LATIN SMALL LETTER S WITH CARON 68 | "\x9b" => '>', # SINGLE RIGHT-POINTING ANGLE QUOTATION MARK 69 | "\x9c" => 'oe', # LATIN SMALL LIGATURE OE 70 | "\x9e" => 'z', # LATIN SMALL LETTER Z WITH CARON 71 | "\x9f" => 'Y', # LATIN CAPITAL LETTER Y WITH DIAERESIS 72 | ); 73 | 74 | s{([\x80-\x9f])}{$ascii_for{$1} || $1}emxsg for @_; 75 | }; 76 | } 77 | 78 | 79 | 1; 80 | 81 | 82 | use warnings; 83 | -------------------------------------------------------------------------------- /lib/Pod/Simple/TranscodeSmart.pm: -------------------------------------------------------------------------------- 1 | use 5.008; 2 | ## Anything before 5.8.0 is GIMPY! 3 | ## This module is to be use()'d only by Pod::Simple::Transcode 4 | 5 | package Pod::Simple::TranscodeSmart; 6 | use strict; 7 | use warnings; 8 | use Pod::Simple; 9 | use Encode; 10 | our $VERSION = '3.47'; 11 | 12 | sub is_dumb {0} 13 | sub is_smart {1} 14 | 15 | sub all_encodings { 16 | return Encode::->encodings(':all'); 17 | } 18 | 19 | sub encoding_is_available { 20 | return Encode::resolve_alias($_[1]); 21 | } 22 | 23 | sub encmodver { 24 | return "Encode.pm v" .($Encode::VERSION || '?'); 25 | } 26 | 27 | sub make_transcoder { 28 | my $e = Encode::find_encoding($_[1]); 29 | die "WHAT ENCODING!?!?" unless $e; 30 | my $x; 31 | return sub { 32 | foreach $x (@_) { 33 | $x = $e->decode($x) unless Encode::is_utf8($x); 34 | } 35 | return; 36 | }; 37 | } 38 | 39 | 40 | 1; 41 | 42 | 43 | -------------------------------------------------------------------------------- /t/00about.t: -------------------------------------------------------------------------------- 1 | # Summary of, well, things. 2 | 3 | use strict; 4 | use warnings; 5 | use Test::More; 6 | my @modules; 7 | BEGIN { 8 | @modules = qw( 9 | 10 | Pod::Escapes 11 | 12 | Pod::Simple 13 | Pod::Simple::BlackBox 14 | Pod::Simple::Checker 15 | Pod::Simple::DumpAsText 16 | Pod::Simple::DumpAsXML 17 | Pod::Simple::HTML 18 | Pod::Simple::HTMLBatch 19 | Pod::Simple::HTMLLegacy 20 | Pod::Simple::LinkSection 21 | Pod::Simple::Methody 22 | Pod::Simple::JustPod 23 | Pod::Simple::Progress 24 | Pod::Simple::PullParser 25 | Pod::Simple::PullParserEndToken 26 | Pod::Simple::PullParserStartToken 27 | Pod::Simple::PullParserTextToken 28 | Pod::Simple::PullParserToken 29 | Pod::Simple::RTF 30 | Pod::Simple::Search 31 | Pod::Simple::SimpleTree 32 | Pod::Simple::Text 33 | Pod::Simple::TextContent 34 | Pod::Simple::TiedOutFH 35 | Pod::Simple::Transcode 36 | Pod::Simple::XMLOutStream 37 | 38 | ); 39 | plan tests => scalar @modules; 40 | }; 41 | 42 | #chdir "t" if -e "t"; 43 | foreach my $m (@modules) { 44 | print "# Loading $m ...\n"; 45 | eval "require $m;"; 46 | unless($@) { ok 1; next } 47 | my $e = $@; 48 | $e =~ s/\s+$//s; 49 | $e =~ s/[\n\r]+/\n# > /; 50 | print "# Error while trying to load $m --\n# > $e\n"; 51 | ok 0; 52 | } 53 | 54 | { 55 | my @out; 56 | push @out, 57 | "\n\nPerl v", 58 | defined($^V) ? sprintf('%vd', $^V) : $], 59 | " under $^O ", 60 | (defined(&Win32::BuildNumber) and defined &Win32::BuildNumber()) 61 | ? ("(Win32::BuildNumber ", &Win32::BuildNumber(), ")") : (), 62 | (defined $MacPerl::Version) 63 | ? ("(MacPerl version $MacPerl::Version)") : (), 64 | "\n" 65 | ; 66 | 67 | # Ugly code to walk the symbol tables: 68 | my %v; 69 | my @stack = (''); # start out in %:: 70 | my $this; 71 | my $count = 0; 72 | my $pref; 73 | while(@stack) { 74 | $this = shift @stack; 75 | die "Too many packages?" if ++$count > 1000; 76 | next if exists $v{$this}; 77 | next if $this eq 'main'; # %main:: is %:: 78 | 79 | #print "Peeking at $this => ${$this . '::VERSION'}\n"; 80 | no strict 'refs'; 81 | if( defined ${$this . '::VERSION'} ) { 82 | $v{$this} = ${$this . '::VERSION'} 83 | } elsif( 84 | defined *{$this . '::ISA'} or defined &{$this . '::import'} 85 | or ($this ne '' and grep defined *{$_}{'CODE'}, values %{$this . "::"}) 86 | # If it has an ISA, an import, or any subs... 87 | ) { 88 | # It's a class/module with no version. 89 | $v{$this} = undef; 90 | } else { 91 | # It's probably an unpopulated package. 92 | ## $v{$this} = '...'; 93 | } 94 | 95 | $pref = length($this) ? "$this\::" : ''; 96 | push @stack, map m/^(.+)::$/ ? "$pref$1" : (), 97 | do { no strict 'refs'; keys %{$this . '::'} }; 98 | #print "Stack: @stack\n"; 99 | } 100 | push @out, " Modules in memory:\n"; 101 | delete @v{'', '[none]'}; 102 | foreach my $p (sort {lc($a) cmp lc($b)} keys %v) { 103 | my $indent = ' ' x (2 + ($p =~ tr/:/:/)); 104 | push @out, ' ', $indent, $p, defined($v{$p}) ? " v$v{$p};\n" : ";\n"; 105 | } 106 | push @out, sprintf "[at %s (local) / %s (GMT)]\n", 107 | scalar(gmtime), scalar(localtime); 108 | my $x = join '', @out; 109 | $x =~ s/^/#/mg; 110 | print $x; 111 | } 112 | 113 | print "# Running", 114 | (chr(65) eq 'A') ? " in an ASCII world.\n" : " in a non-ASCII world.\n", 115 | "#\n", 116 | ; 117 | 118 | print "# \@INC:\n", map("# [$_]\n", @INC), "#\n#\n"; 119 | 120 | print "# \%INC:\n"; 121 | foreach my $x (sort {lc($a) cmp lc($b)} keys %INC) { 122 | print "# [$x] = [", $INC{$x} || '', "]\n"; 123 | } 124 | 125 | -------------------------------------------------------------------------------- /t/ac_d.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More tests => 12; 4 | 5 | #use Pod::Simple::Debug (6); 6 | 7 | use Pod::Simple::DumpAsXML; 8 | use Pod::Simple::XMLOutStream; 9 | 10 | $Pod::Simple::XMLOutStream::ATTR_PAD = ' '; 11 | $Pod::Simple::XMLOutStream::SORT_ATTRS = 1; # for predictably testable output 12 | 13 | $Pod::Simple::XMLOutStream::ATTR_PAD = ' '; 14 | $Pod::Simple::XMLOutStream::SORT_ATTRS = 1; # for predictably testable output 15 | 16 | my $x = 'Pod::Simple::XMLOutStream'; 17 | 18 | print "# Testing exceptions being thrown...\n"; 19 | 20 | eval { $x->new->accept_directive('head1') }; 21 | if($@) { ok 1 } # print " # Good: exception thrown: $@\n" } 22 | else { ok 0, 'No exception thrown!' } 23 | 24 | eval { $x->new->accept_directive('I like pie') }; 25 | if($@) { ok 1 } # print " # Good: exception thrown: $@\n" } 26 | else { ok 0, 'No exception thrown!' } 27 | 28 | #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 29 | # print "Testing basic directive behavior...\n"; 30 | 31 | sub Pd { shift->accept_directive_as_data( 'freepies') } 32 | sub Pv { shift->accept_directive_as_verbatim( 'freepies') } 33 | sub Pp { shift->accept_directive_as_processed('freepies') } 34 | 35 | like( $x->_out( "\n=freepies Mmmmpie\n\n") => qr/POD ERROR/ ); 36 | 37 | is( $x->_out(\&Pp, "\n=freepies Mmmmpie\n\n"), 38 | 'Mmmmpie' 39 | ); 40 | is( $x->_out(\&Pv, "\n=freepies Mmmmpie\n\n"), 41 | 'Mmmmpie' 42 | ); 43 | is( $x->_out(\&Pd, "\n=freepies Mmmmpie\n\n"), 44 | 'Mmmmpie' 45 | ); 46 | 47 | # print "Testing more complex directive behavior...\n"; 48 | 49 | is( $x->_out(\&Pp, "\n=freepies Mmmmpie \n\tI! \n\n"), 50 | 'Mmmmpie is good!' 51 | ); 52 | is( $x->_out(\&Pd, "\n=freepies Mmmmpie \n\tI! \n\n"), 53 | qq{Mmmmpie \n\tI<is good>! } 54 | ); 55 | is( $x->_out(\&Pv, "\n=freepies Mmmmpie \n\tI! \n\n"), 56 | qq{Mmmmpie \n I<is good>! } 57 | ); 58 | 59 | # print "Testing within larger documents...\n"; 60 | 61 | 62 | is( $x->_out(\&Pp, "\n=head1 NAME\n\nPie Consortium -- me gustan pasteles\n\n=freepies Mmmmpie \n\tI! \n\nGoody!"), 63 | 'NAMEPie Consortium -- me gustan pastelesMmmmpie is good!Goody!' 64 | ); 65 | is( $x->_out(\&Pd, "\n=head1 NAME\n\nPie Consortium -- me gustan pasteles\n\n=freepies Mmmmpie \n\tI! \n\nGoody!"), 66 | qq{NAMEPie Consortium -- me gustan pastelesMmmmpie \n\tI<is good>! Goody!} 67 | ); 68 | is( $x->_out(\&Pv, "\n=head1 NAME\n\nPie Consortium -- me gustan pasteles\n\n=freepies Mmmmpie \n\tI! \n\nGoody!"), 69 | qq{NAMEPie Consortium -- me gustan pastelesMmmmpie \n I<is good>! Goody!} 70 | ); 71 | -------------------------------------------------------------------------------- /t/accept01.t: -------------------------------------------------------------------------------- 1 | # Testing accept_codes 2 | use strict; 3 | use warnings; 4 | use Test::More tests => 11; 5 | 6 | #use Pod::Simple::Debug (6); 7 | 8 | use Pod::Simple::DumpAsXML; 9 | use Pod::Simple::XMLOutStream; 10 | print "# Pod::Simple version $Pod::Simple::VERSION\n"; 11 | 12 | BEGIN { 13 | require FindBin; 14 | unshift @INC, $FindBin::Bin . '/lib'; 15 | } 16 | use helpers; 17 | 18 | my $x = 'Pod::Simple::XMLOutStream'; 19 | sub accept_N { $_[0]->accept_codes('N') } 20 | 21 | print "# Some sanity tests...\n"; 22 | is( $x->_out( "=pod\n\nI like pie.\n"), # without acceptor 23 | 'I like pie.' 24 | ); 25 | is( $x->_out( \&accept_N, "=pod\n\nI like pie.\n"), 26 | 'I like pie.' 27 | ); 28 | is( $x->_out( "=pod\n\nB\n"), # without acceptor 29 | 'foo ' 30 | ); 31 | is( $x->_out( \&accept_N, "=pod\n\nB\n"), 32 | 'foo ' 33 | ); 34 | 35 | print "# Some real tests...\n"; 36 | 37 | is( $x->_out( \&accept_N, "=pod\n\nN\n"), 38 | 'foo ' 39 | ); 40 | is( $x->_out( \&accept_N, "=pod\n\nB>\n"), 41 | 'foo ' 42 | ); 43 | isnt( $x->_out( "=pod\n\nB>\n"), # without the mutor 44 | 'foo ' 45 | # make sure it DOESN'T pass thru the N<...> when not accepted 46 | ); 47 | is( $x->_out( \&accept_N, "=pod\n\nBNI>\n"), 48 | 'piezorchfoopling' 49 | ); 50 | 51 | print "# Tests of nonacceptance...\n"; 52 | 53 | sub starts_with { 54 | my($large, $small) = @_; 55 | print("# supahstring is undef\n"), 56 | return '' unless defined $large; 57 | print("# supahstring $large is smaller than target-starter $small\n"), 58 | return '' if length($large) < length($small); 59 | if( substr($large, 0, length($small)) eq $small ) { 60 | #print "# Supahstring $large\n# indeed starts with $small\n"; 61 | return 1; 62 | } else { 63 | print "# Supahstring $large\n# !starts w/ $small\n"; 64 | return ''; 65 | } 66 | } 67 | 68 | 69 | ok( starts_with( $x->_out( "=pod\n\nB>\n"), # without the mutor 70 | 'foo ' 71 | # make sure it DOESN'T pass thru the N<...>, when not accepted 72 | )); 73 | 74 | ok( starts_with( $x->_out( "=pod\n\nBNI>\n"), # !mutor 75 | 'piezorchfoopling' 76 | # make sure it DOESN'T pass thru the N<...>, when not accepted 77 | )); 78 | 79 | ok( starts_with( $x->_out( "=pod\n\nBN>I>\n"), # !mutor 80 | 'piezorchfoopling' 81 | # make sure it DOESN'T pass thru the N<...>, when not accepted 82 | )); 83 | -------------------------------------------------------------------------------- /t/ascii_order.pl: -------------------------------------------------------------------------------- 1 | # Helper for some of the .t's in this directory 2 | 3 | sub native_to_uni($) { # Convert from platform character set to Unicode 4 | # (which is the same as ASCII) 5 | my $string = shift; 6 | 7 | return $string if ord("A") == 65 8 | || "$]" < 5.007_003; # Doesn't work on early EBCDIC Perls 9 | my $output = ""; 10 | for my $i (0 .. length($string) - 1) { 11 | $output .= chr(utf8::native_to_unicode(ord(substr($string, $i, 1)))); 12 | } 13 | # Preserve utf8ness of input onto the output, even if it didn't need to be 14 | # utf8 15 | utf8::upgrade($output) if utf8::is_utf8($string); 16 | 17 | return $output; 18 | } 19 | 20 | 21 | sub ascii_order { # Sort helper. Causes the order to be the same as ASCII 22 | # no matter what the platform's character set is. 23 | return native_to_uni($a) cmp native_to_uni($b); 24 | } 25 | 26 | 1 27 | -------------------------------------------------------------------------------- /t/basic.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More tests => 29; 4 | 5 | #use Pod::Simple::Debug (6); 6 | 7 | require Pod::Simple::BlackBox; 8 | ok 1; 9 | 10 | require Pod::Simple; ok 1; 11 | 12 | Pod::Simple->VERSION(.90); ok 1; 13 | 14 | #print "# Pod::Simple version $Pod::Simple::VERSION\n"; 15 | 16 | require Pod::Simple::DumpAsXML; ok 1; 17 | 18 | require Pod::Simple::XMLOutStream; ok 1; 19 | 20 | BEGIN { 21 | require FindBin; 22 | unshift @INC, $FindBin::Bin . '/lib'; 23 | } 24 | use helpers; 25 | 26 | print "# Simple identity tests...\n"; 27 | 28 | &is( e "", "" ); 29 | &is( e "\n", "", ); 30 | &is( e "\n", "\n", ); 31 | &is( e "puppies\n\n\n\n", "", ); 32 | 33 | 34 | print "# Contentful identity tests...\n"; 35 | 36 | &is( e "=pod\n\nFoo\n", "=pod\n\nFoo\n" ); 37 | &is( e "=pod\n\n\n\nFoo\n\n\n", "=pod\n\n\n\nFoo\n\n\n" ); 38 | &is( e "=pod\n\n\n\nFoo\n\n\n", "=pod\n\nFoo\n" ); 39 | 40 | # Now with some more newlines 41 | &is( e "\n\n=pod\n\nFoo\n", "\n\n=pod\n\nFoo\n" ); 42 | &is( e "=pod\n\n\n\nFoo\n\n\n", "=pod\n\n\n\nFoo\n\n\n" ); 43 | &is( e "=pod\n\n\n\nFoo\n\n\n", "\n\n=pod\n\nFoo\n" ); 44 | 45 | 46 | &is( e "=head1 Foo\n", "=head1 Foo\n" ); 47 | &is( e "=head1 Foo\n\n=cut\n", "=head1 Foo\n\n=cut\n" ); 48 | &is( e "=head1 Foo\n\n=cut\n", "=head1 Foo\n" ); 49 | 50 | # Now just add some newlines... 51 | &is( e "\n\n\n\n=head1 Foo\n", "\n\n\n\n=head1 Foo\n" ); 52 | &is( e "=head1 Foo\n\n=cut\n", "=head1 Foo\n\n=cut\n" ); 53 | &is( e "=head1 Foo\n\n=cut\n", "\n\n\n\n=head1 Foo\n" ); 54 | 55 | 56 | print "# Simple XMLification tests...\n"; 57 | 58 | is( Pod::Simple::XMLOutStream->_out("\n\n\nprint \$^T;\n\n\n"), 59 | qq{} 60 | # make sure the contentless flag is set 61 | ); 62 | is( Pod::Simple::XMLOutStream->_out("\n\n"), 63 | qq{} 64 | # make sure the contentless flag is set 65 | ); 66 | is( Pod::Simple::XMLOutStream->_out("\n"), 67 | qq{} 68 | # make sure the contentless flag is set 69 | ); 70 | is( Pod::Simple::XMLOutStream->_out(""), 71 | qq{} 72 | # make sure the contentless flag is set 73 | ); 74 | 75 | ok( Pod::Simple::XMLOutStream->_out('', '' ) ); 76 | 77 | is( Pod::Simple::XMLOutStream->_out("=pod\n\nFoo\n"), 78 | 'Foo' 79 | ); 80 | 81 | is( Pod::Simple::XMLOutStream->_out("=head1 Chacha\n\nFoo\n"), 82 | 'ChachaFoo' 83 | ); 84 | 85 | # Make sure an obviously invalid Pod tag is invalid. 86 | is( Pod::Simple::XMLOutStream->_out("=F\0blah\n\nwhatever\n"), 87 | qq{} 88 | ); 89 | -------------------------------------------------------------------------------- /t/cbacks.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More tests => 6; 4 | 5 | my $d; 6 | #use Pod::Simple::Debug (\$d, 0); 7 | 8 | use Pod::Simple::XMLOutStream; 9 | use Pod::Simple::DumpAsXML; 10 | use Pod::Simple::DumpAsText; 11 | 12 | my @from = ( 13 | 'Pod::Simple::XMLOutStream' 14 | => 'I LIKE PIE', 15 | 16 | 'Pod::Simple::DumpAsXML' 17 | => "\n \n I LIKE PIE\n \n\n", 18 | 19 | 'Pod::Simple::DumpAsText' 20 | => "++Document\n ++head1\n * \"I LIKE PIE\"\n --head1\n--Document\n", 21 | 22 | ); 23 | 24 | 25 | # Might as well test all the classes... 26 | while(@from) { 27 | my($x => $expected) = splice(@from, 0,2); 28 | my $more = ''; 29 | print "#Testing via class $x, version ", $x->VERSION(), "\n"; 30 | my $p = $x->new; 31 | my($got, $exp); 32 | is scalar($got = $x->_out( 33 | # Mutor: 34 | sub { 35 | $_[0]->code_handler(sub { $more .= $_[1] . ":" . $_[0] . "\n" } ); 36 | $_[0]->cut_handler( sub { $more .= "~" . $_[1] . ":" . $_[0]. "\n" } ); 37 | $_[0]->pod_handler( sub { $more .= "+" . $_[1] . ":" . $_[0]. "\n" } ); 38 | $_[0]->whiteline_handler( 39 | sub { $more .= "=" . $_[1] . ":" . $_[0]. "\n" } ); 40 | } => join "\n", 41 | " ", # space outside pod 42 | "\t# This is handy...", 43 | "=pod text", 44 | "\t", # tab inside pod 45 | "=cut more text", 46 | "\t", # tab outside pod 47 | "=pod", 48 | " \t ", # spaces and tabs inside pod 49 | "=head1 I LIKE PIE", 50 | " ", # space inside pod 51 | "=cut", 52 | "use Test::Harness;", 53 | "runtests(sort glob 't/*.t');", 54 | "", 55 | "", 56 | )) 57 | => scalar($exp = $expected); 58 | ; 59 | unless($got eq $exp) { 60 | print '# Got vs exp:\n# ', Pod::Simple::BlackBox::pretty($got), 61 | "\n# ",Pod::Simple::BlackBox::pretty($exp),"\n"; 62 | } 63 | 64 | is scalar($got = $more), scalar($exp = join "\n" => 65 | "1: ", 66 | "2:\t# This is handy...", 67 | "=4:\t", 68 | "+3:=pod text", 69 | "~5:=cut more text", 70 | "6:\t", 71 | "=8: \t ", 72 | "+7:=pod", 73 | "=10: ", 74 | "~11:=cut", 75 | "12:use Test::Harness;", 76 | "13:runtests(sort glob 't/*.t');", 77 | "14:", 78 | "", 79 | ); 80 | unless($got eq $exp) { 81 | print '# Got vs exp:\n# ', Pod::Simple::BlackBox::pretty($got), 82 | "\n# ",Pod::Simple::BlackBox::pretty($exp),"\n"; 83 | } 84 | } 85 | -------------------------------------------------------------------------------- /t/chunking.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More tests => 9; 4 | 5 | #use Pod::Simple::Debug (2); 6 | 7 | BEGIN { 8 | require FindBin; 9 | unshift @INC, $FindBin::Bin . '/lib'; 10 | } 11 | use helpers; 12 | 13 | use Pod::Simple::DumpAsXML; 14 | use Pod::Simple::XMLOutStream; 15 | print "# Pod::Simple version $Pod::Simple::VERSION\n"; 16 | 17 | is( Pod::Simple::XMLOutStream->_out("=head1 =head1"), 18 | '=head1' 19 | ); 20 | 21 | is( Pod::Simple::XMLOutStream->_out("\n=head1 =head1"), 22 | '=head1' 23 | ); 24 | 25 | is( Pod::Simple::XMLOutStream->_out("\n=head1 =head1\n"), 26 | '=head1' 27 | ); 28 | 29 | is( Pod::Simple::XMLOutStream->_out("\n=head1 =head1\n\n"), 30 | '=head1' 31 | ); 32 | 33 | &is(e "\n=head1 =head1\n\n" , "\n=head1 =head1\n\n"); 34 | 35 | &is(e "\n=head1\n=head1\n\n", "\n=head1 =head1\n\n"); 36 | 37 | &is(e "\n=pod\n\nCha cha cha\n\n" , "\n=pod\n\nCha cha cha\n\n"); 38 | &is(e "\n=pod\n\nCha\tcha cha\n\n" , "\n=pod\n\nCha cha cha\n\n"); 39 | &is(e "\n=pod\n\nCha\ncha cha\n\n" , "\n=pod\n\nCha cha cha\n\n"); 40 | -------------------------------------------------------------------------------- /t/closeys.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More tests => 1; 4 | 5 | BEGIN { 6 | require FindBin; 7 | unshift @INC, $FindBin::Bin . '/lib'; 8 | } 9 | use helpers qw(f); 10 | 11 | my $d; 12 | #use Pod::Simple::Debug (\$d,0); 13 | #use Pod::Simple::Debug (10); 14 | 15 | use Pod::Simple::DumpAsXML; 16 | use Pod::Simple::XMLOutStream; 17 | print "# Pod::Simple version $Pod::Simple::VERSION\n"; 18 | 19 | sub nowhine { 20 | # $_[0]->{'no_whining'} = 1; 21 | $_[0]->accept_targets("*"); 22 | } 23 | 24 | local $Pod::Simple::XMLOutStream::SORT_ATTRS = 1; 25 | &is(f( 26 | \&nowhine, 27 | "=begin :foo\n\n=begin :bar\n\nZaz\n\n", 28 | "=begin :foo\n\n=begin :bar\n\nZaz\n\n=end :bar\n\n=end :foo\n\n", 29 | )); 30 | -------------------------------------------------------------------------------- /t/content_seen.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More tests => 2; 4 | 5 | use Pod::Simple::Text; 6 | 7 | my $p = Pod::Simple::Text->new(); 8 | $p->parse_string_document('dm+aSxLl7V3VUJFIe6CFDU13zhZ3yvjIuVkp6l//ZHcDcX014vnnh3FoElI92kFB 9 | JGFU23Vga5Tfz0Epybwio9dq1gzrZ/PIcil2MnEcUWSrIStriv4hAbf0MXcNRHOM 10 | oOV7xKU= 11 | =y6KV 12 | -----END PGP PUBLIC KEY BLOCK-----}; 13 | 14 | print $key; 15 | exit; 16 | '); 17 | 18 | # The =y6KV should not make this appear to be pod 19 | ok ! $p->content_seen; 20 | 21 | my $q = Pod::Simple::Text->new(); 22 | $q->parse_string_document('=head1 yes this is pod 23 | 24 | And this fills it in 25 | '); 26 | 27 | ok $q->content_seen; 28 | -------------------------------------------------------------------------------- /t/corpus.t: -------------------------------------------------------------------------------- 1 | # Testing a corpus of Pod files 2 | use strict; 3 | use warnings; 4 | 5 | use Test::More; 6 | BEGIN { 7 | use Config; 8 | if ($Config{extensions} !~ /\bEncode\b/) { 9 | plan skip_all => "Encode was not built"; 10 | } 11 | if (ord("A") != 65) { 12 | plan skip_all => "Encode not fully working on non-ASCII platforms at this time"; 13 | } 14 | } 15 | 16 | #use Pod::Simple::Debug (10); 17 | 18 | use File::Spec; 19 | use File::Basename (); 20 | 21 | my(@testfiles, %xmlfiles, %wouldxml); 22 | #use Pod::Simple::Debug (10); 23 | BEGIN { 24 | my $corpusdir = File::Spec->catdir(File::Basename::dirname(File::Spec->rel2abs(__FILE__)), 'corpus'); 25 | note "Corpusdir: $corpusdir"; 26 | 27 | opendir(my $indir, $corpusdir) or die "Can't opendir $corpusdir : $!"; 28 | my @f = map File::Spec::->catfile($corpusdir, $_), readdir($indir); 29 | closedir($indir); 30 | my %f; 31 | @f{@f} = (); 32 | foreach my $maybetest (sort @f) { 33 | my $xml = $maybetest; 34 | $xml =~ s/\.(txt|pod)$/\.xml/is or next; 35 | $wouldxml{$maybetest} = $xml; 36 | push @testfiles, $maybetest; 37 | foreach my $x ($xml, uc($xml), lc($xml)) { 38 | next unless exists $f{$x}; 39 | $xmlfiles{$maybetest} = $x; 40 | last; 41 | } 42 | } 43 | die "Too few test files (".@testfiles.")" unless @ARGV or @testfiles > 20; 44 | 45 | @testfiles = @ARGV if @ARGV and !grep !m/\.txt/, @ARGV; 46 | 47 | plan tests => (2*@testfiles - 1); 48 | } 49 | 50 | my $HACK = 0; 51 | # 1: write generated XML dump to *.xml_out files for debugging 52 | # 2: write generated XML to *.xml files, updating/overwriting test corpus 53 | 54 | #@testfiles = ('nonesuch.txt'); 55 | 56 | { 57 | my @x = @testfiles; 58 | note "Files to test:"; 59 | while(@x) { note " ", join(' ', splice @x,0,3); } 60 | } 61 | 62 | require Pod::Simple::DumpAsXML; 63 | 64 | 65 | foreach my $f (@testfiles) { 66 | my $xml = $xmlfiles{$f}; 67 | note ""; 68 | if($xml) { 69 | note "To test $f against $xml"; 70 | } else { 71 | note "$f has no xml to test it against"; 72 | } 73 | 74 | my $outstring; 75 | eval { 76 | my $p = Pod::Simple::DumpAsXML->new; 77 | $p->output_string( \$outstring ); 78 | $p->parse_file( $f ); 79 | undef $p; 80 | }; 81 | 82 | is $@, '', "parsed $f without error" or do { 83 | ok 0; 84 | next; 85 | }; 86 | 87 | note "generated " . length($outstring) . " bytes"; 88 | 89 | die "Null outstring?" unless $outstring; 90 | 91 | next if $f =~ /nonesuch/; 92 | 93 | my $outfilename = ($HACK > 1) ? $wouldxml{$f} : "$wouldxml{$f}\_out"; 94 | if($HACK) { 95 | open my $out, ">", $outfilename or die "Can't write-open $outfilename: $!\n"; 96 | binmode($out); 97 | print $out $outstring; 98 | close($out); 99 | } 100 | unless($xml) { 101 | note " (no comparison done)"; 102 | ok 1; 103 | next; 104 | } 105 | 106 | open(my $in, "<", $xml) or die "Can't read-open $xml: $!"; 107 | #binmode(IN); 108 | local $/; 109 | my $xmlsource = <$in>; 110 | close($in); 111 | 112 | note "There's errata!" if $outstring =~ m/start_line="-321"/; 113 | 114 | $xmlsource =~ s/[\n\r]+/\n/g; 115 | $outstring =~ s/[\n\r]+/\n/g; 116 | ok $xmlsource eq $outstring, "perfect match to $xml" or do { 117 | diag `diff $xml $outfilename` if $HACK; 118 | }; 119 | 120 | unlink $outfilename if $HACK == 1; 121 | } 122 | -------------------------------------------------------------------------------- /t/corpus/2202jp.txt: -------------------------------------------------------------------------------- 1 | 2 | 3 | =head1 NAME 4 | 5 | haiku-iso2022jp -- a test Japanese document in iso-2022-jp 6 | 7 | =head1 DESCRIPTION 8 | 9 | =encoding iso-2022-jp 10 | 11 | This is a test Pod document in ISO-2202-JP. Its content is some 12 | Japanese haiku by famous poets. 13 | 14 | 15 | =head2 MATSUO BASHO ($B>>HxGN>V(B 1644 - 1694) : 16 | 17 | $B8ECS$d3?$H$S9~$`?e$N2;(B 18 | 19 | (furuike ya / kawazu tobikomu / mizu no oto) 20 | 21 | As verbatim: 22 | 23 | $B8ECS$d3?$H$S9~$`?e$N2;(B 24 | 25 | 26 | 27 | =head2 YOSA BUSON ($BM?L?$$$/$P$/$+$"$kLkC;$7(B 48 | 49 | (yomei / ikubakuka aru / yo mijikashi) 50 | 51 | $BM>L?$$$/$P$/$+$"$kLkC;$7(B 52 | 53 | =head1 AS A LIST 54 | 55 | =over 56 | 57 | =item MATSUO BASHO ($B>>HxGN>V(B 1644 - 1694) : 58 | 59 | $B8ECS$d3?$H$S9~$`?e$N2;(B 60 | 61 | (furuike ya / kawazu tobikomu / mizu no oto) 62 | 63 | As verbatim: 64 | 65 | $B8ECS$d3?$H$S9~$`?e$N2;(B 66 | 67 | 68 | 69 | =item YOSA BUSON ($BM?L?$$$/$P$/$+$"$kLkC;$7(B 90 | 91 | (yomei / ikubakuka aru / yo mijikashi) 92 | 93 | $BM>L?$$$/$P$/$+$"$kLkC;$7(B 94 | 95 | =back 96 | 97 | [end] 98 | 99 | =cut 100 | 101 | 102 | -------------------------------------------------------------------------------- /t/corpus/2202jpx.txt: -------------------------------------------------------------------------------- 1 | 2 | 3 | =head1 NAME 4 | 5 | haiku-iso2022jp -- a test Japanese document in iso-2022-jp 6 | 7 | =head1 DESCRIPTION 8 | 9 | =encoding iso-2022-jp 10 | 11 | This is a test Pod document in ISO-2202-JP. Its content is some 12 | Japanese haiku by famous poets. 13 | 14 | 15 | =head2 MATSUO BASHO ($B>>HxGN>V(B 1644 - 1694) : 16 | 17 | $B8ECS$d3?$H$S9~$`?e$N2;(B 18 | 19 | (furuike ya / kawazu tobikomu / mizu no oto) 20 | 21 | As verbatim: 22 | 23 | $B8ECS$d3?$H$S9~$`?e$N2;(B 24 | 25 | 26 | 27 | =head2 YOSA BUSON ($BM?L?$$$/$P$/$+$"$kLkC;$7(B 48 | 49 | (yomei / ikubakuka aru / yo mijikashi) 50 | 51 | $BM>L?$$$/$P$/$+$"$kLkC;$7(B 52 | 53 | =head1 AS A LIST 54 | 55 | =over 56 | 57 | =item MATSUO BASHO ($B>>HxGN>V(B 1644 - 1694) : 58 | 59 | $B8ECS$d3?$H$S9~$`?e$N2;(B 60 | 61 | (furuike ya / kawazu tobikomu / mizu no oto) 62 | 63 | As verbatim: 64 | 65 | $B8ECS$d3?$H$S9~$`?e$N2;(B 66 | 67 | 68 | 69 | =item YOSA BUSON ($BM?L?$$$/$P$/$+$"$kLkC;$7(B 90 | 91 | (yomei / ikubakuka aru / yo mijikashi) 92 | 93 | $BM>L?$$$/$P$/$+$"$kLkC;$7(B 94 | 95 | =back 96 | 97 | .end. 98 | 99 | =cut 100 | 101 | 102 | -------------------------------------------------------------------------------- /t/corpus/2202jpy.txt: -------------------------------------------------------------------------------- 1 | 2 | =head1 NAME 3 | 4 | haiku-iso2022jp -- a test Japanese document in iso-2022-jp 5 | 6 | =head1 DESCRIPTION 7 | 8 | =encoding iso-2022-jp 9 | 10 | This is a test Pod document in ISO-2202-JP. Its content is some 11 | Japanese haiku by famous poets. 12 | 13 | 14 | =head2 MATSUO BASHO ($B>>HxGN>V(B 1644 - 1694) : 15 | 16 | $B8ECS$d3?$H$S9~$`?e$N2;(B 17 | 18 | (furuike ya / kawazu tobikomu / mizu no oto) 19 | 20 | As verbatim: 21 | 22 | $B8ECS$d3?$H$S9~$`?e$N2;(B 23 | 24 | 25 | 26 | =head2 YOSA BUSON ($BM?L?$$$/$P$/$+$"$kLkC;$7(B 47 | 48 | (yomei / ikubakuka aru / yo mijikashi) 49 | 50 | $BM>L?$$$/$P$/$+$"$kLkC;$7(B 51 | 52 | =head1 AS A LIST 53 | 54 | =over 55 | 56 | =item MATSUO BASHO ($B>>HxGN>V(B 1644 - 1694) : 57 | 58 | $B8ECS$d3?$H$S9~$`?e$N2;(B 59 | 60 | (furuike ya / kawazu tobikomu / mizu no oto) 61 | 62 | As verbatim: 63 | 64 | $B8ECS$d3?$H$S9~$`?e$N2;(B 65 | 66 | 67 | 68 | =item YOSA BUSON ($BM?L?$$$/$P$/$+$"$kLkC;$7(B 89 | 90 | (yomei / ikubakuka aru / yo mijikashi) 91 | 92 | $BM>L?$$$/$P$/$+$"$kLkC;$7(B 93 | 94 | =back 95 | 96 | "end" 97 | 98 | =cut 99 | 100 | 101 | 102 | -------------------------------------------------------------------------------- /t/corpus/2202jpz.txt: -------------------------------------------------------------------------------- 1 | 2 | =head1 NAME 3 | 4 | haiku-iso2022jp -- a test Japanese document in iso-2022-jp 5 | 6 | =head1 DESCRIPTION 7 | 8 | =encoding iso-2022-jp 9 | 10 | This is a test Pod document in ISO-2202-JP. 11 | 12 | =cut 13 | 14 | 15 | -------------------------------------------------------------------------------- /t/corpus/2202jpz.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | NAME 4 | 5 | 6 | haiku-iso2022jp -- a test Japanese document in iso-2022-jp 7 | 8 | 9 | DESCRIPTION 10 | 11 | 12 | iso-2022-jp 13 | 14 | 15 | This is a test Pod document in ISO-2202-JP. 16 | 17 | 18 | -------------------------------------------------------------------------------- /t/corpus/8859_7.pod: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/perl-pod/pod-simple/00192234381dec835a16bc4ec786266ed0f0690b/t/corpus/8859_7.pod -------------------------------------------------------------------------------- /t/corpus/8859_7.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | iso-8859-7 4 | 5 | 6 | NAME 7 | 8 | 9 | Ολυμπιακός 10 | Ύμνος -- Κωστής 11 | Παλαμάς 12 | 13 | 14 | DESCRIPTION 15 | 16 | 17 | Αρχαίο Πνεύμ' 18 | αθάνατον, 19 | αγνέ πατέρα 20 | του ωραίου, 21 | του μεγάλου 22 | και τ' 23 | αληθινού, 24 | 25 | 26 | κατέβα, 27 | φανερώσου κι 28 | άστραψ' εδώ 29 | πέρα στη δόξα 30 | της δικής σου 31 | γης και τ' 32 | ουρανού. 33 | 34 | 35 | Στο δρόμο και 36 | στο πάλεμα 37 | και στο 38 | λιθάρι, στων 39 | ευγενών 40 | Αγώνων λάμψε 41 | την ορμή, 42 | 43 | 44 | και με τ' 45 | αμάραντο 46 | στεφάνωσε 47 | κλωνάρι και 48 | σιδερένιο 49 | πλάσε κι άξιο 50 | το κορμί. 51 | 52 | 53 | Κάμποι, βουνά 54 | και πέλαγα 55 | φέγγουν μαζί 56 | σου σαν ένας 57 | λευκοπόρφυρος 58 | μέγας ναός, 59 | 60 | 61 | και τρέχει στο 62 | ναό εδώ 63 | προσκυνητής 64 | σου. Αρχαίο 65 | Πνεύμ' 66 | αθάνατο, κάθε 67 | λαός. 68 | 69 | 70 | -------------------------------------------------------------------------------- /t/corpus/cp1256.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/perl-pod/pod-simple/00192234381dec835a16bc4ec786266ed0f0690b/t/corpus/cp1256.txt -------------------------------------------------------------------------------- /t/corpus/enc_char_directive.txt: -------------------------------------------------------------------------------- 1 | 2 | =head1 NAME 3 | 4 | Implicit Encoding with Warning and encoding directive in UTF-8 5 | 6 | =head2 DESCRIPTION 7 | 8 | This line should warn that the price €9.99 contains a non-ASCII character. 9 | 10 | =encoding utf8 11 | 12 | And château should not generate a warning. 13 | 14 | -------------------------------------------------------------------------------- /t/corpus/enc_char_directive.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | NAME 4 | 5 | 6 | Implicit Encoding with Warning and encoding directive in UTF-8 7 | 8 | 9 | DESCRIPTION 10 | 11 | 12 | This line should warn that the price €9.99 contains a non-ASCII 13 | character. 14 | 15 | 16 | utf8 17 | 18 | 19 | And château should not generate a warning. 20 | 21 | 22 | POD ERRORS 23 | 24 | 25 | Hey! 26 | 27 | The above document had some coding errors, which are explained below: 28 | 29 | 30 | 31 | 32 | Around line 8: 33 | 34 | 35 | Non-ASCII character seen before =encoding in '€9.99'. 36 | Assuming UTF-8 37 | 38 | 39 | 40 | -------------------------------------------------------------------------------- /t/corpus/enc_char_wrong_directive.txt: -------------------------------------------------------------------------------- 1 | 2 | =head1 NAME 3 | 4 | Implicit Encoding with Warning in UTF8 and wrong encoding directive iso-8859-1 5 | 6 | =head2 DESCRIPTION 7 | 8 | This line should warn that the price €9.99 contains a non-ASCII character. 9 | 10 | =encoding iso-8859-1 11 | 12 | And château should not generate a warning. 13 | 14 | -------------------------------------------------------------------------------- /t/corpus/enc_char_wrong_directive.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | NAME 4 | 5 | 6 | Implicit Encoding with Warning in UTF8 and wrong encoding directive 7 | iso-8859-1 8 | 9 | 10 | DESCRIPTION 11 | 12 | 13 | This line should warn that the price €9.99 contains a non-ASCII 14 | character. 15 | 16 | 17 | iso-8859-1 18 | 19 | 20 | And château should not generate a warning. 21 | 22 | 23 | POD ERRORS 24 | 25 | 26 | Hey! 27 | 28 | The above document had some coding errors, which are explained below: 29 | 30 | 31 | 32 | 33 | Around line 8: 34 | 35 | 36 | Non-ASCII character seen before =encoding in '€9.99'. 37 | Assuming UTF-8 38 | 39 | 40 | Around line 10: 41 | 42 | 43 | Couldn't do =encoding iso-8859-1: Encoding is already set to UTF-8 44 | 45 | 46 | 47 | -------------------------------------------------------------------------------- /t/corpus/encwarn01.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/perl-pod/pod-simple/00192234381dec835a16bc4ec786266ed0f0690b/t/corpus/encwarn01.txt -------------------------------------------------------------------------------- /t/corpus/encwarn01.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | NAME 4 | 5 | 6 | Encoding Warning 1 - implicitly Latin-1 7 | 8 | 9 | DESCRIPTION 10 | 11 | 12 | This line should warn that the word café contains a non-ASCII 13 | character. 14 | 15 | 16 | But château should not generate a warning - once is enough. 17 | 18 | 19 | POD ERRORS 20 | 21 | 22 | Hey! 23 | 24 | The above document had some coding errors, which are explained below: 25 | 26 | 27 | 28 | 29 | Around line 8: 30 | 31 | 32 | Non-ASCII character seen before =encoding in 'café'. Assuming 33 | CP1252 34 | 35 | 36 | 37 | -------------------------------------------------------------------------------- /t/corpus/encwarn02.txt: -------------------------------------------------------------------------------- 1 | 2 | =head1 NAME 3 | 4 | Encoding Warning 1 - implicitly UTF-8 5 | 6 | =head2 DESCRIPTION 7 | 8 | This line should warn that the price €9.99 contains a non-ASCII character. 9 | 10 | But château should not generate a warning - once is enough. 11 | 12 | -------------------------------------------------------------------------------- /t/corpus/encwarn02.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | NAME 4 | 5 | 6 | Encoding Warning 1 - implicitly UTF-8 7 | 8 | 9 | DESCRIPTION 10 | 11 | 12 | This line should warn that the price €9.99 contains a non-ASCII 13 | character. 14 | 15 | 16 | But château should not generate a warning - once is enough. 17 | 18 | 19 | POD ERRORS 20 | 21 | 22 | Hey! 23 | 24 | The above document had some coding errors, which are explained below: 25 | 26 | 27 | 28 | 29 | Around line 8: 30 | 31 | 32 | Non-ASCII character seen before =encoding in '€9.99'. 33 | Assuming UTF-8 34 | 35 | 36 | 37 | -------------------------------------------------------------------------------- /t/corpus/encwarn03.txt: -------------------------------------------------------------------------------- 1 | package MyPackage; 2 | 3 | use strict; 4 | 5 | # Comment here contains āccénted characters but should not generate any 6 | # parse warning since they do not occur in a POD section 7 | 8 | sub main { 9 | print "This file contains no POD\n"; 10 | } 11 | 12 | 1; 13 | -------------------------------------------------------------------------------- /t/corpus/encwarn03.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | -------------------------------------------------------------------------------- /t/corpus/encwarn04.txt: -------------------------------------------------------------------------------- 1 | package MyPackage; 2 | 3 | use strict; 4 | 5 | # Checking encoding warning is generated even on first line of POD 6 | 7 | sub main { 8 | print "This file contains no POD\n"; 9 | } 10 | 11 | 1; 12 | 13 | =head1 TŨTORIAL 14 | 15 | The encoding warning should only fire when the parser is 'in_pod' but that 16 | should also be true on the first line of POD (above). 17 | 18 | -------------------------------------------------------------------------------- /t/corpus/encwarn04.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | TŨTORIAL 4 | 5 | 6 | The encoding warning should only fire when the parser is 'in_pod' 7 | but that should also be true on the first line of POD (above). 8 | 9 | 10 | POD ERRORS 11 | 12 | 13 | Hey! 14 | 15 | The above document had some coding errors, which are explained below: 16 | 17 | 18 | 19 | 20 | Around line 13: 21 | 22 | 23 | Non-ASCII character seen before =encoding in 'TŨTORIAL'. 24 | Assuming UTF-8 25 | 26 | 27 | 28 | -------------------------------------------------------------------------------- /t/corpus/fet_cont.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/perl-pod/pod-simple/00192234381dec835a16bc4ec786266ed0f0690b/t/corpus/fet_cont.txt -------------------------------------------------------------------------------- /t/corpus/fet_cont.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | koi8-r 4 | 5 | 6 | NAME 7 | 8 | 9 | Когда 10 | читала ты 11 | мучительные 12 | строки -- Fet's "When you 13 | were reading" 14 | 15 | 16 | TEXT 17 | 18 | 19 | Shift-JIS 20 | 21 | 22 | (This is a test Pod pocument in KOI8-R.) 23 | 24 | 25 | 15 февраля 1887 26 | 27 | 28 | [end] 29 | 30 | 31 | POD ERRORS 32 | 33 | 34 | Hey! 35 | 36 | The above document had some coding errors, which are explained below: 37 | 38 | 39 | 40 | 41 | Around line 13: 42 | 43 | 44 | Couldn't do =encoding Shift-JIS: Encoding is already set to koi8-r 45 | 46 | 47 | 48 | -------------------------------------------------------------------------------- /t/corpus/fet_dup.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/perl-pod/pod-simple/00192234381dec835a16bc4ec786266ed0f0690b/t/corpus/fet_dup.txt -------------------------------------------------------------------------------- /t/corpus/iso6.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/perl-pod/pod-simple/00192234381dec835a16bc4ec786266ed0f0690b/t/corpus/iso6.txt -------------------------------------------------------------------------------- /t/corpus/koi8r.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/perl-pod/pod-simple/00192234381dec835a16bc4ec786266ed0f0690b/t/corpus/koi8r.txt -------------------------------------------------------------------------------- /t/corpus/laozi38.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/perl-pod/pod-simple/00192234381dec835a16bc4ec786266ed0f0690b/t/corpus/laozi38.txt -------------------------------------------------------------------------------- /t/corpus/laozi38.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | big5 4 | 5 | 6 | 老子道德經 三十八章 7 | -- Big5 (Chinese) encoding test 8 | 9 | 10 | 上德不德，是以有德﹔ 11 | 下德不失德，是以無德。 12 | 上德無為而無以為﹔ 13 | 下德無為而有以為。 14 | 上仁為之而無以為﹔ 15 | 上義為之而有以為。 16 | 上禮為之而莫之應，則攘臂而扔之。 17 | 18 | 19 | 故失道而后德，失德而后仁，失仁而后義，失義而后禮。夫禮者，忠信之薄，而亂之首。 20 | 前識者，道之華，而愚之始。 21 | 是以大丈夫居其厚，不居其薄﹔居其實，不居其華。 22 | 故去彼取此。 23 | 24 | 25 | And as a verbatim section: 26 | 27 | 28 | 29 | 上德不德，是以有德﹔ 30 | 31 | 下德不失德，是以無德。 32 | 33 | 上德無為而無以為﹔ 34 | 35 | 下德無為而有以為。 36 | 37 | 上仁為之而無以為﹔ 38 | 39 | 上義為之而有以為。 40 | 41 | 上禮為之而莫之應，則攘臂而扔之。 42 | 43 | 44 | 故失道而后德，失德而后仁，失仁而后義，失義而后禮。夫禮者，忠信之薄，而亂之首。 45 | 46 | 前識者，道之華，而愚之始。 47 | 48 | 是以大丈夫居其厚，不居其薄﹔居其實，不居其華。 49 | 故去彼取此。 50 | 51 | 52 | [end] 53 | 54 | 55 | -------------------------------------------------------------------------------- /t/corpus/laozi38b.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/perl-pod/pod-simple/00192234381dec835a16bc4ec786266ed0f0690b/t/corpus/laozi38b.txt -------------------------------------------------------------------------------- /t/corpus/laozi38b.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | big5-eten 4 | 5 | 6 | 老子道德經 三十八章 7 | -- Big5 (Chinese) encoding test 8 | 9 | 10 | 上德不德，是以有德﹔ 11 | 下德不失德，是以無德。 12 | 上德無為而無以為﹔ 13 | 下德無為而有以為。 14 | 上仁為之而無以為﹔ 15 | 上義為之而有以為。 16 | 上禮為之而莫之應，則攘臂而扔之。 17 | 18 | 19 | 故失道而后德，失德而后仁，失仁而后義，失義而后禮。夫禮者，忠信之薄，而亂之首。 20 | 前識者，道之華，而愚之始。 21 | 是以大丈夫居其厚，不居其薄﹔居其實，不居其華。 22 | 故去彼取此。 23 | 24 | 25 | And as a verbatim section: 26 | 27 | 28 | 29 | 上德不德，是以有德﹔ 30 | 31 | 下德不失德，是以無德。 32 | 33 | 上德無為而無以為﹔ 34 | 35 | 下德無為而有以為。 36 | 37 | 上仁為之而無以為﹔ 38 | 39 | 上義為之而有以為。 40 | 41 | 上禮為之而莫之應，則攘臂而扔之。 42 | 43 | 44 | 故失道而后德，失德而后仁，失仁而后義，失義而后禮。夫禮者，忠信之薄，而亂之首。 45 | 46 | 前識者，道之華，而愚之始。 47 | 48 | 是以大丈夫居其厚，不居其薄﹔居其實，不居其華。 49 | 故去彼取此。 50 | 51 | 52 | [end] 53 | 54 | 55 | -------------------------------------------------------------------------------- /t/corpus/laozi38p.pod: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/perl-pod/pod-simple/00192234381dec835a16bc4ec786266ed0f0690b/t/corpus/laozi38p.pod -------------------------------------------------------------------------------- /t/corpus/laozi38p.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | big5 4 | 5 | 6 | NAME 7 | 8 | 9 | 老子道德經 三十八章 10 | -- Big5 (Chinese) encoding test 11 | 12 | 13 | DESCRIPTION 14 | 15 | 16 | This is a test Pod document in the Big5 encoding. Its content is the 38th 17 | canto from the 18 | 19 | Dao De Jing 20 | 21 | . 22 | 23 | 24 | 老子道德經 三十八章 25 | 26 | 27 | 上德不德，是以有德﹔ 28 | 下德不失德，是以無德。 29 | 上德無為而無以為﹔ 30 | 下德無為而有以為。 31 | 上仁為之而無以為﹔ 32 | 上義為之而有以為。 33 | 上禮為之而莫之應，則攘臂而扔之。 34 | 35 | 36 | 故失道而后德，失德而后仁，失仁而后義，失義而后禮。夫禮者，忠信之薄，而亂之首。 37 | 前識者，道之華，而愚之始。 38 | 是以大丈夫居其厚，不居其薄﹔居其實，不居其華。 39 | 故去彼取此。 40 | 41 | 42 | And as a verbatim section: 43 | 44 | 45 | 46 | 上德不德，是以有德﹔ 47 | 48 | 下德不失德，是以無德。 49 | 50 | 上德無為而無以為﹔ 51 | 52 | 下德無為而有以為。 53 | 54 | 上仁為之而無以為﹔ 55 | 56 | 上義為之而有以為。 57 | 58 | 上禮為之而莫之應，則攘臂而扔之。 59 | 60 | 61 | 故失道而后德，失德而后仁，失仁而后義，失義而后禮。夫禮者，忠信之薄，而亂之首。 62 | 63 | 前識者，道之華，而愚之始。 64 | 65 | 是以大丈夫居其厚，不居其薄﹔居其實，不居其華。 66 | 故去彼取此。 67 | 68 | 69 | [end] 70 | 71 | 72 | -------------------------------------------------------------------------------- /t/corpus/lat1fr.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/perl-pod/pod-simple/00192234381dec835a16bc4ec786266ed0f0690b/t/corpus/lat1fr.txt -------------------------------------------------------------------------------- /t/corpus/lat1fr.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | iso-8859-1 4 | 5 | 6 | NAME 7 | 8 | 9 | French-Latin-1 -- explicitly Latin-1 test document in French 10 | 11 | 12 | DESCRIPTION 13 | 14 | 15 | This is a test Pod document in Latin-1. Its content is the last two 16 | paragraphs of Baudelaire's 17 | 18 | Le Joujou du pauvre 19 | 20 | . 21 | 22 | 23 | A travers ces barreaux symboliques séparant deux mondes, la grande 24 | route et le château, l'enfant pauvre montrait à 25 | l'enfant riche son propre joujou, que celui-ci examinait avidement 26 | comme un objet rare et inconnu. Or, ce joujou, que le petit souillon 27 | agaçait, agitait et secouait dans une boîte grillée, 28 | c'était un rat vivant ! Les parents, par économie 29 | sans doute, avaient tiré le joujou de la vie elle-même. 30 | 31 | 32 | Et les deux enfants se riaient l'un à l'autre fraternellement, 33 | avec des dents d'une 34 | 35 | égale 36 | 37 | blancheur. 38 | 39 | 40 | As Verbatim 41 | 42 | 43 | A travers ces barreaux symboliques séparant deux mondes, la grande 44 | route 45 | et le château, l'enfant pauvre montrait à l'enfant 46 | riche son propre 47 | joujou, que celui-ci examinait avidement comme un objet rare et 48 | inconnu. 49 | Or, ce joujou, que le petit souillon agaçait, agitait et secouait 50 | dans 51 | une boîte grillée, c'était un rat vivant ! 52 | Les parents, par économie 53 | sans doute, avaient tiré le joujou de la vie elle-même. 54 | 55 | Et les deux enfants se riaient l'un à l'autre 56 | fraternellement, avec des 57 | dents d'une égale blancheur. 58 | 59 | 60 | [end] 61 | 62 | 63 | -------------------------------------------------------------------------------- /t/corpus/lat1frim.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/perl-pod/pod-simple/00192234381dec835a16bc4ec786266ed0f0690b/t/corpus/lat1frim.txt -------------------------------------------------------------------------------- /t/corpus/lat1frim.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | NAME 4 | 5 | 6 | French-Latin-1 -- implicitly Latin-1 test document in French 7 | 8 | 9 | DESCRIPTION 10 | 11 | 12 | This is a test Pod document in Latin-1. Its content is the last two 13 | paragraphs of Baudelaire's 14 | 15 | Le Joujou du pauvre 16 | 17 | . 18 | 19 | 20 | A travers ces barreaux symboliques séparant deux mondes, la grande 21 | route et le château, l'enfant pauvre montrait à 22 | l'enfant riche son propre joujou, que celui-ci examinait avidement 23 | comme un objet rare et inconnu. Or, ce joujou, que le petit souillon 24 | agaçait, agitait et secouait dans une boîte grillée, 25 | c'était un rat vivant ! Les parents, par économie 26 | sans doute, avaient tiré le joujou de la vie elle-même. 27 | 28 | 29 | Et les deux enfants se riaient l'un à l'autre fraternellement, 30 | avec des dents d'une 31 | 32 | égale 33 | 34 | blancheur. 35 | 36 | 37 | As Verbatim 38 | 39 | 40 | A travers ces barreaux symboliques séparant deux mondes, la grande 41 | route 42 | et le château, l'enfant pauvre montrait à l'enfant 43 | riche son propre 44 | joujou, que celui-ci examinait avidement comme un objet rare et 45 | inconnu. 46 | Or, ce joujou, que le petit souillon agaçait, agitait et secouait 47 | dans 48 | une boîte grillée, c'était un rat vivant ! 49 | Les parents, par économie 50 | sans doute, avaient tiré le joujou de la vie elle-même. 51 | 52 | Et les deux enfants se riaient l'un à l'autre 53 | fraternellement, avec des 54 | dents d'une égale blancheur. 55 | 56 | 57 | [end] 58 | 59 | 60 | POD ERRORS 61 | 62 | 63 | Hey! 64 | 65 | The above document had some coding errors, which are explained below: 66 | 67 | 68 | 69 | 70 | Around line 11: 71 | 72 | 73 | Non-ASCII character seen before =encoding in 'séparant'. 74 | Assuming CP1252 75 | 76 | 77 | 78 | -------------------------------------------------------------------------------- /t/corpus/nonesuch.txt: -------------------------------------------------------------------------------- 1 | =encoding blorpy 2 | 3 | =head1 nonesuch -- Document in an unknown encoding 4 | 5 | Blorp. 6 | 7 | [end] 8 | 9 | =cut 10 | 11 | 12 | -------------------------------------------------------------------------------- /t/corpus/nonesuch.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | nonesuch -- Document in an unknown encoding 4 | 5 | 6 | Blorp. 7 | 8 | 9 | [end] 10 | 11 | 12 | POD ERRORS 13 | 14 | 15 | Hey! 16 | 17 | The above document had some coding errors, which are explained 18 | below: 19 | 20 | 21 | 22 | 23 | Around line 1: 24 | 25 | 26 | This document probably does not appear as it should, because 27 | its "=encoding blorpy" line calls for an unsupported 28 | encoding. [Encode.pm v1.98's supported encodings are: 29 | 7bit-jis AdobeStandardEncoding AdobeSymbol AdobeZdingbat 30 | ascii ascii-ctrl big5-eten big5-hkscs cp1006 cp1026 cp1047 31 | cp1250 cp1251 cp1252 cp1253 cp1254 cp1255 cp1256 cp1257 32 | cp1258 cp37 cp424 cp437 cp500 cp737 cp775 cp850 cp852 cp855 33 | cp856 cp857 cp860 cp861 cp862 cp863 cp864 cp865 cp866 cp869 34 | cp874 cp875 cp932 cp936 cp949 cp950 dingbats euc-cn euc-jp 35 | euc-kr gb12345-raw gb2312-raw gsm0338 hp-roman8 hz iso-2022-jp 36 | iso-2022-jp-1 iso-2022-kr iso-8859-1 iso-8859-10 iso-8859-11 37 | iso-8859-13 iso-8859-14 iso-8859-15 iso-8859-16 iso-8859-2 38 | iso-8859-3 iso-8859-4 iso-8859-5 iso-8859-6 iso-8859-7 iso-8859-8 39 | iso-8859-9 iso-ir-165 jis0201-raw jis0208-raw jis0212-raw 40 | johab koi8-f koi8-r koi8-u ksc5601-raw MacArabic MacCentralEurRoman 41 | MacChineseSimp MacChineseTrad MacCroatian MacCyrillic MacDingbats 42 | MacFarsi MacGreek MacHebrew MacIcelandic MacJapanese MacKorean 43 | MacRoman MacRomanian MacRumanian MacSami MacSymbol MacThai 44 | MacTurkish MacUkrainian MIME-B MIME-Header MIME-Q nextstep 45 | null posix-bc shiftjis symbol UCS-2BE UCS-2LE UTF-16 UTF-16BE 46 | UTF-16LE UTF-32 UTF-32BE UTF-32LE UTF-7 utf8 viscii] 47 | 48 | 49 | 50 | -------------------------------------------------------------------------------- /t/corpus/pasternak_cp1251.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/perl-pod/pod-simple/00192234381dec835a16bc4ec786266ed0f0690b/t/corpus/pasternak_cp1251.txt -------------------------------------------------------------------------------- /t/corpus/plain.txt: -------------------------------------------------------------------------------- 1 | 2 | =head1 NAME 3 | 4 | simple_text_document -- an implicitly US-ASCII test document. 5 | 6 | =head1 TEXT 7 | 8 | The quick brown fox jumps over the lazy dog. 9 | 10 | Military Intelligence Yukon rhosts penrep Weekly World News DSD Time 11 | Cohiba finks rail gun DF ~ Corporate Security NATOA CCS DEVGRP 12 | 13 | CONUS Khaddafi NATIA data havens Spetznaz afsatcom BOP Semtex garbage 14 | KGB ^? 737 1080H 1080H Satellite imagery smuggle 15 | 16 | [end] 17 | 18 | =cut 19 | 20 | 21 | -------------------------------------------------------------------------------- /t/corpus/plain.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | NAME 4 | 5 | 6 | simple_text_document -- an implicitly US-ASCII test document. 7 | 8 | 9 | TEXT 10 | 11 | 12 | The quick brown fox jumps over the lazy dog. 13 | 14 | 15 | Military Intelligence Yukon rhosts penrep Weekly World News DSD Time Cohiba 16 | finks rail gun DF ~ Corporate Security NATOA CCS DEVGRP 17 | 18 | 19 | CONUS Khaddafi NATIA data havens Spetznaz afsatcom BOP Semtex garbage KGB 20 | ^? 737 1080H 1080H Satellite imagery smuggle 21 | 22 | 23 | [end] 24 | 25 | 26 | -------------------------------------------------------------------------------- /t/corpus/plain_explicit.txt: -------------------------------------------------------------------------------- 1 | 2 | =encoding ascii 3 | 4 | =head1 NAME 5 | 6 | simple_text_document -- an explicitly US-ASCII test document. 7 | 8 | =head1 TEXT 9 | 10 | The quick brown fox jumps over the lazy dog. 11 | 12 | Military Intelligence Yukon rhosts penrep Weekly World News DSD Time 13 | Cohiba finks rail gun DF ~ Corporate Security NATOA CCS DEVGRP 14 | 15 | CONUS Khaddafi NATIA data havens Spetznaz afsatcom BOP Semtex garbage 16 | KGB ^? 737 1080H 1080H Satellite imagery smuggle 17 | 18 | [end] 19 | 20 | =cut 21 | 22 | 23 | -------------------------------------------------------------------------------- /t/corpus/plain_explicit.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | ascii 4 | 5 | 6 | NAME 7 | 8 | 9 | simple_text_document -- an explicitly US-ASCII test document. 10 | 11 | 12 | TEXT 13 | 14 | 15 | The quick brown fox jumps over the lazy dog. 16 | 17 | 18 | Military Intelligence Yukon rhosts penrep Weekly World News DSD Time Cohiba 19 | finks rail gun DF ~ Corporate Security NATOA CCS DEVGRP 20 | 21 | 22 | CONUS Khaddafi NATIA data havens Spetznaz afsatcom BOP Semtex garbage KGB 23 | ^? 737 1080H 1080H Satellite imagery smuggle 24 | 25 | 26 | [end] 27 | 28 | 29 | -------------------------------------------------------------------------------- /t/corpus/plain_latin1.txt: -------------------------------------------------------------------------------- 1 | 2 | #Doesn't actually use any of the Latin-1 bytes. 3 | 4 | =encoding iso-8859-1 5 | 6 | =head1 NAME 7 | 8 | simple_text_document -- an explicitly Latin-1 (ASCII subset) test document 9 | 10 | =head1 TEXT 11 | 12 | The quick brown fox jumps over the lazy dog. 13 | 14 | Military Intelligence Yukon rhosts penrep Weekly World News DSD Time 15 | Cohiba finks rail gun DF ~ Corporate Security NATOA CCS DEVGRP 16 | 17 | CONUS Khaddafi NATIA data havens Spetznaz afsatcom BOP Semtex garbage 18 | KGB ^? 737 1080H 1080H Satellite imagery smuggle 19 | 20 | [end] 21 | 22 | =cut 23 | 24 | 25 | -------------------------------------------------------------------------------- /t/corpus/plain_latin1.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | iso-8859-1 4 | 5 | 6 | NAME 7 | 8 | 9 | simple_text_document -- an explicitly Latin-1 (ASCII subset) test document 10 | 11 | 12 | TEXT 13 | 14 | 15 | The quick brown fox jumps over the lazy dog. 16 | 17 | 18 | Military Intelligence Yukon rhosts penrep Weekly World News DSD Time Cohiba 19 | finks rail gun DF ~ Corporate Security NATOA CCS DEVGRP 20 | 21 | 22 | CONUS Khaddafi NATIA data havens Spetznaz afsatcom BOP Semtex garbage KGB 23 | ^? 737 1080H 1080H Satellite imagery smuggle 24 | 25 | 26 | [end] 27 | 28 | 29 | -------------------------------------------------------------------------------- /t/corpus/plain_utf8.txt: -------------------------------------------------------------------------------- 1 | 2 | #Doesn't actually use any of the utf8 bytes. 3 | 4 | =encoding utf8 5 | 6 | =head1 NAME 7 | 8 | simple_text_document -- an explicitly UTF8 (ASCII subset) test document 9 | 10 | =head1 TEXT 11 | 12 | The quick brown fox jumps over the lazy dog. 13 | 14 | Military Intelligence Yukon rhosts penrep Weekly World News DSD Time 15 | Cohiba finks rail gun DF ~ Corporate Security NATOA CCS DEVGRP 16 | 17 | CONUS Khaddafi NATIA data havens Spetznaz afsatcom BOP Semtex garbage 18 | KGB ^? 737 1080H 1080H Satellite imagery smuggle 19 | 20 | [end] 21 | 22 | =cut 23 | 24 | 25 | -------------------------------------------------------------------------------- /t/corpus/plain_utf8.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | utf8 4 | 5 | 6 | NAME 7 | 8 | 9 | simple_text_document -- an explicitly UTF8 (ASCII subset) test document 10 | 11 | 12 | TEXT 13 | 14 | 15 | The quick brown fox jumps over the lazy dog. 16 | 17 | 18 | Military Intelligence Yukon rhosts penrep Weekly World News DSD Time Cohiba 19 | finks rail gun DF ~ Corporate Security NATOA CCS DEVGRP 20 | 21 | 22 | CONUS Khaddafi NATIA data havens Spetznaz afsatcom BOP Semtex garbage KGB 23 | ^? 737 1080H 1080H Satellite imagery smuggle 24 | 25 | 26 | [end] 27 | 28 | 29 | -------------------------------------------------------------------------------- /t/corpus/polish_utf8.txt: -------------------------------------------------------------------------------- 1 | 2 | =encoding utf8 3 | 4 | =head1 NAME 5 | 6 | WŚRÓD NOCNEJ CISZY -- explicitly utf8 test document in Polish 7 | 8 | =head1 DESCRIPTION 9 | 10 | This is a test Pod document in UTF8. Its content is the lyrics to 11 | the Polish Christmas carol "Wśród nocnej ciszy", except it includes 12 | a few lines to test RTF specially. 13 | 14 | ff is a character in the upper half of Plane 0, so should be negative in RTF 15 | 𝔸 is a character in Plane 1, so should be expressed as a surrogate pair in RTF 16 | 17 | All the ASCII printables 18 | !"#$%&\'()*+,-./0123456789:;<=>?@ 19 | ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_` 20 | abcdefghijklmnopqrstuvwxyz{|}~ 21 | 22 | Wśród nocnej ciszy głos się rozchodzi: / 23 | Wstańcie, pasterze, Bóg się nam rodzi! / 24 | Czym prędzej się wybierajcie, / 25 | Do Betlejem pospieszajcie / 26 | Przywitać Pana. 27 | 28 | Poszli, znaleźli Dzieciątko w żłobie / 29 | Z wszystkimi znaki danymi sobie. / 30 | Jako Bogu cześć Mu dali, / 31 | A witając zawołali / 32 | Z wielkiej radości: 33 | 34 | Ach, witaj Zbawco z dawno żądany, / 35 | Wiele tysięcy lat wyglądany / 36 | Na Ciebie króle, prorocy / 37 | Czekali, a Tyś tej nocy / 38 | Nam się objawił. 39 | 40 | I my czekamy na Ciebie, Pana, / 41 | A skoro przyjdziesz na głos kapłana, / 42 | Padniemy na twarz przed Tobą, / 43 | Wierząc, żeś jest pod osłoną / 44 | Chleba i wina. 45 | 46 | =head2 As Verbatim 47 | 48 | And now as verbatim text: 49 | 50 | ff upper half, Plane 0 51 | 𝔸 Plane 1 52 | 53 | All the ASCII printables 54 | !"#$%&\'()*+,-./0123456789:;<=>?@ 55 | ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_` 56 | abcdefghijklmnopqrstuvwxyz{|}~ 57 | 58 | Wśród nocnej ciszy głos się rozchodzi: 59 | Wstańcie, pasterze, Bóg się nam rodzi! 60 | Czym prędzej się wybierajcie, 61 | Do Betlejem pospieszajcie 62 | Przywitać Pana. 63 | 64 | Poszli, znaleźli Dzieciątko w żłobie 65 | Z wszystkimi znaki danymi sobie. 66 | Jako Bogu cześć Mu dali, 67 | A witając zawołali 68 | Z wielkiej radości: 69 | 70 | Ach, witaj Zbawco z dawno żądany, 71 | Wiele tysięcy lat wyglądany 72 | Na Ciebie króle, prorocy 73 | Czekali, a Tyś tej nocy 74 | Nam się objawił. 75 | 76 | I my czekamy na Ciebie, Pana, 77 | A skoro przyjdziesz na głos kapłana, 78 | Padniemy na twarz przed Tobą, 79 | Wierząc, żeś jest pod osłoną 80 | Chleba i wina. 81 | 82 | [end] 83 | 84 | =cut 85 | 86 | 87 | -------------------------------------------------------------------------------- /t/corpus/polish_utf8.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | utf8 4 | 5 | 6 | NAME 7 | 8 | 9 | WŚRÓD NOCNEJ CISZY -- explicitly utf8 test document in Polish 10 | 11 | 12 | DESCRIPTION 13 | 14 | 15 | This is a test Pod document in UTF8. Its content is the lyrics to the 16 | Polish Christmas carol "Wśród nocnej ciszy", except 17 | it includes a few lines to test RTF specially. 18 | 19 | 20 | ff is a character in the upper half of Plane 0, so should be negative 21 | in RTF 𝔸 is a character in Plane 1, so should be expressed as a 22 | surrogate pair in RTF 23 | 24 | 25 | All the ASCII printables 26 | !"#$%&\'()*+,-./0123456789:;<=>?@ 27 | ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_` abcdefghijklmnopqrstuvwxyz{|}~ 28 | 29 | 30 | Wśród nocnej ciszy głos się rozchodzi: / Wstańcie, 31 | pasterze, Bóg się nam rodzi! / Czym prędzej się 32 | wybierajcie, / Do Betlejem pospieszajcie / Przywitać Pana. 33 | 34 | 35 | Poszli, znaleźli Dzieciątko w żłobie / Z wszystkimi 36 | znaki danymi sobie. / Jako Bogu cześć Mu dali, / A 37 | witając zawołali / Z wielkiej radości: 38 | 39 | 40 | Ach, witaj Zbawco z dawno żądany, / Wiele tysięcy lat 41 | wyglądany / Na Ciebie króle, prorocy / Czekali, a Tyś 42 | tej nocy / Nam się objawił. 43 | 44 | 45 | I my czekamy na Ciebie, Pana, / A skoro przyjdziesz na głos 46 | kapłana, / Padniemy na twarz przed Tobą, / Wierząc, 47 | żeś jest pod osłoną / Chleba i wina. 48 | 49 | 50 | As Verbatim 51 | 52 | 53 | And now as verbatim text: 54 | 55 | 56 | ff upper half, Plane 0 57 | 𝔸 Plane 1 58 | 59 | All the ASCII printables 60 | !"#$%&\'()*+,-./0123456789:;<=>?@ 61 | ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_` 62 | abcdefghijklmnopqrstuvwxyz{|}~ 63 | 64 | Wśród nocnej ciszy głos się rozchodzi: 65 | Wstańcie, pasterze, Bóg się nam rodzi! 66 | Czym prędzej się wybierajcie, 67 | Do Betlejem pospieszajcie 68 | Przywitać Pana. 69 | 70 | Poszli, znaleźli Dzieciątko w żłobie 71 | Z wszystkimi znaki danymi sobie. 72 | Jako Bogu cześć Mu dali, 73 | A witając zawołali 74 | Z wielkiej radości: 75 | 76 | Ach, witaj Zbawco z dawno żądany, 77 | Wiele tysięcy lat wyglądany 78 | Na Ciebie króle, prorocy 79 | Czekali, a Tyś tej nocy 80 | Nam się objawił. 81 | 82 | I my czekamy na Ciebie, Pana, 83 | A skoro przyjdziesz na głos kapłana, 84 | Padniemy na twarz przed Tobą, 85 | Wierząc, żeś jest pod osłoną 86 | Chleba i wina. 87 | 88 | 89 | [end] 90 | 91 | 92 | -------------------------------------------------------------------------------- /t/corpus/s2763_sjis.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/perl-pod/pod-simple/00192234381dec835a16bc4ec786266ed0f0690b/t/corpus/s2763_sjis.txt -------------------------------------------------------------------------------- /t/corpus/s2763_sjis.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | shiftjis 4 | 5 | 6 | NAME 7 | 8 | 9 | 型番S2763 -- test document in Shift-JIS 10 | 11 | 12 | DESCRIPTION 13 | 14 | 15 | This is a test Pod document in Shift-JIS. Its content is some uninteresting 16 | product specs I found on the Net. 17 | 18 | 19 | It's an textitem list: 20 | 21 | 22 | 23 | 型番 24 | 25 | 26 | S2763 27 | 28 | 29 | 光源 30 | 31 | 32 | GZ4 33 | ダイクロイックミラーランプ 34 | 12V 10W×1 35 | 36 | 37 | 寸法 38 | 39 | 40 | 高・295 幅・365 奥・76mm 41 | 42 | 43 | 質量 44 | 45 | 46 | 8.0kg 47 | 48 | 49 | 材質 50 | 51 | 52 | 樹脂 53 | アルミ、アルマイト仕上 54 | ガラス 55 | 56 | 57 | 価格 58 | 59 | 60 | 76,000円（ランプ・トランス込み） 61 | 62 | 63 | 64 | 2001年10月3日（水）発売開始 65 | 66 | 67 | [end] 68 | 69 | 70 | -------------------------------------------------------------------------------- /t/corpus/thai_iso11.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/perl-pod/pod-simple/00192234381dec835a16bc4ec786266ed0f0690b/t/corpus/thai_iso11.txt -------------------------------------------------------------------------------- /t/corpus2/README: -------------------------------------------------------------------------------- 1 | This is a corpus of data that hasn't been implemented yet. It's 2 | included for future reference, and will be moved to the main corpus 3 | directory as it is implemented. 4 | -------------------------------------------------------------------------------- /t/corpus2/fiqhakbar_iso6.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/perl-pod/pod-simple/00192234381dec835a16bc4ec786266ed0f0690b/t/corpus2/fiqhakbar_iso6.txt -------------------------------------------------------------------------------- /t/corpus2/polish_implicit_utf8.txt: -------------------------------------------------------------------------------- 1 | 2 | =head1 NAME 3 | 4 | WŚRÓD NOCNEJ CISZY -- implicitly utf8 test document in Polish 5 | 6 | =head1 DESCRIPTION 7 | 8 | This is a test Pod document in UTF8. Its content is the lyrics to 9 | the Polish Christmas carol "Wśród nocnej ciszy". 10 | 11 | Wśród nocnej ciszy głos się rozchodzi: / 12 | Wstańcie, pasterze, Bóg się nam rodzi! / 13 | Czym prędzej się wybierajcie, / 14 | Do Betlejem pospieszajcie / 15 | Przywitać Pana. 16 | 17 | Poszli, znaleźli Dzieciątko w żłobie / 18 | Z wszystkimi znaki danymi sobie. / 19 | Jako Bogu cześć Mu dali, / 20 | A witając zawołali / 21 | Z wielkiej radości: 22 | 23 | Ach, witaj Zbawco z dawno żądany, / 24 | Wiele tysięcy lat wyglądany / 25 | Na Ciebie króle, prorocy / 26 | Czekali, a Tyś tej nocy / 27 | Nam się objawił. 28 | 29 | I my czekamy na Ciebie, Pana, / 30 | A skoro przyjdziesz na głos kapłana, / 31 | Padniemy na twarz przed Tobą, / 32 | Wierząc, żeś jest pod osłoną / 33 | Chleba i wina. 34 | 35 | =head2 As Verbatim 36 | 37 | And now as verbatim text: 38 | 39 | Wśród nocnej ciszy głos się rozchodzi: 40 | Wstańcie, pasterze, Bóg się nam rodzi! 41 | Czym prędzej się wybierajcie, 42 | Do Betlejem pospieszajcie 43 | Przywitać Pana. 44 | 45 | Poszli, znaleźli Dzieciątko w żłobie 46 | Z wszystkimi znaki danymi sobie. 47 | Jako Bogu cześć Mu dali, 48 | A witając zawołali 49 | Z wielkiej radości: 50 | 51 | Ach, witaj Zbawco z dawno żądany, 52 | Wiele tysięcy lat wyglądany 53 | Na Ciebie króle, prorocy 54 | Czekali, a Tyś tej nocy 55 | Nam się objawił. 56 | 57 | I my czekamy na Ciebie, Pana, 58 | A skoro przyjdziesz na głos kapłana, 59 | Padniemy na twarz przed Tobą, 60 | Wierząc, żeś jest pod osłoną 61 | Chleba i wina. 62 | 63 | [end] 64 | 65 | =cut 66 | 67 | 68 | -------------------------------------------------------------------------------- /t/corpus2/polish_utf16be_bom.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/perl-pod/pod-simple/00192234381dec835a16bc4ec786266ed0f0690b/t/corpus2/polish_utf16be_bom.txt -------------------------------------------------------------------------------- /t/corpus2/polish_utf16le_bom.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/perl-pod/pod-simple/00192234381dec835a16bc4ec786266ed0f0690b/t/corpus2/polish_utf16le_bom.txt -------------------------------------------------------------------------------- /t/corpus2/polish_utf8_bom.txt: -------------------------------------------------------------------------------- 1 |  2 | =head1 NAME 3 | 4 | WŚRÓD NOCNEJ CISZY -- implicitly utf8 test document in Polish 5 | 6 | =head1 DESCRIPTION 7 | 8 | This is a test Pod document in UTF8. Its content is the lyrics to 9 | the Polish Christmas carol "Wśród nocnej ciszy". 10 | 11 | Wśród nocnej ciszy głos się rozchodzi: / 12 | Wstańcie, pasterze, Bóg się nam rodzi! / 13 | Czym prędzej się wybierajcie, / 14 | Do Betlejem pospieszajcie / 15 | Przywitać Pana. 16 | 17 | Poszli, znaleźli Dzieciątko w żłobie / 18 | Z wszystkimi znaki danymi sobie. / 19 | Jako Bogu cześć Mu dali, / 20 | A witając zawołali / 21 | Z wielkiej radości: 22 | 23 | Ach, witaj Zbawco z dawno żądany, / 24 | Wiele tysięcy lat wyglądany / 25 | Na Ciebie króle, prorocy / 26 | Czekali, a Tyś tej nocy / 27 | Nam się objawił. 28 | 29 | I my czekamy na Ciebie, Pana, / 30 | A skoro przyjdziesz na głos kapłana, / 31 | Padniemy na twarz przed Tobą, / 32 | Wierząc, żeś jest pod osłoną / 33 | Chleba i wina. 34 | 35 | =head2 As Verbatim 36 | 37 | And now as verbatim text: 38 | 39 | Wśród nocnej ciszy głos się rozchodzi: 40 | Wstańcie, pasterze, Bóg się nam rodzi! 41 | Czym prędzej się wybierajcie, 42 | Do Betlejem pospieszajcie 43 | Przywitać Pana. 44 | 45 | Poszli, znaleźli Dzieciątko w żłobie 46 | Z wszystkimi znaki danymi sobie. 47 | Jako Bogu cześć Mu dali, 48 | A witając zawołali 49 | Z wielkiej radości: 50 | 51 | Ach, witaj Zbawco z dawno żądany, 52 | Wiele tysięcy lat wyglądany 53 | Na Ciebie króle, prorocy 54 | Czekali, a Tyś tej nocy 55 | Nam się objawił. 56 | 57 | I my czekamy na Ciebie, Pana, 58 | A skoro przyjdziesz na głos kapłana, 59 | Padniemy na twarz przed Tobą, 60 | Wierząc, żeś jest pod osłoną 61 | Chleba i wina. 62 | 63 | [end] 64 | 65 | =cut 66 | 67 | 68 | -------------------------------------------------------------------------------- /t/corpus2/polish_utf8_bom.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | NAME 4 | 5 | 6 | WÅšRÓD NOCNEJ CISZY -- implicitly utf8 7 | test document in Polish 8 | 9 | 10 | DESCRIPTION 11 | 12 | 13 | This is a test Pod document in UTF8. Its content is the 14 | lyrics to the Polish Christmas carol "WÅ›ród 15 | nocnej ciszy". 16 | 17 | 18 | WÅ›ród nocnej ciszy gÅ‚os 19 | siÄ™ rozchodzi: / WstaÅ„cie, pasterze, 20 | Bóg siÄ™ nam rodzi! / Czym prÄ™dzej 21 | siÄ™ wybierajcie, / Do Betlejem pospieszajcie 22 | / Przywitać Pana. 23 | 24 | 25 | Poszli, znaleźli DzieciÄ tko w żłobie 26 | / Z wszystkimi znaki danymi sobie. / Jako Bogu cześć 27 | Mu dali, / A witajÄ c zawoÅ‚ali / Z wielkiej 28 | radoÅ›ci: 29 | 30 | 31 | Ach, witaj Zbawco z dawno Å¼Ä dany, / Wiele 32 | tysiÄ™cy lat wyglÄ dany / Na Ciebie króle, 33 | prorocy / Czekali, a TyÅ› tej nocy / Nam siÄ™ 34 | objawiÅ‚. 35 | 36 | 37 | I my czekamy na Ciebie, Pana, / A skoro przyjdziesz na gÅ‚os 38 | kapÅ‚ana, / Padniemy na twarz przed TobÄ 39 | , / WierzÄ c, żeÅ› jest pod osÅ‚onÄ 40 | / Chleba i wina. 41 | 42 | 43 | As Verbatim 44 | 45 | 46 | And now as verbatim text: 47 | 48 | 49 | WÅ›ród nocnej ciszy gÅ‚os 50 | siÄ™ rozchodzi: 51 | 52 | WstaÅ„cie, pasterze, Bóg siÄ™ 53 | nam rodzi! 54 | 55 | Czym prÄ™dzej siÄ™ wybierajcie, 56 | 57 | Do Betlejem pospieszajcie 58 | 59 | Przywitać Pana. 60 | 61 | 62 | 63 | Poszli, znaleźli DzieciÄ…tko w żłobie 64 | 65 | Z wszystkimi znaki danymi sobie. 66 | 67 | Jako Bogu cześć Mu dali, 68 | 69 | A witajÄ…c zawoÅ‚ali 70 | 71 | Z wielkiej radoÅ›ci: 72 | 73 | 74 | 75 | Ach, witaj Zbawco z dawno żądany, 76 | 77 | Wiele tysiÄ™cy lat wyglÄ…dany 78 | 79 | Na Ciebie króle, prorocy 80 | 81 | Czekali, a TyÅ› tej nocy 82 | 83 | Nam siÄ™ objawiÅ‚. 84 | 85 | 86 | 87 | I my czekamy na Ciebie, Pana, 88 | 89 | A skoro przyjdziesz na gÅ‚os kapÅ‚ana, 90 | 91 | Padniemy na twarz przed TobÄ…, 92 | 93 | WierzÄ…c, żeÅ› jest pod 94 | osÅ‚onÄ… 95 | 96 | Chleba i wina. 97 | 98 | 99 | [end] 100 | 101 | 102 | -------------------------------------------------------------------------------- /t/corpus2/polish_utf8_bom2.txt: -------------------------------------------------------------------------------- 1 | =head1 NAME 2 | 3 | 4 | WŚRÓD NOCNEJ CISZY -- implicitly utf8 test document in Polish 5 | 6 | =head1 DESCRIPTION 7 | 8 | This is a test Pod document in UTF8. Its content is the lyrics to 9 | the Polish Christmas carol "Wśród nocnej ciszy". 10 | 11 | Wśród nocnej ciszy głos się rozchodzi: / 12 | Wstańcie, pasterze, Bóg się nam rodzi! / 13 | Czym prędzej się wybierajcie, / 14 | Do Betlejem pospieszajcie / 15 | Przywitać Pana. 16 | 17 | Poszli, znaleźli Dzieciątko w żłobie / 18 | Z wszystkimi znaki danymi sobie. / 19 | Jako Bogu cześć Mu dali, / 20 | A witając zawołali / 21 | Z wielkiej radości: 22 | 23 | Ach, witaj Zbawco z dawno żądany, / 24 | Wiele tysięcy lat wyglądany / 25 | Na Ciebie króle, prorocy / 26 | Czekali, a Tyś tej nocy / 27 | Nam się objawił. 28 | 29 | I my czekamy na Ciebie, Pana, / 30 | A skoro przyjdziesz na głos kapłana, / 31 | Padniemy na twarz przed Tobą, / 32 | Wierząc, żeś jest pod osłoną / 33 | Chleba i wina. 34 | 35 | =head2 As Verbatim 36 | 37 | And now as verbatim text: 38 | 39 | Wśród nocnej ciszy głos się rozchodzi: 40 | Wstańcie, pasterze, Bóg się nam rodzi! 41 | Czym prędzej się wybierajcie, 42 | Do Betlejem pospieszajcie 43 | Przywitać Pana. 44 | 45 | Poszli, znaleźli Dzieciątko w żłobie 46 | Z wszystkimi znaki danymi sobie. 47 | Jako Bogu cześć Mu dali, 48 | A witając zawołali 49 | Z wielkiej radości: 50 | 51 | Ach, witaj Zbawco z dawno żądany, 52 | Wiele tysięcy lat wyglądany 53 | Na Ciebie króle, prorocy 54 | Czekali, a Tyś tej nocy 55 | Nam się objawił. 56 | 57 | I my czekamy na Ciebie, Pana, 58 | A skoro przyjdziesz na głos kapłana, 59 | Padniemy na twarz przed Tobą, 60 | Wierząc, żeś jest pod osłoną 61 | Chleba i wina. 62 | 63 | [end] 64 | 65 | =cut 66 | 67 | 68 | -------------------------------------------------------------------------------- /t/corpus2/polish_utf8_bom2.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | NAME 4 | 5 | 6 | WÅšRÓD NOCNEJ CISZY -- implicitly utf8 7 | test document in Polish 8 | 9 | 10 | DESCRIPTION 11 | 12 | 13 | This is a test Pod document in UTF8. Its content is the 14 | lyrics to the Polish Christmas carol "WÅ›ród 15 | nocnej ciszy". 16 | 17 | 18 | WÅ›ród nocnej ciszy gÅ‚os 19 | siÄ™ rozchodzi: / WstaÅ„cie, pasterze, 20 | Bóg siÄ™ nam rodzi! / Czym prÄ™dzej 21 | siÄ™ wybierajcie, / Do Betlejem pospieszajcie 22 | / Przywitać Pana. 23 | 24 | 25 | Poszli, znaleźli DzieciÄ tko w żłobie 26 | / Z wszystkimi znaki danymi sobie. / Jako Bogu cześć 27 | Mu dali, / A witajÄ c zawoÅ‚ali / Z wielkiej 28 | radoÅ›ci: 29 | 30 | 31 | Ach, witaj Zbawco z dawno Å¼Ä dany, / Wiele 32 | tysiÄ™cy lat wyglÄ dany / Na Ciebie króle, 33 | prorocy / Czekali, a TyÅ› tej nocy / Nam siÄ™ 34 | objawiÅ‚. 35 | 36 | 37 | I my czekamy na Ciebie, Pana, / A skoro przyjdziesz na gÅ‚os 38 | kapÅ‚ana, / Padniemy na twarz przed TobÄ 39 | , / WierzÄ c, żeÅ› jest pod osÅ‚onÄ 40 | / Chleba i wina. 41 | 42 | 43 | As Verbatim 44 | 45 | 46 | And now as verbatim text: 47 | 48 | 49 | WÅ›ród nocnej ciszy gÅ‚os 50 | siÄ™ rozchodzi: 51 | 52 | WstaÅ„cie, pasterze, Bóg siÄ™ 53 | nam rodzi! 54 | 55 | Czym prÄ™dzej siÄ™ wybierajcie, 56 | 57 | Do Betlejem pospieszajcie 58 | 59 | Przywitać Pana. 60 | 61 | 62 | 63 | Poszli, znaleźli DzieciÄ…tko w żłobie 64 | 65 | Z wszystkimi znaki danymi sobie. 66 | 67 | Jako Bogu cześć Mu dali, 68 | 69 | A witajÄ…c zawoÅ‚ali 70 | 71 | Z wielkiej radoÅ›ci: 72 | 73 | 74 | 75 | Ach, witaj Zbawco z dawno żądany, 76 | 77 | Wiele tysiÄ™cy lat wyglÄ…dany 78 | 79 | Na Ciebie króle, prorocy 80 | 81 | Czekali, a TyÅ› tej nocy 82 | 83 | Nam siÄ™ objawiÅ‚. 84 | 85 | 86 | 87 | I my czekamy na Ciebie, Pana, 88 | 89 | A skoro przyjdziesz na gÅ‚os kapÅ‚ana, 90 | 91 | Padniemy na twarz przed TobÄ…, 92 | 93 | WierzÄ…c, żeÅ› jest pod 94 | osÅ‚onÄ… 95 | 96 | Chleba i wina. 97 | 98 | 99 | [end] 100 | 101 | 102 | -------------------------------------------------------------------------------- /t/emptylists.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More tests => 3; 4 | 5 | use Pod::Simple::XMLOutStream; 6 | print "# Pod::Simple version $Pod::Simple::VERSION\n"; 7 | 8 | my $x = 'Pod::Simple::XMLOutStream'; 9 | $Pod::Simple::XMLOutStream::ATTR_PAD = ' '; 10 | $Pod::Simple::XMLOutStream::SORT_ATTRS = 1; # for predictably testable output 11 | 12 | sub on {shift->parse_empty_lists(1)} 13 | sub off {shift->parse_empty_lists(0)} 14 | 15 | my $pod = <_out($pod), 42 | '' 43 | ); 44 | 45 | print "# Testing explicit parse_empty_lists( FALSE ) ...\n"; 46 | 47 | is( $x->_out(\&off, $pod), 48 | '' 49 | ); 50 | 51 | print "# Testing parse_empty_lists( TRUE ) ...\n"; 52 | 53 | is( $x->_out(\&on, $pod), 54 | '' 55 | ); 56 | -------------------------------------------------------------------------------- /t/enc-chars.t: -------------------------------------------------------------------------------- 1 | # tell parser the source POD has already been decoded from bytes to chars 2 | # =encoding line should be ignored 3 | # utf8 characters should come through unscathed 4 | 5 | use strict; 6 | use warnings; 7 | 8 | BEGIN { 9 | use Config; 10 | if ($Config::Config{'extensions'} !~ /\bEncode\b/) { 11 | print "1..0 # Skip: Encode was not built\n"; 12 | exit 0; 13 | } 14 | } 15 | 16 | use Test::More tests => 5; 17 | 18 | use Pod::Simple::DumpAsXML; 19 | use Pod::Simple::XMLOutStream; 20 | 21 | my $parser = Pod::Simple::XMLOutStream->new; 22 | $parser->parse_characters(1); 23 | my $output = ''; 24 | $parser->output_string( \$output ); 25 | $parser->parse_string_document(qq{ 26 | 27 | =encoding bogocode 28 | 29 | =head1 DESCRIPTION 30 | 31 | Confirm that if we tell the parser to expect character data, it avoids all 32 | the code paths that might attempt to decode the source from bytes to chars. 33 | 34 | The r\x{101}in in \x{15E}pain \x{FB02}oods the plain 35 | 36 | }); 37 | 38 | ok(1); # parsed without exception 39 | 40 | if($output =~ /POD ERRORS/) { 41 | ok(0); 42 | } 43 | else { 44 | ok(1); # no errors 45 | } 46 | 47 | $output =~ s{&#(\d+);}{chr($1)}eg; 48 | 49 | if($output =~ /The r\x{101}in in \x{15E}pain \x{FB02}oods the plain/) { 50 | ok(1); # data was not messed up 51 | } 52 | else { 53 | ok(0); 54 | } 55 | 56 | ############################################################################## 57 | # Test multiple =encoding declarations. 58 | $parser = Pod::Simple::XMLOutStream->new; 59 | $output = ''; 60 | $parser->output_string( \$output ); 61 | $parser->parse_string_document(qq{ 62 | 63 | =pod 64 | 65 | =encoding UTF-8 66 | 67 | =encoding UTF-8 68 | 69 | =head1 DESCRIPTION 70 | 71 | Confirm that the parser detects multiple encodings and complains. 72 | }); 73 | 74 | # Should have an error. 75 | like($output, qr/POD ERRORS/); 76 | like($output, qr/Cannot have multiple =encoding directives/); 77 | -------------------------------------------------------------------------------- /t/encod01.t: -------------------------------------------------------------------------------- 1 | # encoding nonesuch 2 | use strict; 3 | use warnings; 4 | 5 | use Test::More tests => 5; 6 | use File::Spec; 7 | 8 | #use Pod::Simple::Debug (10); 9 | 10 | use Pod::Simple; 11 | use Pod::Simple::DumpAsXML; 12 | 13 | my $thefile; 14 | 15 | use File::Spec; 16 | use File::Basename (); 17 | 18 | BEGIN { 19 | my $corpusdir = File::Spec->catdir(File::Basename::dirname(File::Spec->rel2abs(__FILE__)), 'corpus'); 20 | $thefile = File::Spec->catfile($corpusdir, 'nonesuch.txt'); 21 | } 22 | 23 | print "# Testing that $thefile parses right.\n"; 24 | my $outstring; 25 | { 26 | my $p = Pod::Simple::DumpAsXML->new; 27 | $p->output_string( \$outstring ); 28 | $p->parse_file( $thefile ); 29 | undef $p; 30 | } 31 | ok 1 ; # make sure it parsed at all 32 | ok( $outstring && length($outstring) ); # make sure it parsed to something. 33 | #print $outstring; 34 | like( $outstring, qr/Blorp/ ); 35 | like( $outstring, qr/errata/ ); 36 | like( $outstring, qr/unsupported/ ); 37 | -------------------------------------------------------------------------------- /t/encod02.t: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/perl-pod/pod-simple/00192234381dec835a16bc4ec786266ed0f0690b/t/encod02.t -------------------------------------------------------------------------------- /t/encod03.t: -------------------------------------------------------------------------------- 1 | # encoding not error 0 2 | use strict; 3 | use warnings; 4 | 5 | use Test::More tests => 2; 6 | 7 | #use Pod::Simple::Debug (5); 8 | 9 | use Pod::Simple::DumpAsXML; 10 | use Pod::Simple::XMLOutStream; 11 | print "# Pod::Simple version $Pod::Simple::VERSION\n"; 12 | 13 | { 14 | my @output_lines = split m/[\cm\cj]+/, Pod::Simple::XMLOutStream->_out( q{ 15 | 16 | =encoding koi8-r 17 | 18 | =head1 NAME 19 | 20 | Bippitty Boppity Boo -- Yormp 21 | 22 | =cut 23 | 24 | } ); 25 | 26 | 27 | if(grep m/Unknown directive/i, @output_lines ) { 28 | ok 0; 29 | print "# I saw an Unknown directive warning here! :\n", 30 | map("#==> $_\n", @output_lines), "#\n#\n"; 31 | } else { 32 | ok 1; 33 | } 34 | 35 | } 36 | 37 | # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 38 | print "# Now a control group, to make sure that =fishbladder DOES\n", 39 | "# cause an 'unknown directive' error...\n"; 40 | 41 | { 42 | my @output_lines = split m/[\cm\cj]+/, Pod::Simple::XMLOutStream->_out( q{ 43 | 44 | =fishbladder 45 | 46 | =head1 NAME 47 | 48 | Fet's "When you were reading" 49 | 50 | =cut 51 | 52 | } ); 53 | 54 | 55 | if(grep m/Unknown directive/i, @output_lines ) { 56 | ok 1; 57 | } else { 58 | ok 0; 59 | print "# But I didn't see an Unknows directive warning here! :\n", 60 | map("#==> $_\n", @output_lines), "#\n#\n"; 61 | } 62 | 63 | } 64 | -------------------------------------------------------------------------------- /t/end_over.t: -------------------------------------------------------------------------------- 1 | # head ends over 2 | use strict; 3 | use warnings; 4 | use Test::More tests => 6; 5 | 6 | BEGIN { 7 | require FindBin; 8 | unshift @INC, $FindBin::Bin . '/lib'; 9 | } 10 | use helpers qw(f); 11 | 12 | my $d; 13 | #use Pod::Simple::Debug (\$d,0); 14 | 15 | use Pod::Simple::DumpAsXML; 16 | use Pod::Simple::XMLOutStream; 17 | print "# Pod::Simple version $Pod::Simple::VERSION\n"; 18 | 19 | sub nowhine { 20 | $_[0]->{'no_whining'} = 1; 21 | } 22 | 23 | &is(f( 24 | \&nowhine, 25 | "=head2 BLOOP\n\nHoopbehwo!\n\n=over\n\n=item Stuff. Um.\n\nBrop.\n\n=head1 SVUP\n\nMyup.", 26 | "=head2 BLOOP\n\nHoopbehwo!\n\n=over\n\n=item Stuff. Um.\n\nBrop.\n\n=back\n\n=head1 SVUP\n\nMyup.", 27 | )); 28 | 29 | &is(f( 30 | \&nowhine, 31 | "=head2 BLOOP\n\nHoopbehwo!\n\n=over\n\n=item Stuff. Um.\n\nBrop.\n\n=head2 SVUP\n\nMyup.", 32 | "=head2 BLOOP\n\nHoopbehwo!\n\n=over\n\n=item Stuff. Um.\n\nBrop.\n\n=back\n\n=head2 SVUP\n\nMyup.", 33 | )); 34 | 35 | &is(f( 36 | \&nowhine, 37 | "=head2 BLOOP\n\nHoopbehwo!\n\n=over\n\n=item Stuff. Um.\n\nBrop.\n\n=head3 SVUP\n\nMyup.", 38 | "=head2 BLOOP\n\nHoopbehwo!\n\n=over\n\n=item Stuff. Um.\n\nBrop.\n\n=back\n\n=head3 SVUP\n\nMyup.", 39 | )); 40 | 41 | &is(f( 42 | \&nowhine, 43 | "=head2 BLOOP\n\nHoopbehwo!\n\n=over\n\n=item Stuff. Um.\n\nBrop.\n\n=head4 SVUP\n\nMyup.", 44 | "=head2 BLOOP\n\nHoopbehwo!\n\n=over\n\n=item Stuff. Um.\n\nBrop.\n\n=back\n\n=head4 SVUP\n\nMyup.", 45 | )); 46 | 47 | &is(f( 48 | \&nowhine, 49 | "=head2 BLOOP\n\nHoopbehwo!\n\n=over\n\n=item Stuff. Um.\n\nBrop.\n\n=head5 SVUP\n\nMyup.", 50 | "=head2 BLOOP\n\nHoopbehwo!\n\n=over\n\n=item Stuff. Um.\n\nBrop.\n\n=back\n\n=head5 SVUP\n\nMyup.", 51 | )); 52 | 53 | &is(f( 54 | \&nowhine, 55 | "=head2 BLOOP\n\nHoopbehwo!\n\n=over\n\n=item Stuff. Um.\n\nBrop.\n\n=head6 SVUP\n\nMyup.", 56 | "=head2 BLOOP\n\nHoopbehwo!\n\n=over\n\n=item Stuff. Um.\n\nBrop.\n\n=back\n\n=head6 SVUP\n\nMyup.", 57 | )); 58 | -------------------------------------------------------------------------------- /t/eol.t: -------------------------------------------------------------------------------- 1 | # t/eol.t - check handling of \r, \n, and \r\n as line separators 2 | 3 | use strict; 4 | use warnings; 5 | use Test::More tests => 7; 6 | 7 | use_ok('Pod::Simple::XHTML') or exit; 8 | 9 | open(POD, ">$$.pod") or die "$$.pod: $!"; 10 | print POD <<__EOF__; 11 | =pod 12 | 13 | =head1 NAME 14 | 15 | crlf 16 | 17 | =head1 DESCRIPTION 18 | 19 | crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf 20 | crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf 21 | crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf 22 | crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf 23 | 24 | crlf crlf crlf crlf 25 | crlf crlf crlf crlf 26 | crlf crlf crlf crlf 27 | 28 | crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf 29 | crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf 30 | crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf 31 | crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf 32 | 33 | =cut 34 | __EOF__ 35 | close(POD); 36 | 37 | # --- CR --- 38 | 39 | my $p1 = Pod::Simple::XHTML->new (); 40 | isa_ok ($p1, 'Pod::Simple::XHTML'); 41 | 42 | open(POD, "<$$.pod") or die "$$.pod: $!"; 43 | open(IN, ">$$.in") or die "$$.in: $!"; 44 | while () { 45 | s/[\r\n]+/\r/g; 46 | print IN $_; 47 | } 48 | close(POD); 49 | close(IN); 50 | 51 | $p1->output_string(\my $o1); 52 | $p1->parse_file("$$.in"); 53 | 54 | # --- LF --- 55 | 56 | my $p2 = Pod::Simple::XHTML->new (); 57 | isa_ok ($p2, 'Pod::Simple::XHTML'); 58 | 59 | open(POD, "<$$.pod") or die "$$.pod: $!"; 60 | open(IN, ">$$.in") or die "$$.in: $!"; 61 | while () { 62 | s/[\r\n]+/\n/g; 63 | print IN $_; 64 | } 65 | close(POD); 66 | close(IN); 67 | 68 | $p2->output_string(\my $o2); 69 | $p2->parse_file("$$.in"); 70 | 71 | # --- CRLF --- 72 | 73 | my $p3 = Pod::Simple::XHTML->new (); 74 | isa_ok ($p3, 'Pod::Simple::XHTML'); 75 | 76 | open(POD, "<$$.pod") or die "$$.pod: $!"; 77 | open(IN, ">$$.in") or die "$$.in: $!"; 78 | while () { 79 | s/[\r\n]+/\r\n/g; 80 | print IN $_; 81 | } 82 | close(POD); 83 | close(IN); 84 | 85 | $p3->output_string(\my $o3); 86 | $p3->parse_file("$$.in"); 87 | 88 | # --- now test --- 89 | 90 | my $cksum1 = unpack("%32C*", $o1); 91 | my $cksum2 = unpack("%32C*", $o2); 92 | my $cksum3 = unpack("%32C*", $o3); 93 | 94 | ok($cksum1 == $cksum2, "CR vs LF"); 95 | ok($cksum1 == $cksum3, "CR vs CRLF"); 96 | ok($cksum2 == $cksum3, "LF vs CRLF"); 97 | 98 | END { 99 | 1 while unlink("$$.pod", "$$.in"); 100 | } 101 | -------------------------------------------------------------------------------- /t/eol2.t: -------------------------------------------------------------------------------- 1 | # t/eol2.t - check handling of \r, \n, and \r\n as line separators (again) 2 | 3 | use strict; 4 | use warnings; 5 | use Test::More tests => 7; 6 | 7 | use_ok('Pod::Simple::XHTML') or exit; 8 | 9 | open(POD, ">$$.pod") or die "$$.pod: $!"; 10 | print POD <<__EOF__; 11 | =pod 12 | 13 | =head1 NAME 14 | 15 | crlf 16 | 17 | =head1 DESCRIPTION 18 | 19 | crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf 20 | crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf 21 | crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf 22 | crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf 23 | 24 | crlf crlf crlf crlf 25 | crlf crlf crlf crlf 26 | crlf crlf crlf crlf 27 | 28 | crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf 29 | crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf 30 | crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf 31 | crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf 32 | 33 | =cut 34 | __EOF__ 35 | close(POD); 36 | 37 | # --- CR --- 38 | 39 | my $p1 = Pod::Simple::XHTML->new (); 40 | isa_ok ($p1, 'Pod::Simple::XHTML'); 41 | 42 | open(POD, "<$$.pod") or die "$$.pod: $!"; 43 | my $i1 = ''; 44 | while () { 45 | s/[\r\n]+/\r/g; 46 | $i1 .= $_; 47 | } 48 | close(POD); 49 | 50 | $p1->output_string(\my $o1); 51 | $p1->parse_string_document($i1); 52 | 53 | # --- LF --- 54 | 55 | my $p2 = Pod::Simple::XHTML->new (); 56 | isa_ok ($p2, 'Pod::Simple::XHTML'); 57 | 58 | open(POD, "<$$.pod") or die "$$.pod: $!"; 59 | my $i2 = ''; 60 | while () { 61 | s/[\r\n]+/\n/g; 62 | $i2 .= $_; 63 | } 64 | close(POD); 65 | 66 | $p2->output_string(\my $o2); 67 | $p2->parse_string_document($i2); 68 | 69 | # --- CRLF --- 70 | 71 | my $p3 = Pod::Simple::XHTML->new (); 72 | isa_ok ($p3, 'Pod::Simple::XHTML'); 73 | 74 | open(POD, "<$$.pod") or die "$$.pod: $!"; 75 | my $i3 = ''; 76 | while () { 77 | s/[\r\n]+/\r\n/g; 78 | $i3 .= $_; 79 | } 80 | close(POD); 81 | 82 | $p3->output_string(\my $o3); 83 | $p3->parse_string_document($i3); 84 | 85 | # --- now test --- 86 | 87 | my $cksum1 = unpack("%32C*", $o1); 88 | my $cksum2 = unpack("%32C*", $o2); 89 | my $cksum3 = unpack("%32C*", $o3); 90 | 91 | ok($cksum1 == $cksum2, "CR vs LF"); 92 | ok($cksum1 == $cksum3, "CR vs CRLF"); 93 | ok($cksum2 == $cksum3, "LF vs CRLF"); 94 | 95 | END { 96 | 1 while unlink("$$.pod", "$$.in"); 97 | } 98 | -------------------------------------------------------------------------------- /t/fake-closers.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More tests => 7; 4 | use Data::Dumper; 5 | 6 | my $i = 0; 7 | 8 | print "# Real closers ...\n"; 9 | 10 | for my $pod ( "=over\n\nblock\n\n=back", 11 | "=over\n\nblock\n\n=cut\n\ncode\n\n=pod\n\n=back", 12 | "=begin html\n\ntag\n\n=end html", 13 | ) { 14 | my $parser = Pod::Simple::Blurb->new(); 15 | $parser->parse_string_document($pod); 16 | is($parser->{'closer-flag'}, -1, "real closer ". ++$i); 17 | } 18 | 19 | $i = 0; 20 | 21 | print "# Fake closers ...\n"; 22 | 23 | for my $pod ("=begin html\n\ntag=cut", 24 | "=begin html\n\ntag\n\n=begin xml tag =end xml", 25 | "=over\n\nblock=cut", 26 | "=over\n\nanother block", 27 | ) { 28 | my $parser = Pod::Simple::Blurb->new(); 29 | $parser->parse_string_document($pod); 30 | is($parser->{'closer-flag'}, 1, "fake closer ". ++$i); 31 | } 32 | 33 | package Pod::Simple::Blurb; 34 | use warnings; 35 | use strict; 36 | use base qw/Pod::Simple::Methody/; 37 | 38 | sub new { 39 | my $new = shift->SUPER::new(@_); 40 | $new->output_string(\my $doesnotmatter); 41 | $new->accept_targets('*'); 42 | return $new; 43 | } 44 | 45 | sub end_over_block { 46 | shift->set(@_); 47 | } 48 | sub end_for { 49 | shift->set(@_); 50 | } 51 | 52 | sub set { 53 | $_[0]{'closer-flag'} = defined $_[1]{'fake-closer'} ? 1 : -1; 54 | } 55 | -------------------------------------------------------------------------------- /t/fcodes_e.t: -------------------------------------------------------------------------------- 1 | # fcodes E 2 | use strict; 3 | use warnings; 4 | use Test::More tests => 18; 5 | 6 | BEGIN { 7 | require FindBin; 8 | unshift @INC, $FindBin::Bin . '/lib'; 9 | } 10 | use helpers; 11 | 12 | #use Pod::Simple::Debug (6); 13 | 14 | use Pod::Simple::DumpAsXML; 15 | use Pod::Simple::XMLOutStream; 16 | 17 | print "# Pod::Simple version $Pod::Simple::VERSION\n"; 18 | 19 | print "# Pod::Escapes version $Pod::Escapes::VERSION\n", 20 | if $Pod::Escapes::VERSION; 21 | # Presumably that's the library being used 22 | 23 | &is( e "", "" ); 24 | &is( e "\n", "", ); 25 | 26 | 27 | print "# Testing some basic mnemonic E sequences...\n"; 28 | 29 | &is( Pod::Simple::XMLOutStream->_out("=pod\n\n1E2\n"), 30 | Pod::Simple::XMLOutStream->_out("=pod\n\n1<2") 31 | ); 32 | &is( Pod::Simple::XMLOutStream->_out("=pod\n\n1E2\n"), 33 | Pod::Simple::XMLOutStream->_out("=pod\n\n1>2") 34 | ); 35 | &is( Pod::Simple::XMLOutStream->_out("=pod\n\n1E2\n"), 36 | Pod::Simple::XMLOutStream->_out("=pod\n\n1|2") 37 | ); 38 | &is( Pod::Simple::XMLOutStream->_out("=pod\n\n1E2\n"), 39 | Pod::Simple::XMLOutStream->_out("=pod\n\n1/2\n") 40 | ); 41 | 42 | 43 | print "# Testing some more mnemonic E sequences...\n"; 44 | 45 | &is( Pod::Simple::XMLOutStream->_out("=pod\n\n1E2\n"), 46 | Pod::Simple::XMLOutStream->_out("=pod\n\n1'2") 47 | ); 48 | &is( Pod::Simple::XMLOutStream->_out("=pod\n\n1E2\n"), 49 | Pod::Simple::XMLOutStream->_out("=pod\n\n1\"2") 50 | ); 51 | &is( Pod::Simple::XMLOutStream->_out("=pod\n\n1&2"), 52 | Pod::Simple::XMLOutStream->_out("=pod\n\n1E2\n") 53 | ); 54 | &is( Pod::Simple::XMLOutStream->_out("=pod\n\n1E2"), 55 | Pod::Simple::XMLOutStream->_out("=pod\n\n1E<233>2\n") 56 | ); 57 | &is( Pod::Simple::XMLOutStream->_out("=pod\n\n1E2"), 58 | Pod::Simple::XMLOutStream->_out("=pod\n\n1E<8734>2\n") 59 | ); 60 | 61 | &is( Pod::Simple::XMLOutStream->_out("=pod\n\n1E2"), 62 | Pod::Simple::XMLOutStream->_out("=pod\n\n1E<171>2\n") 63 | ); 64 | &is( Pod::Simple::XMLOutStream->_out("=pod\n\n1E2"), 65 | Pod::Simple::XMLOutStream->_out("=pod\n\n1E<187>2\n") 66 | ); 67 | &is( Pod::Simple::XMLOutStream->_out("=pod\n\n1E2"), 68 | Pod::Simple::XMLOutStream->_out("=pod\n\n1E<171>2\n") 69 | ); 70 | &is( Pod::Simple::XMLOutStream->_out("=pod\n\n1E2"), 71 | Pod::Simple::XMLOutStream->_out("=pod\n\n1E<187>2\n") 72 | ); 73 | 74 | 75 | 76 | print "# Testing numeric E sequences...\n"; 77 | &is( Pod::Simple::XMLOutStream->_out("=pod\n\n1E<0101>2\n"), 78 | Pod::Simple::XMLOutStream->_out("=pod\n\n1A2") 79 | ); 80 | &is( Pod::Simple::XMLOutStream->_out("=pod\n\n1E<65>2\n"), 81 | Pod::Simple::XMLOutStream->_out("=pod\n\n1A2") 82 | ); 83 | &is( Pod::Simple::XMLOutStream->_out("=pod\n\n1E<0x41>2\n"), 84 | Pod::Simple::XMLOutStream->_out("=pod\n\n1A2") 85 | ); 86 | -------------------------------------------------------------------------------- /t/filter-html.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | use Pod::Simple::XHTML; 6 | 7 | sub convert { 8 | my ($pod, $select) = @_; 9 | 10 | my $out = ''; 11 | my $parser = Pod::Simple::XHTML->new; 12 | $parser->html_header(''); 13 | $parser->html_footer(''); 14 | $parser->output_string(\$out); 15 | $parser->set_heading_select(@$select); 16 | 17 | $parser->parse_string_document($pod); 18 | return $out; 19 | } 20 | 21 | sub compare { 22 | my ($in, $want, $select, $name) = @_; 23 | for my $pod ($in, $want) { 24 | if ($pod =~ /\A([\t ]+)/) { 25 | my $prefix = $1; 26 | $pod =~ s{^$prefix}{}gm; 27 | } 28 | } 29 | my $got = convert($in, $select); 30 | local $Test::Builder::Level = $Test::Builder::Level + 1; 31 | is $got, $want, $name; 32 | } 33 | 34 | compare <<'END_POD', <<'END_HTML', [ 'DESCRIPTION/guff' ]; 35 | =head1 NAME 36 | 37 | NAME content 38 | 39 | =head2 welp 40 | 41 | welp content 42 | 43 | =head3 hork 44 | 45 | hork content 46 | 47 | =head1 DESCRIPTION 48 | 49 | DESCRIPTION content 50 | 51 | =head2 guff 52 | 53 | guff content 54 | 55 | =cut 56 | END_POD 57 |

guff

58 | 59 |

guff content

60 | 61 | END_HTML 62 | 63 | done_testing; 64 | -------------------------------------------------------------------------------- /t/filter.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use Pod::Simple::JustPod; 5 | 6 | sub convert { 7 | my ($pod, $select) = @_; 8 | 9 | my $out = ''; 10 | my $parser = Pod::Simple::JustPod->new; 11 | $parser->output_string(\$out); 12 | $parser->set_heading_select(@$select); 13 | 14 | $parser->parse_string_document($pod); 15 | return $out; 16 | } 17 | 18 | sub compare { 19 | my ($in, $want, $select, $name) = @_; 20 | for my $pod ($in, $want) { 21 | if ($pod =~ /\A([\t ]+)/) { 22 | my $prefix = $1; 23 | $pod =~ s{^$prefix}{}gm; 24 | } 25 | } 26 | my $got = convert($in, $select); 27 | $got =~ s/\A=pod\n\n//; 28 | local $Test::Builder::Level = $Test::Builder::Level + 1; 29 | is $got, $want, $name; 30 | } 31 | 32 | compare <<'END_IN_POD', <<'END_OUT_POD', [ 'DESCRIPTION/guff' ]; 33 | =head1 NAME 34 | 35 | NAME content 36 | 37 | =head2 welp 38 | 39 | welp content 40 | 41 | =head3 hork 42 | 43 | hork content 44 | 45 | =head1 DESCRIPTION 46 | 47 | DESCRIPTION content 48 | 49 | =head2 guff 50 | 51 | guff content 52 | 53 | =cut 54 | END_IN_POD 55 | =head2 guff 56 | 57 | guff content 58 | 59 | =cut 60 | END_OUT_POD 61 | 62 | done_testing; 63 | -------------------------------------------------------------------------------- /t/github_issue_79.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More; 5 | 6 | { 7 | package DumpAsXML::Enh; 8 | 9 | use Pod::Simple::DumpAsXML (); 10 | our @ISA = qw(Pod::Simple::DumpAsXML); 11 | 12 | sub new { 13 | my ( $class ) = @_; 14 | my $self = $class->SUPER::new(); 15 | $self->code_handler( sub { pop( @_ )->_handle_line( 'code', @_ ); } ); 16 | $self->cut_handler( sub { pop( @_ )->_handle_line( 'cut', @_ ); } ); 17 | $self->pod_handler( sub { pop( @_ )->_handle_line( 'pod', @_ ); } ); 18 | $self->whiteline_handler( sub { pop( @_ )->_handle_line( 'white', @_ ); } ); 19 | return $self; 20 | }; 21 | 22 | sub _handle_line { 23 | my ( $self, $elem, $text, $line ) = @_; 24 | my $fh = $self->{ output_fh }; 25 | print { $fh } ' ' x $self->{ indent }, "<$elem start_line=\"$line\"/>\n"; 26 | }; 27 | 28 | } 29 | 30 | my $output = ''; 31 | my $parser = DumpAsXML::Enh->new(); 32 | $parser->output_string( \$output ); 33 | 34 | my $input = [ 35 | '=head1 DESCRIPTION', 36 | '', 37 | ' Verbatim paragraph.', 38 | '', 39 | '=cut', 40 | ]; 41 | my $expected_output = join "\n", 42 | '', 43 | ' ', 44 | ' DESCRIPTION', 45 | ' ', 46 | ' ', 47 | ' Verbatim paragraph.', 48 | ' ', 49 | ' ', 50 | '', 51 | '', 52 | ; 53 | 54 | $parser->parse_lines( @$input, undef ); 55 | 56 | is($output, $expected_output); 57 | 58 | done_testing; 59 | -------------------------------------------------------------------------------- /t/heads.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More tests => 21; 4 | 5 | #use Pod::Simple::Debug (6); 6 | 7 | BEGIN { 8 | require FindBin; 9 | unshift @INC, $FindBin::Bin . '/lib'; 10 | } 11 | use helpers; 12 | 13 | use Pod::Simple::DumpAsXML; 14 | use Pod::Simple::XMLOutStream; 15 | print "# Pod::Simple version $Pod::Simple::VERSION\n"; 16 | 17 | 18 | print "# Simple tests for head1 - head6...\n"; 19 | is( Pod::Simple::XMLOutStream->_out("\n=head1 Chacha\n\n"), 20 | 'Chacha' 21 | ); 22 | is( Pod::Simple::XMLOutStream->_out("\n=head2 Chacha\n\n"), 23 | 'Chacha' 24 | ); 25 | is( Pod::Simple::XMLOutStream->_out("\n=head3 Chacha\n\n"), 26 | 'Chacha' 27 | ); 28 | is( Pod::Simple::XMLOutStream->_out("\n=head4 Chacha\n\n"), 29 | 'Chacha' 30 | ); 31 | is( Pod::Simple::XMLOutStream->_out("\n=head5 Chacha\n\n"), 32 | 'Chacha' 33 | ); 34 | is( Pod::Simple::XMLOutStream->_out("\n=head6 Chacha\n\n"), 35 | 'Chacha' 36 | ); 37 | 38 | print "# Testing whitespace equivalence...\n"; 39 | 40 | &is(e "\n=head1 Chacha\n\n", "\n=head1 Chacha\n\n"); 41 | &is(e "\n=head1 Chacha\n\n", "\n=head1\tChacha\n\n"); 42 | &is(e "\n=head1 Chacha\n\n", "\n=head1\tChacha \n\n"); 43 | 44 | 45 | 46 | is( Pod::Simple::XMLOutStream->_out("=head1 Chachacha"), 47 | 'Chachacha' 48 | ); 49 | 50 | 51 | print "# Testing whitespace variance ...\n"; 52 | is( Pod::Simple::XMLOutStream->_out("=head1 Cha cha cha \n"), 53 | 'Cha cha cha' 54 | ); 55 | is( Pod::Simple::XMLOutStream->_out("=head1 Cha cha\tcha \n"), 56 | 'Cha cha cha' 57 | ); 58 | 59 | 60 | 61 | 62 | print "# Testing head2 ... head6 more...\n"; 63 | 64 | is( Pod::Simple::XMLOutStream->_out("=head2 Cha cha\tcha \n"), 65 | 'Cha cha cha' 66 | ); 67 | is( Pod::Simple::XMLOutStream->_out("=head3 Cha cha\tcha \n"), 68 | 'Cha cha cha' 69 | ); 70 | is( Pod::Simple::XMLOutStream->_out("=head4 Cha cha\tcha \n"), 71 | 'Cha cha cha' 72 | ); 73 | is( Pod::Simple::XMLOutStream->_out("=head5 Cha cha\tcha \n"), 74 | 'Cha cha cha' 75 | ); 76 | is( Pod::Simple::XMLOutStream->_out("=head6 Cha cha\tcha \n"), 77 | 'Cha cha cha' 78 | ); 79 | 80 | print "# Testing entity expansion...\n"; 81 | 82 | is( Pod::Simple::XMLOutStream->_out("=head4 fooE<64>bar!\n"), 83 | Pod::Simple::XMLOutStream->_out("\n=head4 foo\@bar!\n\n"), 84 | ); 85 | 86 | # TODO: a mode so that DumpAsXML can ask for all contiguous string 87 | # sequences to be fused? 88 | # &ok( e "=head4 fooE<64>bar!\n", "\n=head4 foo\@bar!\n\n"); 89 | 90 | print "# Testing formatting sequences...\n"; 91 | 92 | # True only if the sequences resolve, as they should... 93 | &is( e "=head4 C\n", "\n=head4 C<< foobar! >>\n\n"); 94 | &is( e "=head4 C\n", "\n\n=head4 C<<< foobar! >>>\n"); 95 | &is( e "=head4 C\n", "\n=head4 C<< foobar!\n\t>>\n\n"); 96 | -------------------------------------------------------------------------------- /t/html01.t: -------------------------------------------------------------------------------- 1 | # Testing HTML paragraphs 2 | use strict; 3 | use warnings; 4 | use Test::More tests => 15; 5 | 6 | #use Pod::Simple::Debug (10); 7 | 8 | use Pod::Simple::HTML; 9 | 10 | sub x { 11 | my $code = $_[1]; 12 | Pod::Simple::HTML->_out( 13 | sub{ $_[0]->bare_output(1); $code->($_[0]) if $code }, 14 | "=pod\n\n$_[0]", 15 | ) } 16 | 17 | is( x( 18 | q{ 19 | =pod 20 | 21 | This is a paragraph 22 | 23 | =cut 24 | }), 25 | qq{\n

This is a paragraph

\n}, 26 | "paragraph building" 27 | ); 28 | 29 | 30 | is( x(qq{=pod\n\nThis is a paragraph}), 31 | qq{\n

This is a paragraph

\n}, 32 | "paragraph building" 33 | ); 34 | 35 | 36 | is( x(qq{This is a paragraph}), 37 | qq{\n

This is a paragraph

\n}, 38 | "paragraph building" 39 | ); 40 | 41 | 42 | 43 | like(x( 44 | '=head1 This is a heading') 45 | => qr{\s*

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

\s*$}, 46 | "heading building" 47 | ); 48 | 49 | like(x('=head1 This is a heading', sub { $_[0]->html_h_level(2) }) 50 | => qr{\s*

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

\s*$}, 51 | "heading building" 52 | ); 53 | 54 | like(x( 55 | '=head2 This is a heading too') 56 | => qr{\s*

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

\s*$}, 57 | "heading building" 58 | ); 59 | 60 | like(x( 61 | '=head3 Also, this is a heading') 62 | => qr{\s*

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

\s*$}, 63 | "heading building" 64 | ); 65 | 66 | 67 | like(x( 68 | '=head4 This, too, is a heading') 69 | => qr{\s*

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

\s*$}, 70 | "heading building" 71 | ); 72 | 73 | like(x( 74 | '=head5 The number of the heading shall be five') 75 | => qr{\s*
]+>The\s+number\s+of\s+the\s+heading\s+shall\s+be\s+five
\s*$}, 76 | "heading building" 77 | ); 78 | 79 | like(x( 80 | '=head6 The sixth a heading is the perfect heading') 81 | => qr{\s*
]+>The\s+sixth\s+a\s+heading\s+is\s+the\s+perfect\s+heading
\s*$}, 82 | "heading building" 83 | ); 84 | 85 | like(x( 86 | '=head2 Yada Yada Operator 87 | X<...> X<... operator> X') 88 | => qr{name="Yada_Yada_Operator"}, 89 | "heading anchor name" 90 | ); 91 | 92 | is( 93 | x("=over 4\n\n=item one\n\n=item two\n\nHello\n\n=back\n"), 94 | q{ 95 |
96 |
one
98 | 99 |
100 |
two
102 | 103 |
104 |

Hello

105 |
106 |
107 | } 108 | ); 109 | 110 | my $html = q{ 111 | 
112 | #include <stdio.h>
113 | 
114 | int main(int argc,char *argv[]) {
115 | 
116 |         printf("Hellow World\n");
117 |         return 0;
118 | 
119 | }
120 |
121 | }; 122 | is( 123 | x("=begin html\n\n$html\n\n=end html\n"), 124 | "$html\n\n" 125 | ); 126 | 127 | # Check subclass. 128 | SUBCLASS: { 129 | package My::Pod::HTML; 130 | use vars '@ISA', '$VERSION'; 131 | @ISA = ('Pod::Simple::HTML'); 132 | $VERSION = '0.01'; 133 | sub do_section { 'howdy' } 134 | } 135 | 136 | is( 137 | My::Pod::HTML->_out( 138 | sub{ $_[0]->bare_output(1) }, 139 | "=pod\n\n=over\n\n=item Foo\n\n=back\n", 140 | ), 141 | "\n
\n
Foo
\n
\n", 142 | ); 143 | 144 | { # Test that strip_verbatim_indent() works. github issue #i5 145 | my $output; 146 | 147 | my $obj = Pod::Simple::HTML->new; 148 | $obj->strip_verbatim_indent(" "); 149 | $obj->output_string(\$output); 150 | $obj->parse_string_document("=pod\n\n First line\n 2nd line\n"); 151 | like($output, qr!
First line\n2nd line
!s); 152 | } 153 | -------------------------------------------------------------------------------- /t/html02.t: -------------------------------------------------------------------------------- 1 | # Testing HTML text styles 2 | 3 | use strict; 4 | use warnings; 5 | use Test::More tests => 7; 6 | 7 | #use Pod::Simple::Debug (10); 8 | use Pod::Simple::HTML; 9 | 10 | sub x { Pod::Simple::HTML->_out( 11 | sub{ $_[0]->bare_output(1) }, 12 | "=pod\n\n$_[0]", 13 | ) } 14 | 15 | ok 1; 16 | 17 | my @pairs = ( 18 | [ "I" => qq{\n

italicized

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

bolded

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

code

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

/tmp/foo

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

/tmp/foo

\n} ], 23 | [ 'U' => qq{\n

underlined

\n} ], 24 | ); 25 | 26 | 27 | foreach( @pairs ) { 28 | print "# Testing pod source $$_[0] ...\n" unless $_->[0] =~ m/\n/; 29 | is( x($_->[0]), $_->[1] ) 30 | } 31 | -------------------------------------------------------------------------------- /t/html03.t: -------------------------------------------------------------------------------- 1 | # Testing HTML titles 2 | use strict; 3 | use warnings; 4 | use Test::More tests => 5; 5 | 6 | #use Pod::Simple::Debug (10); 7 | 8 | use Pod::Simple::HTML; 9 | 10 | sub x { Pod::Simple::HTML->_out( 11 | #sub{ $_[0]->bare_output(1) }, 12 | "=pod\n\n$_[0]", 13 | ) } 14 | 15 | # make sure empty file => empty output 16 | 17 | is( x(''),'', "Contentlessness" ); 18 | like( x(qq{=pod\n\nThis is a paragraph}), qr{}i ); 19 | like( x(qq{This is a paragraph}), qr{}i ); 20 | like( x(qq{=head1 Prok\n\nThis is a paragraph}), qr{Prok}i ); 21 | like( x(qq{=head1 NAME\n\nProk -- stuff\n\nThis}), qr{Prok} ); 22 | -------------------------------------------------------------------------------- /t/htmlbat.t: -------------------------------------------------------------------------------- 1 | # Testing HTMLBatch 2 | use strict; 3 | use warnings; 4 | 5 | use Test::More tests => 13; 6 | 7 | #sub Pod::Simple::HTMLBatch::DEBUG () {5} 8 | 9 | require Pod::Simple::HTMLBatch; 10 | 11 | use File::Spec (); 12 | use File::Basename (); 13 | 14 | my $t_dir = File::Basename::dirname(File::Spec->rel2abs(__FILE__)); 15 | my $corpus_dir = File::Spec->catdir($t_dir, 'testlib1'); 16 | 17 | my $temp_dir = File::Spec->tmpdir; 18 | my $outdir; 19 | while(1) { 20 | my $rand = sprintf "%05x", rand( 0x100000 ); 21 | $outdir = File::Spec->catdir( $temp_dir, "delme-$rand-out" ); 22 | last unless -e $outdir; 23 | } 24 | 25 | END { 26 | use File::Path; 27 | rmtree $outdir, 0, 0; 28 | } 29 | 30 | note "Output dir: $outdir"; 31 | 32 | mkdir $outdir, 0777 or die "Can't mkdir $outdir: $!"; 33 | 34 | note "Converting $corpus_dir => $outdir"; 35 | my $conv = Pod::Simple::HTMLBatch->new; 36 | $conv->verbose(0); 37 | $conv->index(1); 38 | $conv->batch_convert( [$corpus_dir], $outdir ); 39 | note "OK, back from converting"; 40 | 41 | my @files; 42 | use File::Find; 43 | find( sub { 44 | push @files, $File::Find::name; 45 | if (/[.]html\z/ && !/perl|index/) { 46 | # Make sure an index was generated. 47 | open my $fh, '<', $_ or die "Cannot open $_: $!\n"; 48 | my $html = do { local $/; <$fh> }; 49 | close $fh; 50 | like $html, qr/
/; 51 | } 52 | }, $outdir ); 53 | 54 | { 55 | my $long = ( grep m/zikzik\./i, @files )[0]; 56 | ok($long) or diag "How odd, no zikzik file in $outdir!?"; 57 | if($long) { 58 | $long =~ s{zikzik\.html?\z}{}; 59 | for(@files) { substr($_, 0, length($long)) = ''; } 60 | @files = grep length($_), @files; 61 | } 62 | } 63 | 64 | note "Produced in $outdir ..."; 65 | foreach my $f (sort @files) { 66 | note " $f"; 67 | } 68 | note "(", scalar(@files), " items total)"; 69 | 70 | # Some minimal sanity checks: 71 | cmp_ok scalar(grep m/\.css\z/i, @files), '>', 5; 72 | cmp_ok scalar(grep m/\.html?\z/i, @files), '>', 5; 73 | cmp_ok scalar(grep m{squaa\W+Glunk\.html?\z}i, @files), '>', 0; 74 | 75 | my @long = grep { /^[^.]{9,}/ } map { File::Basename::basename($_) } @files; 76 | unless (is scalar(@long), 0, "Generated filenames fit in 8.* format") { 77 | diag " File names too long:"; 78 | diag " $_" for @long; 79 | } 80 | -------------------------------------------------------------------------------- /t/items02.t: -------------------------------------------------------------------------------- 1 | # Testing the =item directive 2 | use strict; 3 | use warnings; 4 | use Test::More tests => 2; 5 | 6 | BEGIN { 7 | require FindBin; 8 | unshift @INC, $FindBin::Bin . '/lib'; 9 | } 10 | use helpers; 11 | 12 | my $d; 13 | #use Pod::Simple::Debug (\$d,0); 14 | 15 | use Pod::Simple::DumpAsXML; 16 | use Pod::Simple::XMLOutStream; 17 | print "# Pod::Simple version $Pod::Simple::VERSION\n"; 18 | 19 | my $x = 'Pod::Simple::XMLOutStream'; 20 | 21 | print "##### Tests for =item directives via class $x\n"; 22 | 23 | $Pod::Simple::XMLOutStream::ATTR_PAD = ' '; 24 | $Pod::Simple::XMLOutStream::SORT_ATTRS = 1; # for predictably testable output 25 | 26 | 27 | print "#\n# Tests for =item [number] that are icky...\n"; 28 | is( $x->_out(sub { $_[0]->no_errata_section(1) }, 29 | "\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"), 30 | '5Stuff4Quux' 31 | ); 32 | 33 | is( $x->_out(sub { $_[0]->no_errata_section(1) }, 34 | "\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"), 35 | '5.Stuff4.Quux' 36 | ); 37 | -------------------------------------------------------------------------------- /t/itemstar.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More tests => 4; 4 | 5 | BEGIN { 6 | require FindBin; 7 | unshift @INC, $FindBin::Bin . '/lib'; 8 | require helpers; 9 | helpers->import; 10 | } 11 | #my $d; 12 | #use Pod::Simple::Debug (3); 13 | 14 | use Pod::Simple::DumpAsXML; 15 | use Pod::Simple::XMLOutStream; 16 | print "# Pod::Simple version $Pod::Simple::VERSION\n"; 17 | 18 | my $x = 'Pod::Simple::XMLOutStream'; 19 | 20 | print "##### Tests for '=item * Foo' tolerance via class $x\n"; 21 | 22 | $Pod::Simple::XMLOutStream::ATTR_PAD = ' '; 23 | $Pod::Simple::XMLOutStream::SORT_ATTRS = 1; # for predictably testable output 24 | 25 | 26 | print "#\n# Tests for simple =item *'s\n"; 27 | ok( $x->_out("\n=over\n\n=item * Stuff\n\n=item * Bar I!\n\n=back\n\n"), 28 | 'StuffBar baz!' 29 | ); 30 | 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"), 31 | 'StuffBar baz!' 32 | ); 33 | 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"), 34 | 'StuffBar baz!' 35 | ); 36 | ok( $x->_out("\n=over\n\n=item * Stuff I hoo!\n=cut\nStuff\n\n=item *\n\nBar I!\n\n=back"), 37 | 'Stuff things um hoo!Bar baz!' 38 | ); 39 | -------------------------------------------------------------------------------- /t/junk1.pod: -------------------------------------------------------------------------------- 1 | 2 | =cut 3 | 4 | =head9 I like pie 5 | 6 | B 9 | -------------------------------------------------------------------------------- /t/junk1o.txt: -------------------------------------------------------------------------------- 1 | pie is nice E 2 | 3 | POD ERRORS 4 | Hey! The above document had some coding errors, which are explained below: 5 | 6 | Around line 2: 7 | =cut found outside a pod block. Skipping to next block. 8 | Around line 4: 9 | Unknown directive: =head9 10 | Around line 6: 11 | Unterminated B<...> sequence 12 | Around line 8: 13 | Unknown E content in E 14 | -------------------------------------------------------------------------------- /t/junk2.pod: -------------------------------------------------------------------------------- 1 | 2 | =head9 I like pie 3 | 4 | B 7 | -------------------------------------------------------------------------------- /t/junk2o.txt: -------------------------------------------------------------------------------- 1 | pie is nice 2 | 3 | E 4 | 5 | POD ERRORS 6 | Hey! The above document had some coding errors, which are explained below: 7 | Around line 2: 8 | Unknown directive: =head9 9 | Around line 4: 10 | Unterminated B<...> sequence 11 | Around line 6: 12 | Unknown E content in E 13 | 14 | -------------------------------------------------------------------------------- /t/lib/helpers.pm: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | package helpers; 4 | 5 | use strict; 6 | use warnings; 7 | 8 | use Exporter; 9 | 10 | our @ISA = qw{Exporter}; 11 | 12 | our @EXPORT_OK = qw(e f); 13 | our @EXPORT = qw{e}; 14 | 15 | sub e { Pod::Simple::DumpAsXML->_duo(@_) }; 16 | sub f { Pod::Simple::DumpAsXML->_duo(@_) }; 17 | 18 | 1; 19 | -------------------------------------------------------------------------------- /t/linkclas.t: -------------------------------------------------------------------------------- 1 | # Testing the LinkSection class 2 | ### Test the basic sanity of the link-section treelet class 3 | 4 | use strict; 5 | use warnings; 6 | use Test::More tests => 6; 7 | 8 | #use Pod::Simple::Debug (6); 9 | 10 | use Pod::Simple::LinkSection; 11 | use Pod::Simple::BlackBox; # for its pretty() 12 | 13 | my $bare_treelet = 14 | ['B', {'pie' => 'no'}, 15 | 'a', 16 | ['C', {'bzrok' => 'plip'}, 17 | 'b' 18 | ], 19 | 'c' 20 | ] 21 | ; 22 | my $treelet = Pod::Simple::LinkSection->new($bare_treelet); 23 | 24 | # Make sure they're not the same 25 | 26 | is ref($bare_treelet), 'ARRAY'; 27 | is ref($treelet), 'Pod::Simple::LinkSection'; 28 | 29 | print "# Testing stringification...\n"; 30 | 31 | is $treelet->stringify, 'abc'; # explicit 32 | is join('', $treelet), 'abc'; # implicit 33 | 34 | 35 | print "# Testing non-coreferentiality...\n"; 36 | { 37 | my @stack = ($bare_treelet); 38 | my $this; 39 | while(@stack) { 40 | $this = shift @stack; 41 | if(ref($this || '') eq 'ARRAY') { 42 | push @stack, splice @$this; 43 | push @$this, ("BAD!") x 3; 44 | } elsif(ref($this || '') eq 'Pod::Simple::LinkSection') { 45 | push @stack, splice @$this; 46 | push @$this, ("BAD!") x 3; 47 | } elsif(ref($this || '') eq 'HASH') { 48 | %$this = (); 49 | } 50 | } 51 | # These will fail if $treelet and $bare_treelet are coreferential, 52 | # since we just conspicuously nuked $bare_treelet 53 | 54 | is $treelet->stringify, 'abc'; # explicit 55 | is join('', $treelet), 'abc'; # implicit 56 | } 57 | -------------------------------------------------------------------------------- /t/output.t: -------------------------------------------------------------------------------- 1 | # t/output.t - Check output_string. 2 | # 3 | use strict; 4 | use warnings; 5 | use Test::More tests => 36; 6 | 7 | use File::Spec; 8 | use File::Basename (); 9 | 10 | my $t_dir = File::Basename::dirname(File::Spec->rel2abs(__FILE__)); 11 | 12 | for my $format (qw(XHTML HTML Text RTF)) { 13 | my $class = "Pod::Simple::$format"; 14 | use_ok $class or next; 15 | ok my $parser = $class->new, "Construct $format parser"; 16 | 17 | # Try parse_string_document(). 18 | my $output = ''; 19 | ok $parser->output_string(\$output), "Set $format output string"; 20 | ok $parser->parse_string_document( "=head1 Poit!" ), 21 | "Parse to $format via parse_string_document()"; 22 | like $output, qr{Poit!}, 23 | "Should have $format output from parse_string_document()"; 24 | 25 | # Try parse_file(). 26 | ok $parser = $class->new, "Construct another $format parser"; 27 | $output = ''; 28 | ok $parser->output_string(\$output), "Set $format output string again"; 29 | ok $parser->parse_file(File::Spec->catfile($t_dir, qw(testlib1 zikzik.pod))), 30 | "Parse to $format via parse_file()"; 31 | like $output, qr{This is just a test file}, 32 | "Should have $format output from parse_file"; 33 | } 34 | -------------------------------------------------------------------------------- /t/pulltitl.t: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/perl-pod/pod-simple/00192234381dec835a16bc4ec786266ed0f0690b/t/pulltitl.t -------------------------------------------------------------------------------- /t/reinit.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More tests => 5; 4 | 5 | use File::Spec; 6 | use File::Basename (); 7 | 8 | use Pod::Simple::Text; 9 | $Pod::Simple::Text::FREAKYMODE = 1; 10 | 11 | my $parser = Pod::Simple::Text->new(); 12 | 13 | foreach my $file ( 14 | "junk1.pod", 15 | "junk2.pod", 16 | "perlcyg.pod", 17 | "perlfaq.pod", 18 | "perlvar.pod", 19 | ) { 20 | my $full_file = File::Spec->catfile(File::Basename::dirname(File::Spec->rel2abs(__FILE__)), $file); 21 | 22 | unless(-e $full_file) { 23 | ok 0; 24 | print "# But $full_file doesn't exist!!\n"; 25 | next; 26 | } 27 | 28 | my $precooked = $full_file; 29 | my $outstring; 30 | my $compstring; 31 | $precooked =~ s<\.pod>s; 32 | $parser->reinit; 33 | $parser->output_string(\$outstring); 34 | $parser->parse_file($full_file); 35 | 36 | open(IN, $precooked) or die "Can't read-open $precooked: $!"; 37 | { 38 | local $/; 39 | $compstring = ; 40 | } 41 | close(IN); 42 | 43 | for ($outstring,$compstring) { s/\s+/ /g; s/^\s+//s; s/\s+$//s; } 44 | 45 | if($outstring eq $compstring) { 46 | ok 1; 47 | next; 48 | } elsif( do{ 49 | for ($outstring, $compstring) { tr/ //d; }; 50 | $outstring eq $compstring; 51 | }){ 52 | print "# Differ only in whitespace.\n"; 53 | ok 1; 54 | next; 55 | } else { 56 | 57 | my $x = $outstring ^ $compstring; 58 | $x =~ m/^(\x00*)/s or die; 59 | my $at = length($1); 60 | print "# Difference at byte $at...\n"; 61 | if($at > 10) { 62 | $at -= 5; 63 | } 64 | { 65 | print "# ", substr($outstring,$at,20), "\n"; 66 | print "# ", substr($compstring,$at,20), "\n"; 67 | print "# ^..."; 68 | } 69 | 70 | ok 0; 71 | printf "# Unequal lengths %s and %s\n", length($outstring), length($compstring); 72 | next; 73 | } 74 | } 75 | -------------------------------------------------------------------------------- /t/render.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More tests => 25; 4 | use Pod::Simple::TextContent; 5 | use Pod::Simple::Text; 6 | 7 | BEGIN { 8 | *mytime = defined(&Win32::GetTickCount) 9 | ? sub () {Win32::GetTickCount() / 1000} 10 | : sub () {time()} 11 | } 12 | 13 | $Pod::Simple::Text::FREAKYMODE = 1; 14 | use Pod::Simple::TiedOutFH (); 15 | 16 | use File::Spec; 17 | use File::Basename (); 18 | 19 | my $outfile = '10000'; 20 | 21 | foreach my $file ( 22 | "junk1.pod", 23 | "junk2.pod", 24 | "perlcyg.pod", 25 | "perlfaq.pod", 26 | "perlvar.pod", 27 | ) { 28 | my $full_file = File::Spec->catfile(File::Basename::dirname(File::Spec->rel2abs(__FILE__)), $file); 29 | 30 | unless(-e $full_file) { 31 | ok 0; 32 | print "# But $full_file doesn't exist!!\n"; 33 | next; 34 | } 35 | 36 | my @out; 37 | my $precooked = $full_file; 38 | $precooked =~ s<\.pod>s; 39 | unless(-e $precooked) { 40 | ok 0; 41 | print "# But $precooked doesn't exist!!\n"; 42 | exit 1; 43 | } 44 | 45 | print "#\n#\n#\n###################\n# $file\n"; 46 | foreach my $class ('Pod::Simple::TextContent', 'Pod::Simple::Text') { 47 | my $p = $class->new; 48 | push @out, ''; 49 | $p->output_string(\$out[-1]); 50 | my $t = mytime(); 51 | $p->parse_file($full_file); 52 | printf "# %s %s %sb, %.03fs\n", 53 | ref($p), $full_file, length($out[-1]), mytime() - $t ; 54 | ok 1; 55 | } 56 | 57 | print "# Reading $precooked...\n"; 58 | open(IN, $precooked) or die "Can't read-open $precooked: $!"; 59 | { 60 | local $/; 61 | push @out, ; 62 | } 63 | close(IN); 64 | print "# ", length($out[-1]), " bytes pulled in.\n"; 65 | 66 | 67 | for (@out) { s/\s+/ /g; s/^\s+//s; s/\s+$//s; } 68 | 69 | my $faily = 0; 70 | print "#\n#Now comparing 1 and 2...\n"; 71 | $faily += compare2($out[0], $out[1]); 72 | print "#\n#Now comparing 2 and 3...\n"; 73 | $faily += compare2($out[1], $out[2]); 74 | print "#\n#Now comparing 1 and 3...\n"; 75 | $faily += compare2($out[0], $out[2]); 76 | 77 | if($faily) { 78 | ++$outfile; 79 | 80 | my @outnames = map $outfile . $_ , qw(0 1); 81 | open(OUT2, ">$outnames[0].txt") || die "Can't write-open $outnames[0].txt: $!"; 82 | 83 | foreach my $out (@out) { push @outnames, $outnames[-1]; ++$outnames[-1] }; 84 | pop @outnames; 85 | printf "# Writing to %s.txt .. %s.txt\n", $outnames[0], $outnames[-1]; 86 | shift @outnames; 87 | 88 | binmode(OUT2); 89 | foreach my $out (@out) { 90 | my $outname = shift @outnames; 91 | open(OUT, ">$outname.txt") || die "Can't write-open $outname.txt: $!"; 92 | binmode(OUT); 93 | print OUT $out, "\n"; 94 | print OUT2 $out, "\n"; 95 | close(OUT); 96 | } 97 | close(OUT2); 98 | } 99 | } 100 | 101 | sub compare2 { 102 | my @out = @_; 103 | if($out[0] eq $out[1]) { 104 | ok 1; 105 | return 0; 106 | } elsif( do{ 107 | for ($out[0], $out[1]) { tr/ //d; }; 108 | $out[0] eq $out[1]; 109 | }){ 110 | print "# Differ only in whitespace.\n"; 111 | ok 1; 112 | return 0; 113 | } else { 114 | #ok $out[0], $out[1]; 115 | 116 | my $x = $out[0] ^ $out[1]; 117 | $x =~ m/^(\x00*)/s or die; 118 | my $at = length($1); 119 | print "# Difference at byte $at...\n"; 120 | if($at > 10) { 121 | $at -= 5; 122 | } 123 | { 124 | print "# ", substr($out[0],$at,20), "\n"; 125 | print "# ", substr($out[1],$at,20), "\n"; 126 | print "# ^..."; 127 | } 128 | 129 | 130 | 131 | ok 0; 132 | printf "# Unequal lengths %s and %s\n", length($out[0]), length($out[1]); 133 | return 1; 134 | } 135 | } 136 | -------------------------------------------------------------------------------- /t/search05.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Pod::Simple::Search; 4 | use Test::More tests => 15; 5 | 6 | print "# Some basic sanity tests...\n"; 7 | 8 | my $x = Pod::Simple::Search->new; 9 | die "Couldn't make an object!?" unless ok defined $x; 10 | print "# New object: $x\n"; 11 | print "# Version: ", $x->VERSION, "\n"; 12 | ok defined $x->can('callback'); 13 | ok defined $x->can('dir_prefix'); 14 | ok defined $x->can('inc'); 15 | ok defined $x->can('laborious'); 16 | ok defined $x->can('limit_glob'); 17 | ok defined $x->can('limit_re'); 18 | ok defined $x->can('recurse'); 19 | ok defined $x->can('shadows'); 20 | ok defined $x->can('verbose'); 21 | ok defined $x->can('survey'); 22 | ok defined $x->can('_state_as_string'); 23 | ok defined $x->can('contains_pod'); 24 | ok defined $x->can('find'); 25 | ok defined $x->can('simplify_name'); 26 | 27 | print "# Testing state dumping...\n"; 28 | print $x->_state_as_string; 29 | $x->inc("I\nLike Pie!\t!!"); 30 | print $x->_state_as_string; 31 | 32 | -------------------------------------------------------------------------------- /t/search10.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More tests => 9; 4 | 5 | #sub Pod::Simple::Search::DEBUG () {5}; 6 | 7 | use Pod::Simple::Search; 8 | 9 | print "# ", __FILE__, 10 | ": Testing the surveying of a single specified docroot...\n"; 11 | 12 | my $x = Pod::Simple::Search->new; 13 | die "Couldn't make an object!?" unless ok defined $x; 14 | 15 | $x->inc(0); 16 | 17 | use File::Spec; 18 | use File::Basename (); 19 | 20 | my $t_dir = File::Basename::dirname(File::Spec->rel2abs(__FILE__)); 21 | 22 | my $here = File::Spec->catdir($t_dir, 'testlib1'); 23 | 24 | print "# OK, found the test corpus as $here\n"; 25 | 26 | print $x->_state_as_string; 27 | #$x->verbose(12); 28 | 29 | use Pod::Simple; 30 | *pretty = \&Pod::Simple::BlackBox::pretty; 31 | 32 | my($name2where, $where2name) = $x->survey($here); 33 | 34 | my $p = pretty( $where2name, $name2where )."\n"; 35 | $p =~ s/, +/,\n/g; 36 | $p =~ s/^/# /mg; 37 | print $p; 38 | 39 | require File::Spec->catfile($t_dir, 'ascii_order.pl'); 40 | 41 | { 42 | my $names = join "|", sort ascii_order values %$where2name; 43 | is $names, "Blorm|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Vliff|perlflif|perlthng|squaa|squaa::Glunk|squaa::Vliff|zikzik"; 44 | } 45 | 46 | { 47 | my $names = join "|", sort ascii_order keys %$name2where; 48 | is $names, "Blorm|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Vliff|perlflif|perlthng|squaa|squaa::Glunk|squaa::Vliff|zikzik"; 49 | } 50 | 51 | like( ($name2where->{'squaa'} || 'huh???'), qr/squaa\.pm$/); 52 | 53 | is grep( m/squaa\.pm/, keys %$where2name ), 1; 54 | 55 | ###### Now with recurse(0) 56 | 57 | print "# Testing the surveying of a single docroot without recursing...\n"; 58 | 59 | $x->recurse(0); 60 | ($name2where, $where2name) = $x->survey($here); 61 | 62 | $p = pretty( $where2name, $name2where )."\n"; 63 | $p =~ s/, +/,\n/g; 64 | $p =~ s/^/# /mg; 65 | print $p; 66 | 67 | { 68 | my $names = join "|", sort ascii_order values %$where2name; 69 | is $names, "Blorm|squaa|zikzik"; 70 | } 71 | 72 | { 73 | my $names = join "|", sort ascii_order keys %$name2where; 74 | is $names, "Blorm|squaa|zikzik"; 75 | } 76 | 77 | like( ($name2where->{'squaa'} || 'huh???'), qr/squaa\.pm$/); 78 | 79 | is grep( m/squaa\.pm/, keys %$where2name ), 1; 80 | -------------------------------------------------------------------------------- /t/search12.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More tests => 9; 4 | 5 | use Pod::Simple::Search; 6 | 7 | print "# ", __FILE__, 8 | ": Testing the surveying of the current directory...\n"; 9 | 10 | my $x = Pod::Simple::Search->new; 11 | die "Couldn't make an object!?" unless ok defined $x; 12 | 13 | $x->inc(0); 14 | 15 | use File::Spec; 16 | use File::Basename (); 17 | 18 | my $t_dir = File::Basename::dirname(File::Spec->rel2abs(__FILE__)); 19 | 20 | my $here = File::Spec->catdir($t_dir, 'testlib1'); 21 | 22 | print "# OK, found the test corpus as $here\n"; 23 | 24 | print $x->_state_as_string; 25 | #$x->verbose(12); 26 | 27 | use Pod::Simple; 28 | *pretty = \&Pod::Simple::BlackBox::pretty; 29 | 30 | my($name2where, $where2name) = $x->survey($here); 31 | 32 | my $p = pretty( $where2name, $name2where )."\n"; 33 | $p =~ s/, +/,\n/g; 34 | $p =~ s/^/# /mg; 35 | print $p; 36 | 37 | require File::Spec->catfile($t_dir, 'ascii_order.pl'); 38 | 39 | { 40 | my $names = join "|", sort ascii_order values %$where2name; 41 | is $names, "Blorm|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Vliff|perlflif|perlthng|squaa|squaa::Glunk|squaa::Vliff|zikzik"; 42 | } 43 | 44 | { 45 | my $names = join "|", sort ascii_order keys %$name2where; 46 | is $names, "Blorm|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Vliff|perlflif|perlthng|squaa|squaa::Glunk|squaa::Vliff|zikzik"; 47 | } 48 | 49 | like( ($name2where->{'squaa'} || 'huh???'), qr/squaa\.pm$/); 50 | 51 | is grep( m/squaa\.pm/, keys %$where2name ), 1; 52 | 53 | ###### Now with recurse(0) 54 | 55 | print "# Testing the surveying of a subdirectory with recursing off...\n"; 56 | 57 | $x->recurse(0); 58 | ($name2where, $where2name) = $x->survey( 59 | File::Spec->catdir($t_dir, 'testlib2')); 60 | 61 | $p = pretty( $where2name, $name2where )."\n"; 62 | $p =~ s/, +/,\n/g; 63 | $p =~ s/^/# /mg; 64 | print $p; 65 | 66 | { 67 | my $names = lc join "|", sort ascii_order values %$where2name; 68 | is $names, "suzzle"; 69 | } 70 | 71 | { 72 | my $names = lc join "|", sort ascii_order keys %$name2where; 73 | is $names, "suzzle"; 74 | } 75 | 76 | is( ($name2where->{'Vliff'} || 'huh???'), 'huh???'); 77 | 78 | is grep( m/Vliff\.pm/, keys %$where2name ), 0; 79 | -------------------------------------------------------------------------------- /t/search20.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Pod::Simple::Search; 4 | use Test::More tests => 9; 5 | 6 | print "# ", __FILE__, 7 | ": Testing the scanning of several (well, two) docroots...\n"; 8 | 9 | my $x = Pod::Simple::Search->new; 10 | die "Couldn't make an object!?" unless ok defined $x; 11 | 12 | $x->inc(0); 13 | 14 | $x->callback(sub { 15 | print "# ", join(" ", map "{$_}", @_), "\n"; 16 | return; 17 | }); 18 | 19 | use File::Spec; 20 | use File::Basename (); 21 | 22 | my $t_dir = File::Basename::dirname(File::Spec->rel2abs(__FILE__)); 23 | 24 | my $here1 = File::Spec->catdir($t_dir, 'testlib1'); 25 | my $here2 = File::Spec->catdir($t_dir, 'testlib2'); 26 | 27 | print "# OK, found the test corpora\n# as $here1\n# and $here2\n"; 28 | 29 | print $x->_state_as_string; 30 | #$x->verbose(12); 31 | 32 | use Pod::Simple; 33 | *pretty = \&Pod::Simple::BlackBox::pretty; 34 | 35 | print "# OK, starting run...\n# [[\n"; 36 | my($name2where, $where2name) = $x->survey($here1, $here2); 37 | print "# ]]\n#OK, run done.\n"; 38 | 39 | my $p = pretty( $where2name, $name2where )."\n"; 40 | $p =~ s/, +/,\n/g; 41 | $p =~ s/^/# /mg; 42 | print $p; 43 | 44 | require File::Spec->catfile($t_dir, 'ascii_order.pl'); 45 | 46 | SKIP: { 47 | skip '-- case may or may not be preserved', 2 48 | if $^O eq 'VMS'; 49 | 50 | { 51 | my $names = join "|", sort ascii_order values %$where2name; 52 | is $names, 53 | "Blorm|Suzzle|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Vliff|perlflif|perlthng|perlzoned|perlzuk|squaa|squaa::Glunk|squaa::Vliff|squaa::Wowo|zikzik"; 54 | } 55 | 56 | { 57 | my $names = join "|", sort ascii_order keys %$name2where; 58 | is $names, 59 | "Blorm|Suzzle|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Vliff|perlflif|perlthng|perlzoned|perlzuk|squaa|squaa::Glunk|squaa::Vliff|squaa::Wowo|zikzik"; 60 | } 61 | } 62 | 63 | like( ($name2where->{'squaa'} || 'huh???'), qr/squaa\.pm$/); 64 | 65 | is grep( m/squaa\.pm/, keys %$where2name ), 1; 66 | 67 | ###### Now with recurse(0) 68 | 69 | $x->recurse(0); 70 | 71 | print "# OK, starting run without recurse...\n# [[\n"; 72 | ($name2where, $where2name) = $x->survey($here1, $here2); 73 | print "# ]]\n#OK, run without recurse done.\n"; 74 | 75 | $p = pretty( $where2name, $name2where )."\n"; 76 | $p =~ s/, +/,\n/g; 77 | $p =~ s/^/# /mg; 78 | print $p; 79 | 80 | SKIP: { 81 | skip '-- case may or may not be preserved', 2 82 | if $^O eq 'VMS'; 83 | 84 | { 85 | my $names = join "|", sort ascii_order values %$where2name; 86 | is $names, 87 | "Blorm|Suzzle|squaa|zikzik"; 88 | } 89 | 90 | { 91 | my $names = join "|", sort ascii_order keys %$name2where; 92 | is $names, 93 | "Blorm|Suzzle|squaa|zikzik"; 94 | } 95 | } 96 | 97 | like( ($name2where->{'squaa'} || 'huh???'), qr/squaa\.pm$/); 98 | 99 | is grep( m/squaa\.pm/, keys %$where2name ), 1; 100 | -------------------------------------------------------------------------------- /t/search22.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More tests => 13; 4 | 5 | use Pod::Simple::Search; 6 | 7 | print "# ", __FILE__, 8 | ": Testing the scanning of several docroots...\n"; 9 | 10 | my $x = Pod::Simple::Search->new; 11 | die "Couldn't make an object!?" unless ok defined $x; 12 | 13 | $x->inc(0); 14 | $x->shadows(1); 15 | 16 | use File::Spec; 17 | use File::Basename (); 18 | 19 | my $t_dir = File::Basename::dirname(File::Spec->rel2abs(__FILE__)); 20 | 21 | my $here1 = File::Spec->catdir($t_dir, 'testlib1'); 22 | my $here2 = File::Spec->catdir($t_dir, 'testlib2'); 23 | my $here3 = File::Spec->catdir($t_dir, 'testlib3'); 24 | 25 | print "# OK, found the test corpora\n# as $here1\n# and $here2\n# and $here3\n#\n"; 26 | 27 | print $x->_state_as_string; 28 | #$x->verbose(12); 29 | 30 | use Pod::Simple; 31 | *pretty = \&Pod::Simple::BlackBox::pretty; 32 | 33 | my($name2where, $where2name) = $x->survey($here1, $here2, $here3); 34 | 35 | my $p = pretty( $where2name, $name2where )."\n"; 36 | $p =~ s/, +/,\n/g; 37 | $p =~ s/^/# /mg; 38 | print $p; 39 | 40 | require File::Spec->catfile($t_dir, 'ascii_order.pl'); 41 | 42 | SKIP: { 43 | skip '-- case may or may not be preserved', 2 44 | if $^O eq 'VMS'; 45 | 46 | { 47 | print "# won't show any shadows, since we're just looking at the name2where keys\n"; 48 | my $names = join "|", sort ascii_order keys %$name2where; 49 | 50 | is $names, 51 | "Blorm|Suzzle|Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Vliff|perlflif|perlthng|perlzoned|perlzuk|squaa|squaa::Glunk|squaa::Vliff|squaa::Wowo|zikzik"; 52 | } 53 | 54 | { 55 | print "# but here we'll see shadowing:\n"; 56 | my $names = join "|", sort ascii_order values %$where2name; 57 | is $names, 58 | "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"; 59 | } 60 | } 61 | 62 | { 63 | my %count; 64 | for(values %$where2name) { ++$count{$_} }; 65 | #print pretty(\%count), "\n\n"; 66 | delete @count{ grep $count{$_} < 2, keys %count }; 67 | my $shadowed = join "|", sort ascii_order keys %count; 68 | is $shadowed, "hinkhonk::Glunk|hinkhonk::Vliff|perlthng|squaa::Vliff"; 69 | 70 | sub thar { print "# Seen $_[0] :\n", map "# {$_}\n", sort ascii_order grep $where2name->{$_} eq $_[0],keys %$where2name; return; } 71 | 72 | is $count{'perlthng'}, 2; 73 | thar 'perlthng'; 74 | is $count{'squaa::Vliff'}, 3; 75 | thar 'squaa::Vliff'; 76 | } 77 | 78 | 79 | like( ($name2where->{'squaa'} || 'huh???'), qr/squaa\.pm$/); 80 | 81 | is grep( m/squaa\.pm/, keys %$where2name ), 1; 82 | 83 | like( ($name2where->{'perlthng'} || 'huh???'), qr/[^\^]testlib1/ ); 84 | like( ($name2where->{'squaa::Vliff'} || 'huh???'), qr/[^\^]testlib1/ ); 85 | 86 | SKIP: { 87 | skip '-- case may or may not be preserved', 1 88 | if $^O eq 'VMS'; 89 | 90 | # Some sanity: 91 | like 92 | +($name2where->{'squaa::Wowo'} || 'huh???'), 93 | qr/testlib2/; 94 | } 95 | 96 | my $in_pods = $x->find('perlzoned', $here2); 97 | like $in_pods, qr{^\Q$here2\E}; 98 | like $in_pods, qr{perlzoned.pod$}; 99 | -------------------------------------------------------------------------------- /t/search25.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More tests => 8; 4 | 5 | #sub Pod::Simple::Search::DEBUG () {5}; 6 | 7 | use Pod::Simple::Search; 8 | 9 | print "# ", __FILE__, 10 | ": Testing limit_glob ...\n"; 11 | 12 | my $x = Pod::Simple::Search->new; 13 | die "Couldn't make an object!?" unless ok defined $x; 14 | 15 | $x->inc(0); 16 | $x->shadows(1); 17 | 18 | use File::Spec; 19 | use File::Basename (); 20 | 21 | my $t_dir = File::Basename::dirname(File::Spec->rel2abs(__FILE__)); 22 | 23 | my $here1 = File::Spec->catdir($t_dir, 'testlib1'); 24 | my $here2 = File::Spec->catdir($t_dir, 'testlib2'); 25 | my $here3 = File::Spec->catdir($t_dir, 'testlib3'); 26 | 27 | print "# OK, found the test corpora\n# as $here1\n# and $here2\n# and $here3\n#\n"; 28 | 29 | print $x->_state_as_string; 30 | #$x->verbose(12); 31 | 32 | use Pod::Simple; 33 | *pretty = \&Pod::Simple::BlackBox::pretty; 34 | 35 | my $glob = 'squaa::*'; 36 | print "# Limiting to $glob\n"; 37 | $x->limit_glob($glob); 38 | 39 | my($name2where, $where2name) = $x->survey($here1, $here2, $here3); 40 | 41 | my $p = pretty( $where2name, $name2where )."\n"; 42 | $p =~ s/, +/,\n/g; 43 | $p =~ s/^/# /mg; 44 | print $p; 45 | 46 | SKIP: { 47 | skip '-- case may or may not be preserved', 2 48 | if $^O eq 'VMS'; 49 | 50 | { 51 | my $names = join "|", sort keys %$name2where; 52 | is $names, 53 | "squaa::Glunk|squaa::Vliff|squaa::Wowo"; 54 | } 55 | 56 | { 57 | my $names = join "|", sort values %$where2name; 58 | is $names, 59 | "squaa::Glunk|squaa::Vliff|squaa::Vliff|squaa::Vliff|squaa::Wowo"; 60 | } 61 | } 62 | 63 | my %count; 64 | for(values %$where2name) { ++$count{$_} }; 65 | #print pretty(\%count), "\n\n"; 66 | delete @count{ grep $count{$_} < 2, keys %count }; 67 | my $shadowed = join "|", sort keys %count; 68 | is $shadowed, "squaa::Vliff"; 69 | 70 | sub thar { print "# Seen $_[0] :\n", map "# {$_}\n", sort grep $where2name->{$_} eq $_[0],keys %$where2name; return; } 71 | 72 | is $count{'squaa::Vliff'}, 3; 73 | thar 'squaa::Vliff'; 74 | 75 | 76 | ok ! $name2where->{'squaa'}; # because squaa.pm isn't squaa::* 77 | 78 | like( ($name2where->{'squaa::Vliff'} || 'huh???'), qr/[^\^]testlib1/ ); 79 | 80 | SKIP: { 81 | skip '-- case may or may not be preserved', 1 82 | if $^O eq 'VMS'; 83 | 84 | like +($name2where->{'squaa::Wowo'} || 'huh???'), 85 | qr/testlib2/; 86 | } 87 | -------------------------------------------------------------------------------- /t/search26.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Pod::Simple::Search; 4 | use Test::More tests => 3; 5 | 6 | # 7 | # "kleene" rhymes with "zany". It's a fact! 8 | # 9 | 10 | 11 | print "# ", __FILE__, 12 | ": Testing limit_glob ...\n"; 13 | 14 | my $x = Pod::Simple::Search->new; 15 | die "Couldn't make an object!?" unless ok defined $x; 16 | 17 | $x->inc(0); 18 | $x->shadows(1); 19 | 20 | use File::Spec; 21 | use File::Basename (); 22 | 23 | my $t_dir = File::Basename::dirname(File::Spec->rel2abs(__FILE__)); 24 | 25 | my $here1 = File::Spec->catdir($t_dir, 'testlib1'); 26 | my $here2 = File::Spec->catdir($t_dir, 'testlib2'); 27 | my $here3 = File::Spec->catdir($t_dir, 'testlib3'); 28 | 29 | print "# OK, found the test corpora\n# as $here1\n# and $here2\n# and $here3\n#\n"; 30 | 31 | print $x->_state_as_string; 32 | #$x->verbose(12); 33 | 34 | use Pod::Simple; 35 | *pretty = \&Pod::Simple::BlackBox::pretty; 36 | 37 | my $glob = '*k'; 38 | print "# Limiting to $glob\n"; 39 | $x->limit_glob($glob); 40 | 41 | my($name2where, $where2name) = $x->survey($here1, $here2, $here3); 42 | 43 | my $p = pretty( $where2name, $name2where )."\n"; 44 | $p =~ s/, +/,\n/g; 45 | $p =~ s/^/# /mg; 46 | print $p; 47 | 48 | require File::Spec->catfile($t_dir, 'ascii_order.pl'); 49 | 50 | { 51 | my $names = join "|", sort ascii_order keys %$name2where; 52 | is $names, "Zonk::Pronk|hinkhonk::Glunk|perlzuk|squaa::Glunk|zikzik"; 53 | } 54 | 55 | { 56 | my $names = join "|", sort ascii_order values %$where2name; 57 | is $names, "Zonk::Pronk|hinkhonk::Glunk|hinkhonk::Glunk|perlzuk|squaa::Glunk|zikzik"; 58 | } 59 | -------------------------------------------------------------------------------- /t/search27.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Pod::Simple::Search; 4 | use Test::More tests => 8; 5 | 6 | print "# ", __FILE__, 7 | ": Testing limit_glob ...\n"; 8 | 9 | my $x = Pod::Simple::Search->new; 10 | die "Couldn't make an object!?" unless ok defined $x; 11 | 12 | $x->inc(0); 13 | $x->shadows(1); 14 | 15 | use File::Spec; 16 | use File::Basename (); 17 | 18 | my $t_dir = File::Basename::dirname(File::Spec->rel2abs(__FILE__)); 19 | 20 | my $here1 = File::Spec->catdir($t_dir, 'testlib1'); 21 | my $here2 = File::Spec->catdir($t_dir, 'testlib2'); 22 | my $here3 = File::Spec->catdir($t_dir, 'testlib3'); 23 | 24 | print "# OK, found the test corpora\n# as $here1\n# and $here2\n# and $here3\n#\n"; 25 | 26 | print $x->_state_as_string; 27 | #$x->verbose(12); 28 | 29 | use Pod::Simple; 30 | *pretty = \&Pod::Simple::BlackBox::pretty; 31 | 32 | my $glob = 'squaa*'; 33 | print "# Limiting to $glob\n"; 34 | $x->limit_glob($glob); 35 | 36 | my($name2where, $where2name) = $x->survey($here1, $here2, $here3); 37 | 38 | my $p = pretty( $where2name, $name2where )."\n"; 39 | $p =~ s/, +/,\n/g; 40 | $p =~ s/^/# /mg; 41 | print $p; 42 | 43 | SKIP: { 44 | skip '-- case may or may not be preserved', 2 45 | if $^O eq 'VMS'; 46 | 47 | { 48 | my $names = join "|", sort keys %$name2where; 49 | is $names, 50 | "squaa|squaa::Glunk|squaa::Vliff|squaa::Wowo"; 51 | } 52 | 53 | { 54 | my $names = join "|", sort values %$where2name; 55 | is $names, 56 | "squaa|squaa::Glunk|squaa::Vliff|squaa::Vliff|squaa::Vliff|squaa::Wowo"; 57 | } 58 | } 59 | 60 | my %count; 61 | for(values %$where2name) { ++$count{$_} }; 62 | #print pretty(\%count), "\n\n"; 63 | delete @count{ grep $count{$_} < 2, keys %count }; 64 | my $shadowed = join "|", sort keys %count; 65 | ok $shadowed, "squaa::Vliff"; 66 | 67 | sub thar { print "# Seen $_[0] :\n", map "# {$_}\n", sort grep $where2name->{$_} eq $_[0],keys %$where2name; return; } 68 | 69 | is $count{'squaa::Vliff'}, 3; 70 | thar 'squaa::Vliff'; 71 | 72 | 73 | ok $name2where->{'squaa'}; # because squaa.pm IS squaa* 74 | 75 | like( ($name2where->{'squaa::Vliff'} || 'huh???'), qr/[^\^]testlib1/ ); 76 | 77 | SKIP: { 78 | skip '-- case may or may not be preserved', 1 79 | if $^O eq 'VMS'; 80 | 81 | like +($name2where->{'squaa::Wowo'} || 'huh???'), 82 | qr/testlib2/; 83 | } 84 | -------------------------------------------------------------------------------- /t/search28.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Pod::Simple::Search; 4 | use Test::More tests => 2; 5 | 6 | print "# ", __FILE__, 7 | ": Testing limit_glob ...\n"; 8 | 9 | my $x = Pod::Simple::Search->new; 10 | die "Couldn't make an object!?" unless ok defined $x; 11 | 12 | $x->inc(0); 13 | $x->shadows(1); 14 | 15 | use File::Spec; 16 | use File::Basename (); 17 | 18 | my $t_dir = File::Basename::dirname(File::Spec->rel2abs(__FILE__)); 19 | 20 | my $here1 = File::Spec->catdir($t_dir, 'testlib1'); 21 | my $here2 = File::Spec->catdir($t_dir, 'testlib2'); 22 | my $here3 = File::Spec->catdir($t_dir, 'testlib3'); 23 | 24 | print "# OK, found the test corpora\n# as $here1\n# and $here2\n# and $here3\n#\n"; 25 | 26 | print $x->_state_as_string; 27 | #$x->verbose(12); 28 | 29 | use Pod::Simple; 30 | *pretty = \&Pod::Simple::BlackBox::pretty; 31 | 32 | my $glob = '*z*k*'; 33 | print "# Limiting to $glob\n"; 34 | $x->limit_glob($glob); 35 | 36 | my($name2where, $where2name) = $x->survey($here1, $here2, $here3); 37 | 38 | my $p = pretty( $where2name, $name2where )."\n"; 39 | $p =~ s/, +/,\n/g; 40 | $p =~ s/^/# /mg; 41 | print $p; 42 | 43 | require File::Spec->catfile($t_dir, 'ascii_order.pl'); 44 | 45 | { 46 | my $names = join "|", sort ascii_order values %$where2name; 47 | is $names, "Zonk::Pronk|perlzuk|zikzik"; 48 | } 49 | -------------------------------------------------------------------------------- /t/search29.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Pod::Simple::Search; 4 | use Test::More tests => 2; 5 | 6 | print "# ", __FILE__, 7 | ": Testing limit_glob ...\n"; 8 | 9 | my $x = Pod::Simple::Search->new; 10 | die "Couldn't make an object!?" unless ok defined $x; 11 | 12 | $x->inc(0); 13 | $x->shadows(1); 14 | 15 | use File::Spec; 16 | use File::Basename (); 17 | 18 | my $t_dir = File::Basename::dirname(File::Spec->rel2abs(__FILE__)); 19 | 20 | my $here1 = File::Spec->catdir($t_dir, 'testlib1'); 21 | my $here2 = File::Spec->catdir($t_dir, 'testlib2'); 22 | my $here3 = File::Spec->catdir($t_dir, 'testlib3'); 23 | 24 | print "# OK, found the test corpora\n# as $here1\n# and $here2\n# and $here3\n#\n"; 25 | 26 | print $x->_state_as_string; 27 | #$x->verbose(12); 28 | 29 | use Pod::Simple; 30 | *pretty = \&Pod::Simple::BlackBox::pretty; 31 | 32 | my $glob = '*z?k*'; 33 | print "# Limiting to $glob\n"; 34 | $x->limit_glob($glob); 35 | 36 | my($name2where, $where2name) = $x->survey($here1, $here2, $here3); 37 | 38 | my $p = pretty( $where2name, $name2where )."\n"; 39 | $p =~ s/, +/,\n/g; 40 | $p =~ s/^/# /mg; 41 | print $p; 42 | 43 | { 44 | my $names = join "|", sort values %$where2name; 45 | is $names, "perlzuk|zikzik"; 46 | } 47 | -------------------------------------------------------------------------------- /t/search50.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use Test::More skip_all => 'slow'; 5 | 6 | #sub Pod::Simple::Search::DEBUG () {5}; 7 | 8 | use Pod::Simple::Search; 9 | 10 | # print "# Test the scanning of the whole of \@INC ...\n"; 11 | 12 | my $x = Pod::Simple::Search->new; 13 | die "Couldn't make an object!?" unless ok defined $x; 14 | ok $x->inc; # make sure inc=1 is the default 15 | # print $x->_state_as_string; 16 | #$x->verbose(12); 17 | 18 | use Pod::Simple; 19 | *pretty = \&Pod::Simple::BlackBox::pretty; 20 | *pretty = \&Pod::Simple::BlackBox::pretty; # avoid 'once' warning 21 | 22 | my $found = 0; 23 | $x->callback(sub { 24 | # print "# ", join(" ", map "{$_}", @_), "\n"; 25 | ++$found; 26 | return; 27 | }); 28 | 29 | # print "# \@INC == @INC\n"; 30 | 31 | my $t = time(); my($name2where, $where2name) = $x->survey(); 32 | $t = time() - $t; 33 | ok $found; 34 | 35 | # print "# Found $found items in $t seconds!\n# See...\n"; 36 | 37 | # my $p = pretty( $where2name, $name2where )."\n"; 38 | # $p =~ s/, +/,\n/g; 39 | # $p =~ s/^/# /mg; 40 | # print $p; 41 | 42 | # print "# OK, making sure strict and strict.pm were in there...\n"; 43 | # print "# (On Debian-based distributions Pod is stripped from\n", 44 | # "# strict.pm, so skip these tests.)\n"; 45 | my $nopod = not exists ($name2where->{'strict'}); 46 | SKIP: { 47 | skip 'No Pod for strict.pm', 3 if $nopod; 48 | like $name2where->{'strict'}, qr/strict\.(pod|pm)$/; 49 | ok grep( m/strict\.(pod|pm)/, keys %$where2name); 50 | 51 | ok my $strictpath = $name2where->{'strict'}, 'Should have strict path'; 52 | my @x = ($x->find('strict')||'(nil)', $strictpath); 53 | # print "# Comparing \"$x[0]\" to \"$x[1]\"\n"; 54 | for(@x) { s{[/\\]}{/}g; } 55 | # print "# => \"$x[0]\" to \"$x[1]\"\n"; 56 | is $x[0], $x[1], " find('strict') should match survey's name2where{strict}"; 57 | } 58 | 59 | # print "# Test again on a module we know is present, in case the 60 | # strict.pm tests were skipped...\n"; 61 | 62 | # Search for all files in $name2where. 63 | while (my ($testmod, $testpath) = each %{ $name2where }) { 64 | unless ( $testmod ) { 65 | fail; # no 'thatpath/.pm' means can't test find() 66 | next; 67 | } 68 | my @x = ($x->find($testmod)||'(nil)', $testpath); 69 | # print "# Comparing \"$x[0]\" to \"$x[1]\"\n"; 70 | my $result = File::Spec->rel2abs($x[0]); 71 | # print "# => \"$result\" to \"$x[1]\"\n"; 72 | if ($result ne $x[1]) { 73 | TODO: { 74 | local $TODO = 'unstable Pod::Simple::Search'; 75 | is( $result, $x[1], 76 | " find('$testmod') should match survey's name2where{$testmod}"); 77 | } 78 | } else { 79 | is( $result, $x[1], 80 | " find('$testmod') should match survey's name2where{$testmod}"); 81 | } 82 | } 83 | 84 | done_testing; 85 | -------------------------------------------------------------------------------- /t/search60.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Pod::Simple::Search; 4 | use Test::More tests => 3; 5 | 6 | print "# ", __FILE__, 7 | ": Testing forced case sensitivity ...\n"; 8 | 9 | my $x = Pod::Simple::Search->new; 10 | die "Couldn't make an object!?" unless ok defined $x; 11 | 12 | $x->inc(0); 13 | $x->is_case_insensitive(0); 14 | 15 | use File::Spec; 16 | use File::Basename (); 17 | 18 | my $t_dir = File::Basename::dirname(File::Spec->rel2abs(__FILE__)); 19 | 20 | my $A = File::Spec->catdir($t_dir, 'search60', 'A'); 21 | my $B = File::Spec->catdir($t_dir, 'search60', 'B'); 22 | 23 | print "# OK, found the test corpora\n# as $A\n# and $B\n#\n"; 24 | 25 | my($name2where, $where2name) = $x->survey($A, $B); 26 | like ($name2where->{x}, qr{^\Q$A\E[\\/]x\.pod$}); 27 | 28 | like ($name2where->{X}, qr{^\Q$B\E[\\/]X\.pod$}); 29 | -------------------------------------------------------------------------------- /t/search60/A/x.pod: -------------------------------------------------------------------------------- 1 | =head1 x 2 | -------------------------------------------------------------------------------- /t/search60/B/X.pod: -------------------------------------------------------------------------------- 1 | =head1 X 2 | -------------------------------------------------------------------------------- /t/stree.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More tests => 30; 4 | 5 | #use Pod::Simple::Debug (6); 6 | 7 | use Pod::Simple::SimpleTree; 8 | print "# Pod::Simple version $Pod::Simple::VERSION\n"; 9 | 10 | my $hashes_dont_matter = 0; 11 | 12 | 13 | my $x = 'Pod::Simple::SimpleTree'; 14 | sub x { 15 | my $p = $x->new; 16 | $p->merge_text(1); 17 | $p->parse_string_document( shift )->root; 18 | } 19 | 20 | print "# a bit of meta-testing...\n"; 21 | ok( deq( 1, 1 )); 22 | ok(!deq( 2, 1 )); 23 | 24 | ok( deq( undef, undef )); 25 | ok(!deq( undef, 1 )); 26 | ok(!deq( 1, undef )); 27 | 28 | ok( deq( [ ], [ ] )); 29 | ok(!deq( [ ], 1 )); 30 | ok(!deq( 1, [ ] )); 31 | 32 | ok( deq( [1], [1] )); 33 | ok(!deq( [1], 1 )); 34 | ok(!deq( 1, [1] )); 35 | ok(!deq( [1], [ ] )); 36 | ok(!deq( [ ], [1] )); 37 | ok(!deq( [1], [2] )); 38 | ok(!deq( [2], [1] )); 39 | 40 | ok( deq( [ ], [ ] )); 41 | ok(!deq( [ ], 1 )); 42 | ok(!deq( 1, [ ] )); 43 | 44 | ok( deq( {}, {} )); 45 | ok(!deq( {}, 1 )); 46 | ok(!deq( 1, {} )); 47 | ok(!deq( {1,2}, {} )); 48 | ok(!deq( {}, {1,2} )); 49 | ok( deq( {1,2}, {1,2} )); 50 | ok(!deq( {2,1}, {1,2} )); 51 | 52 | 53 | 54 | 55 | print '# ', Pod::Simple::pretty(x( "=pod\n\nI like pie.\n" )), "\n"; 56 | print "# Making sure we get a tree at all...\n"; 57 | ok x( "=pod\n\nI like pie.\n" ); 58 | 59 | 60 | print "# Some real tests...\n"; 61 | ok( deq( x( "=pod\n\nI like pie.\n"), 62 | [ "Document", {"start_line"=>1}, 63 | [ "Para", {"start_line"=>3}, 64 | "I like pie." 65 | ] 66 | ] 67 | )); 68 | 69 | $hashes_dont_matter = 1; 70 | 71 | ok( deq( x("=pod\n\nB\n"), 72 | [ "Document", {}, 73 | [ "Para", {}, 74 | ["B", {}, 75 | "foo " 76 | ] 77 | ] 78 | ] 79 | )); 80 | 81 | 82 | ok( deq( x("=pod\n\nBXI>\n"), 83 | [ "Document", {}, 84 | [ "Para", {}, 85 | ["B", {}, 86 | "pie", 87 | ['F',{}, 'zorch'], 88 | ['X',{}, 'foo' ], 89 | ['I',{}, 'pling'], 90 | ] 91 | ] 92 | ] 93 | )); 94 | 95 | ok( deq( x("=over\n\n=item BXI>!\n\n=back"), 96 | [ "Document", {}, 97 | [ "over-text", {}, 98 | [ "item-text", {}, 99 | ["B", {}, 100 | "pie", 101 | ['F',{}, 'zorch'], 102 | ['X',{}, 'foo' ], 103 | ['I',{}, 'pling'], 104 | ], 105 | '!' 106 | ] 107 | ] 108 | ] 109 | )); 110 | 111 | sub deq { # deep-equals 112 | #print "# deq ", Pod::Simple::pretty($_[0], $_[1]), "\n"; 113 | return 1 unless defined $_[0] or defined $_[1]; # two undefs = same 114 | return '' if defined $_[0] xor defined $_[1]; 115 | return '' if ref($_[0]) ne ref($_[1]); # unequal referentiality 116 | return $_[0] eq $_[1] unless ref $_[0]; 117 | # So it's a ref: 118 | if(UNIVERSAL::isa($_[0], 'ARRAY')) { 119 | return '' unless @{$_[0]} == @{$_[1]}; 120 | for(my $i = 0; $i < @{$_[0]}; $i++) { 121 | print("# NEQ ", Pod::Simple::pretty($_[0]), 122 | "\n# != ", Pod::Simple::pretty($_[1]), "\n"), 123 | return '' unless deq($_[0][$i], $_[1][$i]); # recurse! 124 | } 125 | return 1; 126 | } elsif(UNIVERSAL::isa($_[0], 'HASH')) { 127 | return 1 if $hashes_dont_matter; 128 | return '' unless keys %{$_[0]} == keys %{$_[1]}; 129 | foreach my $k (keys %{$_[0]}) { 130 | return '' unless exists $_[1]{$k}; 131 | return '' unless deq($_[0]{$k}, $_[1]{$k}); 132 | } 133 | return 1; 134 | } else { 135 | print "# I don't know how to deque $_[0] & $_[1]\n"; 136 | return 1; 137 | } 138 | } 139 | -------------------------------------------------------------------------------- /t/testlib1/Blorm.pm: -------------------------------------------------------------------------------- 1 | =head1 NAME 2 | 3 | Blorm -- blorpoesu 4 | 5 | =head1 DESCRIPTION 6 | 7 | This is just a test file. 8 | 9 | =cut 10 | 11 | -------------------------------------------------------------------------------- /t/testlib1/Zonk/Fiddle.txt: -------------------------------------------------------------------------------- 1 | 2 | This is just a dummy file. It's podless and shouldn't even be scanned for pod. 3 | 4 | 5 | -------------------------------------------------------------------------------- /t/testlib1/Zonk/Pronk.pm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/perl-pod/pod-simple/00192234381dec835a16bc4ec786266ed0f0690b/t/testlib1/Zonk/Pronk.pm -------------------------------------------------------------------------------- /t/testlib1/Zonk/Veng.pm: -------------------------------------------------------------------------------- 1 | 2 | # This is just a podless test file. 3 | 1; 4 | 5 | -------------------------------------------------------------------------------- /t/testlib1/hinkhonk/Glunk.pod: -------------------------------------------------------------------------------- 1 | 2 | =head1 NAME 3 | 4 | squaa::Glunk -- blorpoesu 5 | 6 | =head1 DESCRIPTION 7 | 8 | This is just a test file. 9 | 10 | =cut 11 | 12 | -------------------------------------------------------------------------------- /t/testlib1/hinkhonk/Vliff.pm: -------------------------------------------------------------------------------- 1 | 2 | =head1 NAME 3 | 4 | squaa::Vliff -- blorpoesu 5 | 6 | =head1 DESCRIPTION 7 | 8 | This is just a test file. 9 | 10 | =cut 11 | 12 | print "HOOBOY!\n"; 13 | 1; 14 | 15 | -------------------------------------------------------------------------------- /t/testlib1/hinkhonk/readme.txt: -------------------------------------------------------------------------------- 1 | This directory should never be scanned. 2 | -------------------------------------------------------------------------------- /t/testlib1/pod/perlflif.pod: -------------------------------------------------------------------------------- 1 | 2 | =head1 NAME 3 | 4 | perlthang - This is just some test file 5 | 6 | =cut 7 | 8 | -------------------------------------------------------------------------------- /t/testlib1/pod/perlthng.pod: -------------------------------------------------------------------------------- 1 | 2 | =head1 NAME 3 | 4 | perlthang - This is just some test file 5 | 6 | =cut 7 | 8 | -------------------------------------------------------------------------------- /t/testlib1/squaa.pm: -------------------------------------------------------------------------------- 1 | package squaa; 2 | 3 | =head1 NAME 4 | 5 | squaa -- blorpoesu 6 | 7 | =head1 DESCRIPTION 8 | 9 | This is just a test file. 10 | 11 | =cut 12 | 13 | -------------------------------------------------------------------------------- /t/testlib1/squaa/Glunk.pod: -------------------------------------------------------------------------------- 1 | 2 | =head1 NAME 3 | 4 | squaa::Glunk -- blorpoesu 5 | 6 | =head1 DESCRIPTION 7 | 8 | This is just a test file. 9 | 10 | =cut 11 | 12 | -------------------------------------------------------------------------------- /t/testlib1/squaa/Vliff.pm: -------------------------------------------------------------------------------- 1 | 2 | =head1 NAME 3 | 4 | squaa::Vliff -- blorpoesu 5 | 6 | =head1 DESCRIPTION 7 | 8 | This is just a test file. 9 | 10 | =cut 11 | 12 | print "HOOBOY!\n"; 13 | 1; 14 | 15 | -------------------------------------------------------------------------------- /t/testlib1/zikzik.pod: -------------------------------------------------------------------------------- 1 | =head1 NAME 2 | 3 | zikzik -- blorpoesu 4 | 5 | =head1 DESCRIPTION 6 | 7 | This is just a test file. 8 | 9 | =cut 10 | 11 | -------------------------------------------------------------------------------- /t/testlib2/Suzzle.pm: -------------------------------------------------------------------------------- 1 | 2 | 1; 3 | __END__ 4 | 5 | =head1 NAME 6 | 7 | Sizzlesuzzle -- hooboy, this is a test file too. 8 | 9 | =cut 10 | 11 | -------------------------------------------------------------------------------- /t/testlib2/hinkhonk/Glunk.pod: -------------------------------------------------------------------------------- 1 | 2 | =head1 NAME 3 | 4 | squaa::Glunk -- blorpoesu 5 | 6 | =head1 DESCRIPTION 7 | 8 | This is just a test file. 9 | 10 | =cut 11 | 12 | -------------------------------------------------------------------------------- /t/testlib2/hinkhonk/Vliff.pm: -------------------------------------------------------------------------------- 1 | 2 | =head1 NAME 3 | 4 | squaa::Vliff -- blorpoesu 5 | 6 | =head1 DESCRIPTION 7 | 8 | This is just a test file. 9 | 10 | =cut 11 | 12 | print "HOOBOY!\n"; 13 | 1; 14 | 15 | -------------------------------------------------------------------------------- /t/testlib2/hinkhonk/readme.txt: -------------------------------------------------------------------------------- 1 | This directory should never be scanned. 2 | -------------------------------------------------------------------------------- /t/testlib2/pod/perlthng.pod: -------------------------------------------------------------------------------- 1 | 2 | =head1 NAME 3 | 4 | perlthang - This is just some test file 5 | 6 | =cut 7 | 8 | -------------------------------------------------------------------------------- /t/testlib2/pod/perlzuk.pod: -------------------------------------------------------------------------------- 1 | 2 | =head1 NAME 3 | 4 | perlthang - This is just some test file 5 | 6 | =cut 7 | 8 | -------------------------------------------------------------------------------- /t/testlib2/pods/perlzoned.pod: -------------------------------------------------------------------------------- 1 | =head1 NAME 2 | 3 | perlzoned - This is just some test file 4 | 5 | =cut 6 | -------------------------------------------------------------------------------- /t/testlib2/squaa/Vliff.pm: -------------------------------------------------------------------------------- 1 | 2 | =head1 NAME 3 | 4 | squaa::Vliff -- blorpoesu 5 | 6 | =head1 DESCRIPTION 7 | 8 | This is just a test file. 9 | 10 | =cut 11 | 12 | print "HOOBOY!\n"; 13 | 1; 14 | 15 | -------------------------------------------------------------------------------- /t/testlib2/squaa/Wowo.pod: -------------------------------------------------------------------------------- 1 | 2 | =head1 NAME 3 | 4 | squaa::Glunk -- blorpoesu 5 | 6 | =head1 DESCRIPTION 7 | 8 | This is just a test file. 9 | 10 | =cut 11 | 12 | -------------------------------------------------------------------------------- /t/testlib3/squaa/Vliff.pm: -------------------------------------------------------------------------------- 1 | 2 | =head1 NAME 3 | 4 | squaa::Vliff -- blorpoesu 5 | 6 | =head1 DESCRIPTION 7 | 8 | This is just a test file. 9 | 10 | =cut 11 | 12 | print "HOOBOY!\n"; 13 | 1; 14 | 15 | -------------------------------------------------------------------------------- /t/tiedfh.t: -------------------------------------------------------------------------------- 1 | # Testing tied output filehandle 2 | use strict; 3 | use warnings; 4 | use Test::More tests => 6; 5 | 6 | use Pod::Simple::TiedOutFH; 7 | 8 | print "# Sanity test of Perl and Pod::Simple::TiedOutFH\n"; 9 | 10 | { 11 | my $x = 'abc'; 12 | my $out = Pod::Simple::TiedOutFH->handle_on($x); 13 | print $out "Puppies\n"; 14 | print $out "rrrrr"; 15 | print $out "uffuff!"; 16 | is $x, "abcPuppies\nrrrrruffuff!"; 17 | undef $out; 18 | is $x, "abcPuppies\nrrrrruffuff!"; 19 | } 20 | 21 | # Now test that we can have two different strings. 22 | { 23 | my $x1 = 'abc'; 24 | my $x2 = 'xyz'; 25 | my $out1 = Pod::Simple::TiedOutFH->handle_on($x1); 26 | my $out2 = Pod::Simple::TiedOutFH->handle_on($x2); 27 | 28 | print $out1 "Puppies\n"; 29 | print $out2 "Kitties\n"; 30 | print $out2 "mmmmm"; 31 | print $out1 "rrrrr"; 32 | print $out2 "iaooowwlllllllrrr!\n"; 33 | print $out1 "uffuff!"; 34 | 35 | is $x1, "abcPuppies\nrrrrruffuff!", "out1 test"; 36 | is $x2, "xyzKitties\nmmmmmiaooowwlllllllrrr!\n", "out2 test"; 37 | 38 | undef $out1; 39 | undef $out2; 40 | 41 | is $x1, "abcPuppies\nrrrrruffuff!", "out1 test"; 42 | is $x2, "xyzKitties\nmmmmmiaooowwlllllllrrr!\n", "out2 test"; 43 | } 44 | -------------------------------------------------------------------------------- /t/whine.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More tests => 6; 4 | 5 | { 6 | package Pod::Simple::ErrorFinder; 7 | use base 'Pod::Simple::DumpAsXML'; # arbitrary choice -- rjbs, 2013-04-16 8 | 9 | sub errors_for_input { 10 | my ($class, $input, $mutor) = @_; 11 | 12 | my $parser = $class->new; 13 | my $output = ''; 14 | $parser->output_string( \$output ); 15 | $parser->no_errata_section(1); 16 | $parser->parse_string_document( $input ); 17 | 18 | return $parser->errata_seen(); 19 | } 20 | } 21 | 22 | sub errors { Pod::Simple::ErrorFinder->errors_for_input(@_) } 23 | 24 | { 25 | my $errors = errors("=over 4\n\n=item 1\n\nHey\n\n"); 26 | is_deeply( 27 | $errors, 28 | { 1 => [ "=over without closing =back" ] }, 29 | "no closing =back", 30 | ); 31 | } 32 | 33 | { 34 | for my $l_code ('L< foo>', 'L< bar>') { 35 | my $input = "=pod\n\nAmbiguous space: $l_code\n"; 36 | my $errors = errors("$input"); 37 | is_deeply( 38 | $errors, 39 | { 3 => [ "L<> starts or ends with whitespace" ] }, 40 | "warning for space in $l_code", 41 | ); 42 | } 43 | } 44 | 45 | { 46 | my $input = "=pod\n\nAmbiguous slash: L\n"; 47 | my $errors = errors("$input"); 48 | is_deeply( 49 | $errors, 50 | { 3 => [ "alternative text 'I/O Operators' contains non-escaped | or /" ] }, 51 | "warning for / in text part of L<>", 52 | ); 53 | } 54 | 55 | { 56 | my $input = "=pod\n\nnested LEEE: L|http://baz>\n"; 57 | my $errors = errors("$input"); 58 | is_deeply( 59 | $errors, 60 | { 3 => [ "Nested L<> are illegal. Pretending inner one is X<...> so can continue looking for other errors." ] }, 61 | "warning for nested L<>", 62 | ); 63 | } 64 | 65 | { 66 | my $input = "=pod\n\nLEEE containing only slash: L< / >\n"; 67 | my $errors = errors("$input"); 68 | is_deeply( 69 | $errors, 70 | { 3 => [ "L<> contains only '/'" ] }, 71 | "warning for L< / > containing only a slash", 72 | ); 73 | } 74 | -------------------------------------------------------------------------------- /t/xhtml-bkb.t: -------------------------------------------------------------------------------- 1 | # t/xhtml-bkb.t - https://rt.cpan.org/Public/Bug/Display.html?id=77686 2 | 3 | use strict; 4 | use warnings; 5 | use Test::More tests => 1; 6 | use Pod::Simple::XHTML; 7 | my $c = < 13 | EOF 14 | my $d = Pod::Simple::XHTML->new (); 15 | $d->index (1); 16 | my $e; 17 | $d->output_string (\$e); 18 | $d->parse_string_document ($c); 19 | unlike ($e, qr!]+>]+>!); 20 | -------------------------------------------------------------------------------- /t/xhtml05.t: -------------------------------------------------------------------------------- 1 | # t/xhtml05.t - check block output from Pod::Simple::XHTML 2 | use strict; 3 | use warnings; 4 | use Test::More tests => 6; 5 | 6 | use_ok('Pod::Simple::XHTML') or exit; 7 | 8 | my $parser = Pod::Simple::XHTML->new (); 9 | isa_ok ($parser, 'Pod::Simple::XHTML'); 10 | 11 | my $results; 12 | initialize($parser, $results); 13 | $parser->accept_targets_as_text( 'comment' ); 14 | $parser->parse_string_document(<<'EOPOD'); 15 | =for comment 16 | This is an ordinary for block. 17 | 18 | EOPOD 19 | 20 | is($results, <<'EOHTML', "a for block"); 21 |
22 | 23 |

This is an ordinary for block.

24 | 25 |
26 | 27 | EOHTML 28 | 29 | foreach my $target (qw(note tip warning)) { 30 | initialize($parser, $results); 31 | $parser->accept_targets_as_text( $target ); 32 | $parser->parse_string_document(<<"EOPOD"); 33 | =begin $target 34 | 35 | This is a $target. 36 | 37 | =end $target 38 | EOPOD 39 | 40 | is($results, <<"EOHTML", "allow $target blocks"); 41 |
42 | 43 |

This is a $target.

44 | 45 |
46 | 47 | EOHTML 48 | 49 | } 50 | 51 | ###################################### 52 | 53 | sub initialize { 54 | $_[0] = Pod::Simple::XHTML->new (); 55 | $_[0]->html_header(""); 56 | $_[0]->html_footer(""); 57 | $_[0]->output_string( \$results ); # Send the resulting output to a string 58 | $_[1] = ''; 59 | return; 60 | } 61 | -------------------------------------------------------------------------------- /t/xhtml15.t: -------------------------------------------------------------------------------- 1 | # t/xhtml15.t - test compatibility between Pod::Simple::XHTML and 2 | # Pod::Simple::HtmlBatch 3 | 4 | use strict; 5 | use warnings; 6 | use Test::More tests => 4; 7 | 8 | use_ok('Pod::Simple::XHTML') or exit; 9 | 10 | my ($parser, $results); 11 | 12 | initialize(); 13 | my $style = 'http://amazingpants.com/style.css'; 14 | $parser->html_css($style); 15 | $parser->parse_string_document( '=head1 Foo' ); 16 | like $results, qr/ href="$style" /, 'CSS is correct when link is passed in'; 17 | 18 | initialize(); 19 | my $link = qq{}; 20 | $parser->html_css($link); 21 | $parser->parse_string_document( '=head1 Foo' ); 22 | like $results, qr/ href="$style" /, 'CSS is correct when is passed in'; 23 | 24 | #note('These methods are called when XHTML is used by HtmlBatch'); 25 | can_ok $parser, qw/batch_mode_page_object_init html_header_after_title/; 26 | 27 | sub initialize { 28 | $parser = Pod::Simple::XHTML->new; 29 | $parser->index(1); 30 | $parser->output_string( \$results ); 31 | $results = ''; 32 | } 33 | -------------------------------------------------------------------------------- /t/xhtml20.t: -------------------------------------------------------------------------------- 1 | # t/xhtml20.t - test subclassing of Pod::Simple::XHTML 2 | 3 | use strict; 4 | use warnings; 5 | use Test::More tests => 1; 6 | 7 | BEGIN { 8 | package MyXHTML; 9 | use base 'Pod::Simple::XHTML'; 10 | 11 | sub handle_code { 12 | my($self, $code, $kind) = @_; 13 | $code = $kind . "[$code]"; 14 | $self->SUPER::handle_code($code); 15 | } 16 | 17 | sub start_code { 18 | my($self, $kind) = @_; 19 | $self->{scratch} .= ""; 20 | } 21 | 22 | sub end_code { 23 | my($self, $kind) = @_; 24 | $self->{scratch} .= ""; 25 | } 26 | } 27 | 28 | 29 | 30 | my ($parser, $results); 31 | 32 | initialize(); 33 | $parser->parse_string_document(<<'EOT'); 34 | =head1 Foo 35 | 36 | This is C<$code> and so is: 37 | 38 | my $foo = 1; 39 | 40 | Code might even be C<<< nested( B<< C<1> >> ) >>>. 41 | EOT 42 | 43 | is($results, <<'EOT'); 44 |

Foo

45 | 46 |

This is C[$code] and so is:

47 | 48 | 
Verbatim[  my $foo = 1;]
49 | 50 |

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

51 | 52 | EOT 53 | 54 | 55 | sub initialize { 56 | $parser = MyXHTML->new; 57 | $parser->html_header(''); 58 | $parser->html_footer(''); 59 | $parser->output_string( \$results ); 60 | $results = ''; 61 | } 62 | -------------------------------------------------------------------------------- /t/xhtml25.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | 5 | BEGIN { 6 | package MyXHTML; 7 | use base 'Pod::Simple::XHTML'; 8 | 9 | sub new { 10 | my $class = shift; 11 | my $self = $class->SUPER::new(@_); 12 | $self->html_header(''); 13 | $self->html_footer(''); 14 | $self->index(1); 15 | $self->anchor_items(1); 16 | return $self; 17 | } 18 | 19 | sub parse_to_string { 20 | my $self = shift; 21 | my $pod = shift; 22 | my $output = ''; 23 | $self->output_string( \$output ); 24 | $self->parse_string_document($pod); 25 | return $output; 26 | } 27 | 28 | sub idify { 29 | my ($self, $t, $not_unique) = @_; 30 | for ($t) { 31 | $t =~ s/\A\s+//; 32 | $t =~ s/\s+\z//; 33 | $t =~ s/[\s-]+/-/g; 34 | } 35 | return $t if $not_unique; 36 | my $i = ''; 37 | $i++ while $self->{ids}{"$t$i"}++; 38 | return "$t$i"; 39 | } 40 | } 41 | 42 | 43 | my @tests = ( 44 | # Pod id link (url encoded) 45 | [ 'Foo', 'Foo', 'Foo' ], 46 | [ '$@', '$@', '%24%40' ], 47 | [ 'With C', 'With-Formatting', 'With-Formatting' ], 48 | [ '$obj->method($foo)', '$obj->method($foo)', '%24obj-%3Emethod(%24foo)' ], 49 | ); 50 | 51 | plan tests => 5 * scalar @tests; 52 | 53 | my $parser = MyXHTML->new; 54 | 55 | for my $names (@tests) { 56 | my ($heading, $id, $link) = @$names; 57 | 58 | is $link, $parser->encode_url($id), 59 | 'assert correct encoding of url fragment'; 60 | 61 | my $html_id = $parser->encode_entities($id); 62 | 63 | { 64 | my $result = MyXHTML->new->parse_to_string(<<"EOT"); 65 | =head1 $heading 66 | 67 | L<< /$heading >> 68 | 69 | EOT 70 | like $result, qr{

}, 71 | "heading id generated correctly for '$heading'"; 72 | like $result, qr{
  • }, 73 | "index link generated correctly for '$heading'"; 74 | like $result, qr{

    }, 75 | "L<> link generated correctly for '$heading'"; 76 | } 77 | { 78 | my $result = MyXHTML->new->parse_to_string(<<"EOT"); 79 | =over 4 80 | 81 | =item $heading 82 | 83 | =back 84 | 85 | EOT 86 | like $result, qr{

    }, 87 | "item id generated correctly for '$heading'"; 88 | } 89 | } 90 | --------------------------------------------------------------------------------