Pod-POM-0.29/0000755000175000017500000000000012260471766012154 5ustar andrewandrewPod-POM-0.29/README0000644000175000017500000000366511355213167013037 0ustar andrewandrew Pod::POM Version 0.26 1st April 2010 Copyright (C) 2000-2002 Andy Wardley. All Rights Reserved Copyright (C) 2009-2010 Andrew Ford. All Rights Reserved This is free software; you can redistribute it and/or modify it under the same terms as Perl itself. DESCRIPTION ----------- This module implements a parser to convert Pod documents into a simple object model form known hereafter as the Pod Object Model. The object model is generated as a hierarchical tree of nodes, each of which represents a different element of the original document. The tree can be walked manually and the nodes examined, printed or otherwise manipulated. In addition, Pod::POM supports and provides view objects which can automatically traverse the tree, or section thereof, and generate an output representation in one form or another. The Template Toolkit Pod plugin interfaces to this module. See the Pod::POM documentation for further details. STATUS ------ Development of Pod::POM was restarted in March 2009 with the aim of making the modules comply with perlpodspec. SUPPORT ------- The Pod::POM mailing list provides a forum for discussing these modules. To subscribe to the mailing list, send an email to: pod-pom-request@template-toolkit.org with the message 'subscribe' in the body. You can also use the web interface to subscribe or browse the archives: http://mail.template-toolkit.org/mailman/listinfo/pod-pom AUTHOR ------ Pod::POM was originally written by Andy Wardley . Andrew Ford is co-maintainer as of March 2009. COPYRIGHT --------- Copyright (C) 2000-2002 Andy Wardley. All Rights Reserved. Copyright (C) 2009-2010 Andrew Ford. All Rights Reserved. This is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Pod-POM-0.29/Changes0000644000175000017500000002623512260471742013451 0ustar andrewandrew#======================================================================== # # Changes # # DESCRIPTION # Revision history for Pod::POM module. # # AUTHOR # Andy Wardley # Andrew Ford # #------------------------------------------------------------------------ # $Id: Changes 91 2013-12-31 07:36:02Z ford $ #======================================================================== #------------------------------------------------------------------------ # Version 0.29 2013-12-31 #------------------------------------------------------------------------ * fixed bug 87124 (upgrade Module::Install) * fixed bug 90010 (typos) #------------------------------------------------------------------------ # Version 0.28 2013-05-30 #------------------------------------------------------------------------ * fixed bug 81707 (test failures due to hash randomisation in perl 5.17.6) * change 'use vars' to 'our' declarations #------------------------------------------------------------------------ # Version 0.27 2010-04-02 #------------------------------------------------------------------------ * changed 'unless (defined (%{"$class\::ACCEPT"}))' to just 'unless (%{"$class\::ACCEPT"})' in Pod::POM::Node to fix defect #56205 (use of the now deprecated "defined(%hash)" construct) #------------------------------------------------------------------------ # Version 0.26 2009-08-20 #------------------------------------------------------------------------ * updated Makefile.PL to require at least 2001.0929 of Text::Wrap, as versions prior to this always unexpand tabs. * applied Andreas Koenig's encoding patch * changed 'use base' to 'use parent' * split Pod::POM::Nodes into separate modules, retaining the original file to just use all the individual node modules. * added AF to author and copyright info for modules (in addition to ABW) #------------------------------------------------------------------------ # Version 0.25 2009-03-27 #------------------------------------------------------------------------ * updated Makefile.PL to use Module::Include properly - i.e. flag modules as test_requires as appropriate * output test failure reason with diag() * added t/YAML/Tiny.pm (self-contained YAML library) to remove test-only module dependency * test library uses Test::Differences if available but package does not list it as a dependency #------------------------------------------------------------------------ # Version 0.24 2009-03-21 #------------------------------------------------------------------------ * fixed broken YAML files in testcases that were causing tests to fail on some platforms * added text and HTML verbatim paragraph view tests * fixed typo in synopsis in Pod::POM #------------------------------------------------------------------------ # Version 0.23 2009-03-20 #------------------------------------------------------------------------ * Applied JJ's patch for coalescing verbatim paragraphs separated by blank lines and refined verbatim paragraph test cases and expected output * Tweaked pom dump format to quote individual text lines * Tweaked PodPOMTestLib to remove dependency on Class::Accessor * Added test cases for =headN hierarchy and =begin blocks * Added format name to =end in Pod::POM::View::Pod * Switch Makefile.PL to Module::Include #------------------------------------------------------------------------ # Version 0.22 2009-03-19 #------------------------------------------------------------------------ * Added missing dependencies to Makefile.PL * Added pomdump program to list of executables #------------------------------------------------------------------------ # Version 0.21 2009-03-18 #------------------------------------------------------------------------ * Added missing dependencies to Makefile.PL #------------------------------------------------------------------------ # Version 0.20 2009-03-17 #------------------------------------------------------------------------ * Added basic pod documentation to the view modules * expanded the test cases (especially expanded sequences and blockquote paragraphs) * add support for blockquote paragraphs to Text and HTML views #------------------------------------------------------------------------ # Version 0.19 2009-03-17 #------------------------------------------------------------------------ * Added dump method to Pod::POM::Node * Reorganized tests with new testcases directory #------------------------------------------------------------------------ # Version 0.18 2009-03-11 #------------------------------------------------------------------------ * Add patches from RT * BOOK's ticket #24266: Proposed correction for bugs #1949 and #5759 (As described in tickets #1949 and #5759, the content =begin/=end blocks should be treated as data text (no sequence parsing, etc).) * JJ's ticket #16764: Problem handling paragraph separators - incompatibility with perlpodspec (Pod::POM 0.17 does not accept blank lines containing whitespace as paragraph separators, it only accepts blank lines containing no characters at all. According to perlpodspec, blank lines containing whitespace should be taken as paragraph separators. * Modified pom2 to search for viewer modules other than Pod, Text and HTML in @INC, and to pass any options to the constructor method. #------------------------------------------------------------------------ # Version 0.17 #------------------------------------------------------------------------ * Pod::POM::View::Pod::view_item could have $title non reference, so handle that gracefully. * add 'fallback => 1' to use of overload in Pod::POM::Node. #------------------------------------------------------------------------ # Version 0.16 #------------------------------------------------------------------------ * Pod::POM::View::Text and Pod::POM::View::HTML now implement F<> rendering similar to I<>. Tests adjusted. [Stas Bekman] * Added 'bool' overload to Pod::POM::Node to prevent unwanted stringification of nodes simply to test their truth. Also removed C test from Pod::POM::Nodes::Text::present() which was having the same early stringification side-effect. #------------------------------------------------------------------------ # Version 0.15 8th March 2002 #------------------------------------------------------------------------ * Applied a patch from Stas Bekman to re-implement view_seq_link() in Pod/POM/View/HTML.pm - don't add "the foo manpage" automatically. - implement a big part of the L<> according to the spec, parts borrowed from Pod::HTML - the implementation includes an optional callback which can be sub-classed to provide transformations of the 'page' part of the L<> tag. For example if the page is located elsewhere. * Applied another patch from Stas to fix view_seq_text() - ! and ; are also punctuation chars - fix comment typos - fix incorrectly parsed url followed by punctuation at the end of string: #------------------------------------------------------------------------ # Version 0.14 25th February 2002 #------------------------------------------------------------------------ * Added the visit(), leave() and visiting() methods to Pod::POM::View to allow visitors to track elements of the path that they've taken. This allows one method to know if it has been called within the context of another. #------------------------------------------------------------------------ # Version 0.13 6th February 2002 #------------------------------------------------------------------------ * Applied a patch from Leon Brocard to change 'length' to 'defined' to make Pod::POM work OK with bleadperl. * Changed Pod::POM::View::HTML view_seq_text() method to automatically escape < > and &. Thanks to lazy POD author Mark Fowler for raising the issue. :-) #------------------------------------------------------------------------ # Version 0.12 3rd January 2002 #------------------------------------------------------------------------ * Applied a patch from Stas Bekman which: - fixes the over/item functionality (quite a few very missing), see the tests - fixes a bug revealed with "" overload - changes HTML version to be foo, not 'foo' - adds the URL hyperlinking code, borrowed from bleadperl's Pod::Html. * Fixed a typo in the SYNOPSIS and removed some dead spaces. Thanks to Ron Savage for reporting the problems. * Added Ron's fancy-pom2.pl script as bin/custom-pom2 * Renamed pomcheck to podlint because it is a much catchier name :-) * Added some docs to bin/pom2 and bin/podlint * Several other minor documentation fixes and improvements. #------------------------------------------------------------------------ # Version 0.11 2nd December 2001 #------------------------------------------------------------------------ * Fixed HTML view_verbatim() to escape < > and & to HTML entities. * Bumped version number up to 0.11 to ensure it supercedes the ill fated 0.1 release which has been confusing CPAN ever since (0.1 < 0.03) #------------------------------------------------------------------------ # Version 0.03 26th November 2001 #------------------------------------------------------------------------ * Fixed HTML view_head1() to remove illegal
    ...
tags. Also modified view_over() to detect the type of the first item (e.g. '=item *', '=item 1.' or '=item foo') and adjust accordingly to create a '
    ...
' or '
    ...
' list. Item titles of the form '*' or '1.' then get stripped off as appropiate. Thanks to Stas Bekman for raising these issues. * Added support for new =head3 and =head4 POD tags, also due to prodding from Stas. :-) * Added support for experimental 'meta' tag. Disabled by default. #------------------------------------------------------------------------ # Version 0.02 09-Apr-2001 #------------------------------------------------------------------------ * Fixed several bugs in Pod/POM/Nodes.pm where I had relied on the 5.6.0 "Do The Right Thing" behaviour of C<$EXPECT = qw( ... )> to correctly quote a single string. Now changed to C<$EXPECT = '...'>. Thanks to Randal Schwartz for identifying the problem. * Added C to Pod::POM::View::* modules because C doesn't do it automatically for you in some earlier versions of Perl, even if it says it does. * Updated documentation to refer to released Template Toolkit v2.02 and added a little more on using the Pod plugin and VIEW directive to munge Pod. * Changed the Pod::POM::View::Text module to be smarter about indenting, keeping track of a current indent level via an internal INDENT member (when used as an object) or the package variable $INDENT (when used as a class) instead of the previous approach of blindly stuffing everything through Text::Wrap as an afterthought. Converting Pod to text is now significantly faster and should generate correctly indented output. #------------------------------------------------------------------------ # Version 0.01 09-Jan-2001 #------------------------------------------------------------------------ * first public release. Pod-POM-0.29/inc/0000755000175000017500000000000012260471766012725 5ustar andrewandrewPod-POM-0.29/inc/Module/0000755000175000017500000000000012260471766014152 5ustar andrewandrewPod-POM-0.29/inc/Module/Install.pm0000644000175000017500000003013512260471750016111 0ustar andrewandrew#line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } use 5.005; use strict 'vars'; use Cwd (); use File::Find (); use File::Path (); use vars qw{$VERSION $MAIN}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or # different versions of modules. # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. $VERSION = '1.06'; # Storage for the pseudo-singleton $MAIN = undef; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; #------------------------------------------------------------- # all of the following checks should be included in import(), # to allow "eval 'require Module::Install; 1' to test # installation of Module::Install. (RT #51267) #------------------------------------------------------------- # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE" } Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE # This reportedly fixes a rare Win32 UTC file time issue, but # as this is a non-cross-platform XS module not in the core, # we shouldn't really depend on it. See RT #24194 for detail. # (Also, this module only supports Perl 5.6 and above). eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006; # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. if ( -f $0 ) { my $s = (stat($0))[9]; # If the modification time is only slightly in the future, # sleep briefly to remove the problem. my $a = $s - time; if ( $a > 0 and $a < 5 ) { sleep 5 } # Too far in the future, throw an error. my $t = time; if ( $s > $t ) { die <<"END_DIE" } Your installer $0 has a modification time in the future ($s > $t). This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE } # Build.PL was formerly supported, but no longer is due to excessive # difficulty in implementing every single feature twice. if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" } Module::Install no longer supports Build.PL. It was impossible to maintain duel backends, and has been deprecated. Please remove all Build.PL files and only use the Makefile.PL installer. END_DIE #------------------------------------------------------------- # To save some more typing in Module::Install installers, every... # use inc::Module::Install # ...also acts as an implicit use strict. $^H |= strict::bits(qw(refs subs vars)); #------------------------------------------------------------- unless ( -f $self->{file} ) { foreach my $key (keys %INC) { delete $INC{$key} if $key =~ /Module\/Install/; } local $^W; require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } local $^W; *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{'inc/Module/Install.pm'}; delete $INC{'Module/Install.pm'}; # Save to the singleton $MAIN = $self; return 1; } sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::cwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::cwd(); if ( my $code = $sym->{$pwd} ) { # Delegate back to parent dirs goto &$code unless $cwd eq $pwd; } unless ($$sym =~ s/([^:]+)$//) { # XXX: it looks like we can't retrieve the missing function # via $$sym (usually $main::AUTOLOAD) in this case. # I'm still wondering if we should slurp Makefile.PL to # get some context or not ... my ($package, $file, $line) = caller; die <<"EOT"; Unknown function is found at $file line $line. Execution of $file aborted due to runtime errors. If you're a contributor to a project, you may need to install some Module::Install extensions from CPAN (or other repository). If you're a user of a module, please contact the author. EOT } my $method = $1; if ( uc($method) eq $method ) { # Do nothing return; } elsif ( $method =~ /^_/ and $self->can($method) ) { # Dispatch to the root M:I class return $self->$method(@_); } # Dispatch to the appropriate plugin unshift @_, ( $self, $1 ); goto &{$self->can('call')}; }; } sub preload { my $self = shift; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { @exts = $self->{admin}->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { local $^W; *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; delete $INC{'FindBin.pm'}; { # to suppress the redefine warning local $SIG{__WARN__} = sub {}; require FindBin; } # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ( $args{path} ) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; $args{wrote} = 0; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; my $should_reload = 0; unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; $should_reload = 1; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { local $^W; require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = $should_reload ? delete $INC{$file} : $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } $self->{extensions} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { my $content = Module::Install::_read($subpath . '.pm'); my $in_pod = 0; foreach ( split //, $content ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } ##################################################################### # Common Utility Functions sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _read { local *FH; open( FH, '<', $_[0] ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_NEW sub _read { local *FH; open( FH, "< $_[0]" ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_OLD sub _readperl { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s; $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg; return $string; } sub _readpod { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; return $string if $_[0] =~ /\.pod\z/; $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg; $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg; $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg; $string =~ s/^\n+//s; return $string; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _write { local *FH; open( FH, '>', $_[0] ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_NEW sub _write { local *FH; open( FH, "> $_[0]" ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_OLD # _version is for processing module versions (eg, 1.03_05) not # Perl versions (eg, 5.8.1). sub _version ($) { my $s = shift || 0; my $d =()= $s =~ /(\.)/g; if ( $d >= 2 ) { # Normalise multipart versions $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg; } $s =~ s/^(\d+)\.?//; my $l = $1 || 0; my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g; $l = $l . '.' . join '', @v if @v; return $l + 0; } sub _cmp ($$) { _version($_[1]) <=> _version($_[2]); } # Cloned from Params::Util::_CLASS sub _CLASS ($) { ( defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s ) ? $_[0] : undef; } 1; # Copyright 2008 - 2012 Adam Kennedy. Pod-POM-0.29/inc/Module/Install/0000755000175000017500000000000012260471766015560 5ustar andrewandrewPod-POM-0.29/inc/Module/Install/Win32.pm0000644000175000017500000000340312260471750017011 0ustar andrewandrew#line 1 package Module::Install::Win32; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); die <<'END_MESSAGE' unless $rv; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } 1; Pod-POM-0.29/inc/Module/Install/Makefile.pm0000644000175000017500000002743712260471750017641 0ustar andrewandrew#line 1 package Module::Install::Makefile; use strict 'vars'; use ExtUtils::MakeMaker (); use Module::Install::Base (); use Fcntl qw/:flock :seek/; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing or non-interactive session, always use defaults if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } # Store a cleaned up version of the MakeMaker version, # since we need to behave differently in a variety of # ways based on the MM version. my $makemaker = eval $ExtUtils::MakeMaker::VERSION; # If we are passed a param, do a "newer than" comparison. # Otherwise, just return the MakeMaker version. sub makemaker { ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0 } # Ripped from ExtUtils::MakeMaker 6.56, and slightly modified # as we only need to know here whether the attribute is an array # or a hash or something else (which may or may not be appendable). my %makemaker_argtype = ( C => 'ARRAY', CONFIG => 'ARRAY', # CONFIGURE => 'CODE', # ignore DIR => 'ARRAY', DL_FUNCS => 'HASH', DL_VARS => 'ARRAY', EXCLUDE_EXT => 'ARRAY', EXE_FILES => 'ARRAY', FUNCLIST => 'ARRAY', H => 'ARRAY', IMPORTS => 'HASH', INCLUDE_EXT => 'ARRAY', LIBS => 'ARRAY', # ignore '' MAN1PODS => 'HASH', MAN3PODS => 'HASH', META_ADD => 'HASH', META_MERGE => 'HASH', PL_FILES => 'HASH', PM => 'HASH', PMLIBDIRS => 'ARRAY', PMLIBPARENTDIRS => 'ARRAY', PREREQ_PM => 'HASH', CONFIGURE_REQUIRES => 'HASH', SKIP => 'ARRAY', TYPEMAPS => 'ARRAY', XS => 'HASH', # VERSION => ['version',''], # ignore # _KEEP_AFTER_FLUSH => '', clean => 'HASH', depend => 'HASH', dist => 'HASH', dynamic_lib=> 'HASH', linkext => 'HASH', macro => 'HASH', postamble => 'HASH', realclean => 'HASH', test => 'HASH', tool_autosplit => 'HASH', # special cases where you can use makemaker_append CCFLAGS => 'APPENDABLE', DEFINE => 'APPENDABLE', INC => 'APPENDABLE', LDDLFLAGS => 'APPENDABLE', LDFROM => 'APPENDABLE', ); sub makemaker_args { my ($self, %new_args) = @_; my $args = ( $self->{makemaker_args} ||= {} ); foreach my $key (keys %new_args) { if ($makemaker_argtype{$key}) { if ($makemaker_argtype{$key} eq 'ARRAY') { $args->{$key} = [] unless defined $args->{$key}; unless (ref $args->{$key} eq 'ARRAY') { $args->{$key} = [$args->{$key}] } push @{$args->{$key}}, ref $new_args{$key} eq 'ARRAY' ? @{$new_args{$key}} : $new_args{$key}; } elsif ($makemaker_argtype{$key} eq 'HASH') { $args->{$key} = {} unless defined $args->{$key}; foreach my $skey (keys %{ $new_args{$key} }) { $args->{$key}{$skey} = $new_args{$key}{$skey}; } } elsif ($makemaker_argtype{$key} eq 'APPENDABLE') { $self->makemaker_append($key => $new_args{$key}); } } else { if (defined $args->{$key}) { warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n}; } $args->{$key} = $new_args{$key}; } } return $args; } # For mm args that take multiple space-seperated args, # append an argument to the current list. sub makemaker_append { my $self = shift; my $name = shift; my $args = $self->makemaker_args; $args->{$name} = defined $args->{$name} ? join( ' ', $args->{$name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } sub _wanted_t { } sub tests_recursive { my $self = shift; my $dir = shift || 't'; unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } my %tests = map { $_ => 1 } split / /, ($self->tests || ''); require File::Find; File::Find::find( sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 }, $dir ); $self->tests( join ' ', sort keys %tests ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; # Check the current Perl version my $perl_version = $self->perl_version; if ( $perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } # Make sure we have a new enough MakeMaker require ExtUtils::MakeMaker; if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) { # This previous attempted to inherit the version of # ExtUtils::MakeMaker in use by the module author, but this # was found to be untenable as some authors build releases # using future dev versions of EU:MM that nobody else has. # Instead, #toolchain suggests we use 6.59 which is the most # stable version on CPAN at time of writing and is, to quote # ribasushi, "not terminally fucked, > and tested enough". # TODO: We will now need to maintain this over time to push # the version up as new versions are released. $self->build_requires( 'ExtUtils::MakeMaker' => 6.59 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 ); } else { # Allow legacy-compatibility with 5.005 by depending on the # most recent EU:MM that supported 5.005. $self->build_requires( 'ExtUtils::MakeMaker' => 6.36 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 ); } # Generate the MakeMaker params my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name; $args->{NAME} =~ s/-/::/g; $args->{VERSION} = $self->version or die <<'EOT'; ERROR: Can't determine distribution version. Please specify it explicitly via 'version' in Makefile.PL, or set a valid $VERSION in a module, and provide its file path via 'version_from' (or 'all_from' if you prefer) in Makefile.PL. EOT if ( $self->tests ) { my @tests = split ' ', $self->tests; my %seen; $args->{test} = { TESTS => (join ' ', grep {!$seen{$_}++} @tests), }; } elsif ( $Module::Install::ExtraTests::use_extratests ) { # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness. # So, just ignore our xt tests here. } elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) { $args->{test} = { TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ), }; } if ( $] >= 5.005 ) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = join ', ', @{$self->author || []}; } if ( $self->makemaker(6.10) ) { $args->{NO_META} = 1; #$args->{NO_MYMETA} = 1; } if ( $self->makemaker(6.17) and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } if ( $self->makemaker(6.31) and $self->license ) { $args->{LICENSE} = $self->license; } my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->requires) ); # Remove any reference to perl, PREREQ_PM doesn't support it delete $args->{PREREQ_PM}->{perl}; # Merge both kinds of requires into BUILD_REQUIRES my $build_prereq = ($args->{BUILD_REQUIRES} ||= {}); %$build_prereq = ( %$build_prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->configure_requires, $self->build_requires) ); # Remove any reference to perl, BUILD_REQUIRES doesn't support it delete $args->{BUILD_REQUIRES}->{perl}; # Delete bundled dists from prereq_pm, add it to Makefile DIR my $subdirs = ($args->{DIR} || []); if ($self->bundles) { my %processed; foreach my $bundle (@{ $self->bundles }) { my ($mod_name, $dist_dir) = @$bundle; delete $prereq->{$mod_name}; $dist_dir = File::Basename::basename($dist_dir); # dir for building this module if (not exists $processed{$dist_dir}) { if (-d $dist_dir) { # List as sub-directory to be processed by make push @$subdirs, $dist_dir; } # Else do nothing: the module is already present on the system $processed{$dist_dir} = undef; } } } unless ( $self->makemaker('6.55_03') ) { %$prereq = (%$prereq,%$build_prereq); delete $args->{BUILD_REQUIRES}; } if ( my $perl_version = $self->perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; if ( $self->makemaker(6.48) ) { $args->{MIN_PERL_VERSION} = $perl_version; } } if ($self->installdirs) { warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS}; $args->{INSTALLDIRS} = $self->installdirs; } my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_} ) } keys %$args; my $user_preop = delete $args{dist}->{PREOP}; if ( my $preop = $self->admin->preop($user_preop) ) { foreach my $key ( keys %$preop ) { $args{dist}->{$key} = $preop->{$key}; } } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; eval { flock MAKEFILE, LOCK_EX }; my $makefile = do { local $/; }; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; seek MAKEFILE, 0, SEEK_SET; truncate MAKEFILE, 0; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 544 Pod-POM-0.29/inc/Module/Install/Metadata.pm0000644000175000017500000004327712260471750017644 0ustar andrewandrew#line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } my @boolean_keys = qw{ sign }; my @scalar_keys = qw{ name module_name abstract version distribution_type tests installdirs }; my @tuple_keys = qw{ configure_requires build_requires requires recommends bundles resources }; my @resource_keys = qw{ homepage bugtracker repository }; my @array_keys = qw{ keywords author }; *authors = \&author; sub Meta { shift } sub Meta_BooleanKeys { @boolean_keys } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } sub Meta_ResourceKeys { @resource_keys } sub Meta_ArrayKeys { @array_keys } foreach my $key ( @boolean_keys ) { *$key = sub { my $self = shift; if ( defined wantarray and not @_ ) { return $self->{values}->{$key}; } $self->{values}->{$key} = ( @_ ? $_[0] : 1 ); return $self; }; } foreach my $key ( @scalar_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} = shift; return $self; }; } foreach my $key ( @array_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} ||= []; push @{$self->{values}->{$key}}, @_; return $self; }; } foreach my $key ( @resource_keys ) { *$key = sub { my $self = shift; unless ( @_ ) { return () unless $self->{values}->{resources}; return map { $_->[1] } grep { $_->[0] eq $key } @{ $self->{values}->{resources} }; } return $self->{values}->{resources}->{$key} unless @_; my $uri = shift or die( "Did not provide a value to $key()" ); $self->resources( $key => $uri ); return 1; }; } foreach my $key ( grep { $_ ne "resources" } @tuple_keys) { *$key = sub { my $self = shift; return $self->{values}->{$key} unless @_; my @added; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @added, [ $module, $version ]; } push @{ $self->{values}->{$key} }, @added; return map {@$_} @added; }; } # Resource handling my %lc_resource = map { $_ => 1 } qw{ homepage license bugtracker repository }; sub resources { my $self = shift; while ( @_ ) { my $name = shift or last; my $value = shift or next; if ( $name eq lc $name and ! $lc_resource{$name} ) { die("Unsupported reserved lowercase resource '$name'"); } $self->{values}->{resources} ||= []; push @{ $self->{values}->{resources} }, [ $name, $value ]; } $self->{values}->{resources}; } # Aliases for build_requires that will have alternative # meanings in some future version of META.yml. sub test_requires { shift->build_requires(@_) } sub install_requires { shift->build_requires(@_) } # Aliases for installdirs options sub install_as_core { $_[0]->installdirs('perl') } sub install_as_cpan { $_[0]->installdirs('site') } sub install_as_site { $_[0]->installdirs('site') } sub install_as_vendor { $_[0]->installdirs('vendor') } sub dynamic_config { my $self = shift; my $value = @_ ? shift : 1; if ( $self->{values}->{dynamic_config} ) { # Once dynamic we never change to static, for safety return 0; } $self->{values}->{dynamic_config} = $value ? 1 : 0; return 1; } # Convenience command sub static_config { shift->dynamic_config(0); } sub perl_version { my $self = shift; return $self->{values}->{perl_version} unless @_; my $version = shift or die( "Did not provide a value to perl_version()" ); # Normalize the version $version = $self->_perl_version($version); # We don't support the really old versions unless ( $version >= 5.005 ) { die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n"; } $self->{values}->{perl_version} = $version; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die( "all_from called with no args without setting name() first" ); $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; unless ( -e $file ) { die("all_from cannot find $file from $name"); } } unless ( -f $file ) { die("The path '$file' does not exist, or is not a file"); } $self->{values}{all_from} = $file; # Some methods pull from POD instead of code. # If there is a matching .pod, use that instead my $pod = $file; $pod =~ s/\.pm$/.pod/i; $pod = $file unless -e $pod; # Pull the different values $self->name_from($file) unless $self->name; $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; $self->author_from($pod) unless @{$self->author || []}; $self->license_from($pod) unless $self->license; $self->abstract_from($pod) unless $self->abstract; return 1; } sub provides { my $self = shift; my $provides = ( $self->{values}->{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides( %{ $build->find_dist_packages || {} } ); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}->{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}->{features} ? @{ $self->{values}->{features} } : (); } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}->{no_index}->{$type} }, @_ if $type; return $self->{values}->{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML::Tiny', 0 ); require YAML::Tiny; my $data = YAML::Tiny::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->version( ExtUtils::MM_Unix->parse_version($file) ); # for version integrity check $self->makemaker_args( VERSION_FROM => $file ); } sub abstract_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } # Add both distribution and module name sub name_from { my ($self, $file) = @_; if ( Module::Install::_read($file) =~ m/ ^ \s* package \s* ([\w:]+) \s* ; /ixms ) { my ($name, $module_name) = ($1, $1); $name =~ s{::}{-}g; $self->name($name); unless ( $self->module_name ) { $self->module_name($module_name); } } else { die("Cannot determine name from $file\n"); } } sub _extract_perl_version { if ( $_[0] =~ m/ ^\s* (?:use|require) \s* v? ([\d_\.]+) \s* ; /ixms ) { my $perl_version = $1; $perl_version =~ s{_}{}g; return $perl_version; } else { return; } } sub perl_version_from { my $self = shift; my $perl_version=_extract_perl_version(Module::Install::_read($_[0])); if ($perl_version) { $self->perl_version($perl_version); } else { warn "Cannot determine perl version info from $_[0]\n"; return; } } sub author_from { my $self = shift; my $content = Module::Install::_read($_[0]); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; # XXX: ugly but should work anyway... if (eval "require Pod::Escapes; 1") { # Pod::Escapes has a mapping table. # It's in core of perl >= 5.9.3, and should be installed # as one of the Pod::Simple's prereqs, which is a prereq # of Pod::Text 3.x (see also below). $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $Pod::Escapes::Name2character_number{$1} ? chr($Pod::Escapes::Name2character_number{$1}) : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) { # Pod::Text < 3.0 has yet another mapping table, # though the table name of 2.x and 1.x are different. # (1.x is in core of Perl < 5.6, 2.x is in core of # Perl < 5.9.3) my $mapping = ($Pod::Text::VERSION < 2) ? \%Pod::Text::HTML_Escapes : \%Pod::Text::ESCAPES; $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $mapping->{$1} ? $mapping->{$1} : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } else { $author =~ s{E}{<}g; $author =~ s{E}{>}g; } $self->author($author); } else { warn "Cannot determine author info from $_[0]\n"; } } #Stolen from M::B my %license_urls = ( perl => 'http://dev.perl.org/licenses/', apache => 'http://apache.org/licenses/LICENSE-2.0', apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1', artistic => 'http://opensource.org/licenses/artistic-license.php', artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php', lgpl => 'http://opensource.org/licenses/lgpl-license.php', lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php', lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html', bsd => 'http://opensource.org/licenses/bsd-license.php', gpl => 'http://opensource.org/licenses/gpl-license.php', gpl2 => 'http://opensource.org/licenses/gpl-2.0.php', gpl3 => 'http://opensource.org/licenses/gpl-3.0.html', mit => 'http://opensource.org/licenses/mit-license.php', mozilla => 'http://opensource.org/licenses/mozilla1.1.php', open_source => undef, unrestricted => undef, restrictive => undef, unknown => undef, ); sub license { my $self = shift; return $self->{values}->{license} unless @_; my $license = shift or die( 'Did not provide a value to license()' ); $license = __extract_license($license) || lc $license; $self->{values}->{license} = $license; # Automatically fill in license URLs if ( $license_urls{$license} ) { $self->resources( license => $license_urls{$license} ); } return 1; } sub _extract_license { my $pod = shift; my $matched; return __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?) (=head \d.*|=cut.*|)\z /xms ) || __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?) (=head \d.*|=cut.*|)\z /xms ); } sub __extract_license { my $license_text = shift or return; my @phrases = ( '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1, '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1, 'Artistic and GPL' => 'perl', 1, 'GNU general public license' => 'gpl', 1, 'GNU public license' => 'gpl', 1, 'GNU lesser general public license' => 'lgpl', 1, 'GNU lesser public license' => 'lgpl', 1, 'GNU library general public license' => 'lgpl', 1, 'GNU library public license' => 'lgpl', 1, 'GNU Free Documentation license' => 'unrestricted', 1, 'GNU Affero General Public License' => 'open_source', 1, '(?:Free)?BSD license' => 'bsd', 1, 'Artistic license 2\.0' => 'artistic_2', 1, 'Artistic license' => 'artistic', 1, 'Apache (?:Software )?license' => 'apache', 1, 'GPL' => 'gpl', 1, 'LGPL' => 'lgpl', 1, 'BSD' => 'bsd', 1, 'Artistic' => 'artistic', 1, 'MIT' => 'mit', 1, 'Mozilla Public License' => 'mozilla', 1, 'Q Public License' => 'open_source', 1, 'OpenSSL License' => 'unrestricted', 1, 'SSLeay License' => 'unrestricted', 1, 'zlib License' => 'open_source', 1, 'proprietary' => 'proprietary', 0, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s#\s+#\\s+#gs; if ( $license_text =~ /\b$pattern\b/i ) { return $license; } } return ''; } sub license_from { my $self = shift; if (my $license=_extract_license(Module::Install::_read($_[0]))) { $self->license($license); } else { warn "Cannot determine license info from $_[0]\n"; return 'unknown'; } } sub _extract_bugtracker { my @links = $_[0] =~ m#L<( https?\Q://rt.cpan.org/\E[^>]+| https?\Q://github.com/\E[\w_]+/[\w_]+/issues| https?\Q://code.google.com/p/\E[\w_\-]+/issues/list )>#gx; my %links; @links{@links}=(); @links=keys %links; return @links; } sub bugtracker_from { my $self = shift; my $content = Module::Install::_read($_[0]); my @links = _extract_bugtracker($content); unless ( @links ) { warn "Cannot determine bugtracker info from $_[0]\n"; return 0; } if ( @links > 1 ) { warn "Found more than one bugtracker link in $_[0]\n"; return 0; } # Set the bugtracker bugtracker( $links[0] ); return 1; } sub requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->requires( $module => $version ); } } sub test_requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->test_requires( $module => $version ); } } # Convert triple-part versions (eg, 5.6.1 or 5.8.9) to # numbers (eg, 5.006001 or 5.008009). # Also, convert double-part versions (eg, 5.8) sub _perl_version { my $v = $_[-1]; $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e; $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e; $v =~ s/(\.\d\d\d)000$/$1/; $v =~ s/_.+$//; if ( ref($v) ) { # Numify $v = $v + 0; } return $v; } sub add_metadata { my $self = shift; my %hash = @_; for my $key (keys %hash) { warn "add_metadata: $key is not prefixed with 'x_'.\n" . "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/; $self->{values}->{$key} = $hash{$key}; } } ###################################################################### # MYMETA Support sub WriteMyMeta { die "WriteMyMeta has been deprecated"; } sub write_mymeta_yaml { my $self = shift; # We need YAML::Tiny to write the MYMETA.yml file unless ( eval { require YAML::Tiny; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.yml\n"; YAML::Tiny::DumpFile('MYMETA.yml', $meta); } sub write_mymeta_json { my $self = shift; # We need JSON to write the MYMETA.json file unless ( eval { require JSON; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.json\n"; Module::Install::_write( 'MYMETA.json', JSON->new->pretty(1)->canonical->encode($meta), ); } sub _write_mymeta_data { my $self = shift; # If there's no existing META.yml there is nothing we can do return undef unless -f 'META.yml'; # We need Parse::CPAN::Meta to load the file unless ( eval { require Parse::CPAN::Meta; 1; } ) { return undef; } # Merge the perl version into the dependencies my $val = $self->Meta->{values}; my $perl = delete $val->{perl_version}; if ( $perl ) { $val->{requires} ||= []; my $requires = $val->{requires}; # Canonize to three-dot version after Perl 5.6 if ( $perl >= 5.006 ) { $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e } unshift @$requires, [ perl => $perl ]; } # Load the advisory META.yml file my @yaml = Parse::CPAN::Meta::LoadFile('META.yml'); my $meta = $yaml[0]; # Overwrite the non-configure dependency hashs delete $meta->{requires}; delete $meta->{build_requires}; delete $meta->{recommends}; if ( exists $val->{requires} ) { $meta->{requires} = { map { @$_ } @{ $val->{requires} } }; } if ( exists $val->{build_requires} ) { $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } }; } return $meta; } 1; Pod-POM-0.29/inc/Module/Install/Fetch.pm0000644000175000017500000000462712260471750017151 0ustar andrewandrew#line 1 package Module::Install::Fetch; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub get_file { my ($self, %args) = @_; my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } $|++; print "Fetching '$file' from $host... "; unless (eval { require Socket; Socket::inet_aton($host) }) { warn "'$host' resolve failed!\n"; return; } return unless $scheme eq 'ftp' or $scheme eq 'http'; require Cwd; my $dir = Cwd::getcwd(); chdir $args{local_dir} or return if exists $args{local_dir}; if (eval { require LWP::Simple; 1 }) { LWP::Simple::mirror($args{url}, $file); } elsif (eval { require Net::FTP; 1 }) { eval { # use Net::FTP to get past firewall my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); $ftp->login("anonymous", 'anonymous@example.com'); $ftp->cwd($path); $ftp->binary; $ftp->get($file) or (warn("$!\n"), return); $ftp->quit; } } elsif (my $ftp = $self->can_run('ftp')) { eval { # no Net::FTP, fallback to ftp.exe require FileHandle; my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { warn "Couldn't open ftp: $!\n"; chdir $dir; return; } my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; Pod-POM-0.29/inc/Module/Install/Scripts.pm0000644000175000017500000000101112260471750017527 0ustar andrewandrew#line 1 package Module::Install::Scripts; use strict 'vars'; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub install_script { my $self = shift; my $args = $self->makemaker_args; my $exe = $args->{EXE_FILES} ||= []; foreach ( @_ ) { if ( -f $_ ) { push @$exe, $_; } elsif ( -d 'script' and -f "script/$_" ) { push @$exe, "script/$_"; } else { die("Cannot find script '$_'"); } } } 1; Pod-POM-0.29/inc/Module/Install/Can.pm0000644000175000017500000000615712260471750016621 0ustar andrewandrew#line 1 package Module::Install::Can; use strict; use Config (); use ExtUtils::MakeMaker (); use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # check if we can load some module ### Upgrade this to not have to load the module if possible sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= '.pm' unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # Check if we can run some command sub can_run { my ($self, $cmd) = @_; my $_cmd = $cmd; return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { next if $dir eq ''; require File::Spec; my $abs = File::Spec->catfile($dir, $cmd); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # Can our C compiler environment build XS files sub can_xs { my $self = shift; # Ensure we have the CBuilder module $self->configure_requires( 'ExtUtils::CBuilder' => 0.27 ); # Do we have the configure_requires checker? local $@; eval "require ExtUtils::CBuilder;"; if ( $@ ) { # They don't obey configure_requires, so it is # someone old and delicate. Try to avoid hurting # them by falling back to an older simpler test. return $self->can_cc(); } # Do we have a working C compiler my $builder = ExtUtils::CBuilder->new( quiet => 1, ); unless ( $builder->have_compiler ) { # No working C compiler return 0; } # Write a C file representative of what XS becomes require File::Temp; my ( $FH, $tmpfile ) = File::Temp::tempfile( "compilexs-XXXXX", SUFFIX => '.c', ); binmode $FH; print $FH <<'END_C'; #include "EXTERN.h" #include "perl.h" #include "XSUB.h" int main(int argc, char **argv) { return 0; } int boot_sanexs() { return 1; } END_C close $FH; # Can the C compiler access the same headers XS does my @libs = (); my $object = undef; eval { local $^W = 0; $object = $builder->compile( source => $tmpfile, ); @libs = $builder->link( objects => $object, module_name => 'sanexs', ); }; my $result = $@ ? 0 : 1; # Clean up all the build files foreach ( $tmpfile, $object, @libs ) { next unless defined $_; 1 while unlink; } return $result; } # Can we locate a (the) C compiler sub can_cc { my $self = shift; my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 236 Pod-POM-0.29/inc/Module/Install/WriteAll.pm0000644000175000017500000000237612260471750017642 0ustar andrewandrew#line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_, ); $self->sign(1) if $args{sign}; $self->admin->WriteAll(%args) if $self->is_admin; $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{PL_FILES} ) { # XXX: This still may be a bit over-defensive... unless ($self->makemaker(6.25)) { $self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL'; } } # Until ExtUtils::MakeMaker support MYMETA.yml, make sure # we clean it up properly ourself. $self->realclean_files('MYMETA.yml'); if ( $args{inline} ) { $self->Inline->write; } else { $self->Makefile->write; } # The Makefile write process adds a couple of dependencies, # so write the META.yml files after the Makefile. if ( $args{meta} ) { $self->Meta->write; } # Experimental support for MYMETA if ( $ENV{X_MYMETA} ) { if ( $ENV{X_MYMETA} eq 'JSON' ) { $self->Meta->write_mymeta_json; } else { $self->Meta->write_mymeta_yaml; } } return 1; } 1; Pod-POM-0.29/inc/Module/Install/Base.pm0000644000175000017500000000214712260471750016765 0ustar andrewandrew#line 1 package Module::Install::Base; use strict 'vars'; use vars qw{$VERSION}; BEGIN { $VERSION = '1.06'; } # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } #line 42 sub new { my $class = shift; unless ( defined &{"${class}::call"} ) { *{"${class}::call"} = sub { shift->_top->call(@_) }; } unless ( defined &{"${class}::load"} ) { *{"${class}::load"} = sub { shift->_top->load(@_) }; } bless { @_ }, $class; } #line 61 sub AUTOLOAD { local $@; my $func = eval { shift->_top->autoload } or return; goto &$func; } #line 75 sub _top { $_[0]->{_top}; } #line 90 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } #line 106 sub is_admin { ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin'); } sub DESTROY {} package Module::Install::Base::FakeAdmin; use vars qw{$VERSION}; BEGIN { $VERSION = $Module::Install::Base::VERSION; } my $fake; sub new { $fake ||= bless(\@_, $_[0]); } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 159 Pod-POM-0.29/TODO0000644000175000017500000000364311355203561012640 0ustar andrewandrew* document Pod::POM::View and friends * add more thorough testing * fix link generation via L<...> * handle =encoding * more views for different styles, formats, etc. * According to the new podspec: C<< o->foo >> is the same as Cfoo>. adjust Pod::POM to handle this kind of markup also check that this works: S[$foo] >>> (Most likely the text parser needs to be rewritten) [stas] * you need to escape < and > if they're inside of [A-Z]<...>. Outside of formatting code ([A-Z]<...>) the parser shouldn't complain and leave < and > as is. * =begin/=end blocks are mishandled, I have a working version but it's imperfect. Parser's rewrite will provide a robust solution [stas] * some pods may include sequences unrecognized by Pod::POM, currently it spits many undefined var warnings (e.g. add N to the tests). - should gracefull handle this situation and probably warn about the unknown sequence each time it's encountered with line number. - should probably ignore the sequence, but process what's inside the sequence like the unknown sequence wasn't there. [stas] * the =over/=item can have very different usages, currently Pod::POM::View::Pod doesn't deparse correctly the following: =over =item Cat =item Sat =item Mat =back it loses the =item parts, simply copy the rest of the item tests I've recently added to t/htmlview.t to t/complete.t and you will see that the generated pod misses '=item' keys for this section. [stas] * if the pod doesn't start from the top of the file, but there is some leading text, the parser will report warnings on the line numbers relative to the beginning of the pod and not the absolute linenumber in the file. To make the warnings useful, the parser probably should accomodate for skipped non-pod lines. Think of .pm files with inlined pod (before each function) where this will come very useful. Pod-POM-0.29/MANIFEST0000644000175000017500000000652711355203561013305 0ustar andrewandrewChanges MANIFEST META.yml Makefile.PL README TODO bin/custom-pom2 bin/podlint bin/pom2 bin/pomdump inc/Module/Install.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/Fetch.pm inc/Module/Install/Makefile.pm inc/Module/Install/Metadata.pm inc/Module/Install/Scripts.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm lib/Pod/POM.pm lib/Pod/POM/Constants.pm lib/Pod/POM/Node.pm lib/Pod/POM/Node/Begin.pm lib/Pod/POM/Node/Code.pm lib/Pod/POM/Node/Content.pm lib/Pod/POM/Node/For.pm lib/Pod/POM/Node/Head1.pm lib/Pod/POM/Node/Head2.pm lib/Pod/POM/Node/Head3.pm lib/Pod/POM/Node/Head4.pm lib/Pod/POM/Node/Item.pm lib/Pod/POM/Node/Over.pm lib/Pod/POM/Node/Pod.pm lib/Pod/POM/Node/Sequence.pm lib/Pod/POM/Node/Text.pm lib/Pod/POM/Node/Verbatim.pm lib/Pod/POM/Nodes.pm lib/Pod/POM/Test.pm lib/Pod/POM/View.pm lib/Pod/POM/View/HTML.pm lib/Pod/POM/View/Pod.pm lib/Pod/POM/View/Text.pm t/00-use-modules.t t/10-parser.t t/11-view-pod.t t/12-view-text.t t/13-view-html.t t/PodPOMTestLib.pm t/YAML/Tiny.pm t/code.t t/complete.t t/head.t t/htmlescp.t t/htmllist.t t/htmlview.t t/list.t t/meta.t t/test.pod t/testcases/100-simple-document.pod t/testcases/100-simple-document.pom-dump t/testcases/100-simple-document.view-html t/testcases/100-simple-document.view-pod t/testcases/100-simple-document.view-text t/testcases/120-verbatim-paragraphs.pod t/testcases/120-verbatim-paragraphs.pom-dump t/testcases/120-verbatim-paragraphs.view-html t/testcases/120-verbatim-paragraphs.view-pod t/testcases/120-verbatim-paragraphs.view-text t/testcases/120-verbatim-paragraphs.yml t/testcases/130-blockquote-paragraphs.pod t/testcases/130-blockquote-paragraphs.pom-dump t/testcases/130-blockquote-paragraphs.view-html t/testcases/130-blockquote-paragraphs.view-pod t/testcases/130-blockquote-paragraphs.view-text t/testcases/130-blockquote-paragraphs.yml t/testcases/140-lists.pod t/testcases/140-lists.pom-dump t/testcases/140-lists.view-html t/testcases/140-lists.view-pod t/testcases/140-lists.view-text t/testcases/140-lists.yml t/testcases/150-head-sections.pod t/testcases/150-head-sections.pom-dump t/testcases/150-head-sections.view-html t/testcases/150-head-sections.view-pod t/testcases/150-head-sections.view-text t/testcases/160-begin-block.pod t/testcases/160-begin-block.pom-dump t/testcases/160-begin-block.view-html t/testcases/160-begin-block.view-pod t/testcases/160-begin-block.view-text t/testcases/200-simple-sequences.pod t/testcases/200-simple-sequences.pom-dump t/testcases/200-simple-sequences.view-html t/testcases/200-simple-sequences.view-pod t/testcases/200-simple-sequences.view-text t/testcases/210-extended-sequences.pod t/testcases/210-extended-sequences.pom-dump t/testcases/210-extended-sequences.view-html t/testcases/210-extended-sequences.view-pod t/testcases/210-extended-sequences.view-text t/testcases/220-mixed-sequences.pod t/testcases/220-mixed-sequences.pom-dump t/testcases/220-mixed-sequences.view-html t/testcases/220-mixed-sequences.view-pod t/testcases/220-mixed-sequences.view-text t/testcases/220-mixed-sequences.yml t/testcases/230-alternate-delimters.pod t/testcases/230-alternate-delimters.pom-dump t/testcases/230-alternate-delimters.view-html t/testcases/230-alternate-delimters.view-pod t/testcases/230-alternate-delimters.view-text t/testcases/240-encoding.pod t/testcases/240-encoding.view-html t/text.t t/textview.t t/view.t t/warn.t t/wrap.t Pod-POM-0.29/META.yml0000644000175000017500000000111012260471750013407 0ustar andrewandrew--- abstract: 'POD Object Model' author: - 'Andy Wardley ' build_requires: ExtUtils::MakeMaker: 6.59 File::Slurp: 0 Test::More: 0 configure_requires: ExtUtils::MakeMaker: 6.59 distribution_type: module dynamic_config: 1 generated_by: 'Module::Install version 1.06' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Pod-POM no_index: directory: - inc - t requires: Encode: 0 Text::Wrap: 2001.0929 parent: 0 perl: 5.6.0 resources: license: http://dev.perl.org/licenses/ version: 0.29 Pod-POM-0.29/t/0000755000175000017500000000000012260471766012417 5ustar andrewandrewPod-POM-0.29/t/testcases/0000755000175000017500000000000012260471766014415 5ustar andrewandrewPod-POM-0.29/t/testcases/200-simple-sequences.pom-dump0000644000175000017500000000164311355203553021651 0ustar andrewandrewpod head1 @title "NAME" text @text "200-simple-sequences" head1 @title "TESTCASES" text @text "This is " B< "bold" > "." text @text "This is " I< "italic" > "." text @text "This is " C< "code" > "." text @text "This is a " F< "filename" > "." text @text "This is an ampersand escape: " E< "amp" > "." text @text "This is a " S< "non-breaking space sequence" > "." text @text "This is an index entry." X< "index entry" > " (Nothing to see)" text @text "This line contains a Z sequence." Z< > Pod-POM-0.29/t/testcases/240-encoding.view-html0000644000175000017500000000022511355203554020333 0ustar andrewandrew

NAME

230-encoding

This is latin-2 for a c with an accent: Slaven Rezić

Pod-POM-0.29/t/testcases/130-blockquote-paragraphs.view-pod0000644000175000017500000000055311355203553022662 0ustar andrewandrew=head1 NAME 130-blockquote-paragraphs =head1 EXAMPLES Text before blockquote paragraph. =over 4 Blockquote paragraph. =back Text between blockquote paragraphs. =over 4 Multi-paragraph blockquote. Here is the second paragraph in the blockquote. Here is the third paragraph in the blockquote. =over 4 Nested blockquote paragraph. =back =back [EOF] Pod-POM-0.29/t/testcases/160-begin-block.view-html0000644000175000017500000000023011355203553020715 0ustar andrewandrew

NAME

160-begin-block

EXAMPLES

This is an HTML-only block

[EOF]

Pod-POM-0.29/t/testcases/150-head-sections.view-pod0000644000175000017500000000041611355203553021112 0ustar andrewandrew=head1 1 =head2 1.1 =head3 1.1.1 =head4 1.1.1.1 =head4 1.1.1.2 =head3 1.1.2 =head3 1.1.3 =head3 1.1.4 =head4 1.1.4.1 =head2 1.2 =head2 1.3 =head1 2 =head1 3 =head4 3.0.0.1 =head4 3.0.0.2 =head3 3.0.1 =head2 3.1 =head4 3.1.0.1 =head4 3.1.0.2 =head1 4 Pod-POM-0.29/t/testcases/130-blockquote-paragraphs.pod0000644000175000017500000000055211355203553021711 0ustar andrewandrew=head1 NAME 130-blockquote-paragraphs =head1 EXAMPLES Text before blockquote paragraph. =over 4 Blockquote paragraph. =back Text between blockquote paragraphs. =over 4 Multi-paragraph blockquote. Here is the second paragraph in the blockquote. Here is the third paragraph in the blockquote. =over 4 Nested blockquote paragraph. =back =back [EOF] Pod-POM-0.29/t/testcases/220-mixed-sequences.view-pod0000644000175000017500000000051611355203553021462 0ustar andrewandrew=head1 NAME 220-mixed-sequences =head1 TESTCASES This is B>. This is I>. This is code with a replacable text as italic: C)>. This is an bold with embedded escapes: B bold>. Code within non-breaking space sequence: S<< C<< code code code >> >> Pod-POM-0.29/t/testcases/160-begin-block.pom-dump0000644000175000017500000000073011355203553020544 0ustar andrewandrewpod head1 @title "NAME" text @text "160-begin-block" head1 @title "EXAMPLES" begin @format "text" text @text "This is a text-only block" begin @format "html" text @text "

This is an HTML-only block

" begin @format "obscure" text @text "This is an obscure block" text @text "[EOF]" Pod-POM-0.29/t/testcases/130-blockquote-paragraphs.yml0000644000175000017500000000032311355203554021725 0ustar andrewandrew# blockquote paragraphs --- notes: > Blockquote paragraphs consist of text within an =over/=back sequence without any =item directives. Such paragraphs can contain further blockquote paragraphs or lists. Pod-POM-0.29/t/testcases/210-extended-sequences.pod0000644000175000017500000000054711355203553021207 0ustar andrewandrew=head1 NAME 210-extended-sequences =head1 TESTCASES This is B<< bold >>. This is I<< italic >>. This is code: C<< $obj->method < 42 >>. This is a F<< filename >>. This is an ampersand escape: E<< amp >>. This is a S<< non-breaking space sequence >>. This is an index entry.X<< index entry >> (Nothing to see) This line contains a Z sequence.Z<< >> Pod-POM-0.29/t/testcases/210-extended-sequences.view-pod0000644000175000017500000000051411355203552022150 0ustar andrewandrew=head1 NAME 210-extended-sequences =head1 TESTCASES This is B. This is I. This is code: C<< $obj->method < 42 >>. This is a F. This is an ampersand escape: E. This is a S. This is an index entry.X (Nothing to see) This line contains a Z sequence.Z<> Pod-POM-0.29/t/testcases/140-lists.pom-dump0000644000175000017500000000136411355203554017531 0ustar andrewandrewpod head1 @title "NAME" text @text "140-lists" head1 @title "EXAMPLES" text @text "An itemized list:" over @indent "4" item @title "*" text @text "item 1" item @title "*" text @text "item 2" item @title "*" text @text "item 3" text @text "A definition list:" over @indent "4" item @title "Term 1" text @text "description 1" item @title "Term 2" text @text "description 2" Pod-POM-0.29/t/testcases/200-simple-sequences.view-text0000644000175000017500000000045211355203553022044 0ustar andrewandrewNAME 200-simple-sequences TESTCASES This is *bold*. This is _italic_. This is 'code'. This is a _filename_. This is an ampersand escape: &. This is a non-breaking space sequence. This is an index entry. (Nothing to see) This line contains a Z sequence. Pod-POM-0.29/t/testcases/120-verbatim-paragraphs.pod0000644000175000017500000000073611355203553021355 0ustar andrewandrew=head1 NAME 120-verbatim-paragraphs =head1 EXAMPLES =head2 Simple Verbatim Section Content First line Second line (note blank line with one space and empty line follow) Third line =head2 Verbatim Interspersed with Normal Text Text before verbatim paragraph. Verbatim paragraph Text between verbatim paragraphs Two line verbatim paragraph Text between verbatim paragraphs Verbatim paragraph More text after a blank line [EOF] Pod-POM-0.29/t/testcases/140-lists.view-html0000644000175000017500000000063111355203553017702 0ustar andrewandrew

NAME

140-lists

EXAMPLES

An itemized list:

  • item 1

  • item 2

  • item 3

A definition list:

Term 1

description 1

Term 2

description 2

Pod-POM-0.29/t/testcases/130-blockquote-paragraphs.pom-dump0000644000175000017500000000143611355203554022670 0ustar andrewandrewpod head1 @title "NAME" text @text "130-blockquote-paragraphs" head1 @title "EXAMPLES" text @text "Text before blockquote paragraph." over @indent "4" text @text "Blockquote paragraph." text @text "Text between blockquote paragraphs." over @indent "4" text @text "Multi-paragraph blockquote." text @text "Here is the second paragraph in" "the blockquote." text @text "Here is the third paragraph in" "the blockquote." over @indent "4" text @text "Nested blockquote paragraph." text @text "[EOF]" Pod-POM-0.29/t/testcases/140-lists.view-pod0000644000175000017500000000033511355203553017521 0ustar andrewandrew=head1 NAME 140-lists =head1 EXAMPLES An itemized list: =over 4 =item * item 1 =item * item 2 =item * item 3 =back A definition list: =over 4 =item Term 1 description 1 =item Term 2 description 2 =back Pod-POM-0.29/t/testcases/150-head-sections.view-text0000644000175000017500000000033611355203552021314 0ustar andrewandrew1 1.1 1.1.1 1.1.1.1 1.1.1.2 1.1.2 1.1.3 1.1.4 1.1.4.1 1.2 1.3 2 3 3.0.0.1 3.0.0.2 3.0.1 3.1 3.1.0.1 3.1.0.2 4 Pod-POM-0.29/t/testcases/150-head-sections.view-html0000644000175000017500000000052611355203553021276 0ustar andrewandrew

1

1.1

1.1.1

1.1.1.1

1.1.1.2

1.1.2

1.1.3

1.1.4

1.1.4.1

1.2

1.3

2

3

3.0.0.1

3.0.0.2

3.0.1

3.1

3.1.0.1

3.1.0.2

4

Pod-POM-0.29/t/testcases/120-verbatim-paragraphs.pom-dump0000644000175000017500000000176511355203554022335 0ustar andrewandrewpod head1 @title "NAME" text @text "120-verbatim-paragraphs" head1 @title "EXAMPLES" head2 @title "Simple Verbatim Section Content" verbatim @text " First line" "" " Second line" " (note blank line with one space and empty line follow)" " " "" " Third line" head2 @title "Verbatim Interspersed with Normal Text" text @text "Text before verbatim paragraph." verbatim @text " Verbatim paragraph" text @text "Text between verbatim paragraphs" verbatim @text " Two line" " verbatim paragraph" text @text "Text between verbatim paragraphs" verbatim @text " Verbatim paragraph" "" " More text after a blank line" text @text "[EOF]" Pod-POM-0.29/t/testcases/210-extended-sequences.view-html0000644000175000017500000000070311355203554022334 0ustar andrewandrew

NAME

210-extended-sequences

TESTCASES

This is bold.

This is italic.

This is code: $obj->method < 42.

This is a filename.

This is an ampersand escape: &.

This is a non-breaking space sequence.

This is an index entry. (Nothing to see)

This line contains a Z sequence.

Pod-POM-0.29/t/testcases/160-begin-block.view-text0000644000175000017500000000011511355203554020740 0ustar andrewandrewNAME 160-begin-block EXAMPLES This is a text-only block [EOF] Pod-POM-0.29/t/testcases/160-begin-block.view-pod0000644000175000017500000000033411355203554020541 0ustar andrewandrew=head1 NAME 160-begin-block =head1 EXAMPLES =begin text This is a text-only block =end text =begin html

This is an HTML-only block

=end html =begin obscure This is an obscure block =end obscure [EOF] Pod-POM-0.29/t/testcases/210-extended-sequences.view-text0000644000175000017500000000047711355203553022363 0ustar andrewandrewNAME 210-extended-sequences TESTCASES This is *bold*. This is _italic_. This is code: '$obj->method < 42'. This is a _filename_. This is an ampersand escape: &. This is a non-breaking space sequence. This is an index entry. (Nothing to see) This line contains a Z sequence. Pod-POM-0.29/t/testcases/220-mixed-sequences.pom-dump0000644000175000017500000000166511355203554021475 0ustar andrewandrewpod head1 @title "NAME" text @text "220-mixed-sequences" head1 @title "TESTCASES" text @text "This is " B< "bold and " I< "bold italic" > > "." text @text "This is " I< "italic and " B< "bold italic" > > "." text @text "This is code with a replacable text as italic: " C< "function(" I< "argument" > ")" > "." text @text "This is an bold with embedded escapes: " B< "bold " E< "amp" > " bold" > "." text @text "Code within non-breaking space sequence: " S<< C<< "code code code" >> >> Pod-POM-0.29/t/testcases/100-simple-document.pod0000644000175000017500000000010511355203553020507 0ustar andrewandrew=head1 NAME 100-simple =head1 DESCRIPTION A very simple Pod file. Pod-POM-0.29/t/testcases/100-simple-document.view-pod0000644000175000017500000000010611355203554021461 0ustar andrewandrew=head1 NAME 100-simple =head1 DESCRIPTION A very simple Pod file. Pod-POM-0.29/t/testcases/150-head-sections.pom-dump0000644000175000017500000000146611355203553021124 0ustar andrewandrewpod head1 @title "1" head2 @title "1.1" head3 @title "1.1.1" head4 @title "1.1.1.1" head4 @title "1.1.1.2" head3 @title "1.1.2" head3 @title "1.1.3" head3 @title "1.1.4" head4 @title "1.1.4.1" head2 @title "1.2" head2 @title "1.3" head1 @title "2" head1 @title "3" head4 @title "3.0.0.1" head4 @title "3.0.0.2" head3 @title "3.0.1" head2 @title "3.1" head4 @title "3.1.0.1" head4 @title "3.1.0.2" head1 @title "4" Pod-POM-0.29/t/testcases/130-blockquote-paragraphs.view-text0000644000175000017500000000054711355203554023070 0ustar andrewandrewNAME 130-blockquote-paragraphs EXAMPLES Text before blockquote paragraph. Blockquote paragraph. Text between blockquote paragraphs. Multi-paragraph blockquote. Here is the second paragraph in the blockquote. Here is the third paragraph in the blockquote. Nested blockquote paragraph. [EOF] Pod-POM-0.29/t/testcases/120-verbatim-paragraphs.yml0000644000175000017500000000062711355203554021374 0ustar andrewandrew# verbatim paragraphs options --- notes: > Verbatim paragraphs consist of lines that are indented. A blank line between two indended lines will initially be seen as separating the verbatim paragraphs, but the parser will note that the second verbatim paragraphs follows the first and will coalesce the paragraphs into a single verbatim block, preserving the whitespace on the separating lines. Pod-POM-0.29/t/testcases/230-alternate-delimters.pod0000644000175000017500000000024611355203553021361 0ustar andrewandrew=head1 NAME 230-alternate-delimiters =head1 TESTCASES Code containing a greater than symbol should be legal: C<< $obj->clone >> makes a deep copy of the object. Pod-POM-0.29/t/testcases/150-head-sections.pod0000644000175000017500000000042311355203554020141 0ustar andrewandrew=head1 1 =head2 1.1 =head3 1.1.1 =head4 1.1.1.1 =head4 1.1.1.2 =head3 1.1.2 =head3 1.1.3 =head3 1.1.4 =head4 1.1.4.1 =head2 1.2 =head2 1.3 =head1 2 =head1 3 =head4 3.0.0.1 =head4 3.0.0.2 =head3 3.0.1 =head2 3.1 =head4 3.1.0.1 =head4 3.1.0.2 =head1 4 =cut Pod-POM-0.29/t/testcases/140-lists.view-text0000644000175000017500000000030011355203553017713 0ustar andrewandrewNAME 140-lists EXAMPLES An itemized list: * item 1 * item 2 * item 3 A definition list: Term 1 description 1 Term 2 description 2 Pod-POM-0.29/t/testcases/210-extended-sequences.pom-dump0000644000175000017500000000174211355203553022161 0ustar andrewandrewpod head1 @title "NAME" text @text "210-extended-sequences" head1 @title "TESTCASES" text @text "This is " B<< "bold" >> "." text @text "This is " I<< "italic" >> "." text @text "This is code: " C<< "$obj-" ">" "method < 42" >> "." text @text "This is a " F<< "filename" >> "." text @text "This is an ampersand escape: " E<< "amp" >> "." text @text "This is a " S<< "non-breaking space sequence" >> "." text @text "This is an index entry." X<< "index entry" >> " (Nothing to see)" text @text "This line contains a Z sequence." Z<< >> Pod-POM-0.29/t/testcases/100-simple-document.view-text0000644000175000017500000000007611355203553021670 0ustar andrewandrewNAME 100-simple DESCRIPTION A very simple Pod file. Pod-POM-0.29/t/testcases/220-mixed-sequences.yml0000644000175000017500000000023111355203553020523 0ustar andrewandrew--- notes: > Sequences can be expressed as N or N<< text >>. This test mixes those formats. view-pod: todo: pod view output not as expected Pod-POM-0.29/t/testcases/100-simple-document.pom-dump0000644000175000017500000000025411355203553021470 0ustar andrewandrewpod head1 @title "NAME" text @text "100-simple" head1 @title "DESCRIPTION" text @text "A very simple Pod file." Pod-POM-0.29/t/testcases/220-mixed-sequences.view-text0000644000175000017500000000047611355203553021671 0ustar andrewandrewNAME 220-mixed-sequences TESTCASES This is *bold and _bold italic_*. This is _italic and *bold italic*_. This is code with a replacable text as italic: 'function(_argument_)'. This is an bold with embedded escapes: *bold & bold*. Code within non-breaking space sequence: 'code code code' Pod-POM-0.29/t/testcases/140-lists.pod0000644000175000017500000000033411355203552016547 0ustar andrewandrew=head1 NAME 140-lists =head1 EXAMPLES An itemized list: =over 4 =item * item 1 =item * item 2 =item * item 3 =back A definition list: =over 4 =item Term 1 description 1 =item Term 2 description 2 =back Pod-POM-0.29/t/testcases/240-encoding.pod0000644000175000017500000000014611355203553017202 0ustar andrewandrew=head1 NAME 230-encoding =encoding iso-8859-2 This is latin-2 for a c with an accent: Slaven Reziæ Pod-POM-0.29/t/testcases/120-verbatim-paragraphs.view-text0000644000175000017500000000112311355203553022516 0ustar andrewandrewNAME 120-verbatim-paragraphs EXAMPLES Simple Verbatim Section Content First line Second line (note blank line with one space and empty line follow) Third line Verbatim Interspersed with Normal Text Text before verbatim paragraph. Verbatim paragraph Text between verbatim paragraphs Two line verbatim paragraph Text between verbatim paragraphs Verbatim paragraph More text after a blank line [EOF] Pod-POM-0.29/t/testcases/160-begin-block.pod0000644000175000017500000000033311355203554017570 0ustar andrewandrew=head1 NAME 160-begin-block =head1 EXAMPLES =begin text This is a text-only block =end text =begin html

This is an HTML-only block

=end html =begin obscure This is an obscure block =end obscure [EOF] Pod-POM-0.29/t/testcases/230-alternate-delimters.view-text0000644000175000017500000000023511355203553022531 0ustar andrewandrewNAME 230-alternate-delimiters TESTCASES Code containing a greater than symbol should be legal: '$obj->clone' makes a deep copy of the object. Pod-POM-0.29/t/testcases/200-simple-sequences.view-html0000644000175000017500000000065011355203554022025 0ustar andrewandrew

NAME

200-simple-sequences

TESTCASES

This is bold.

This is italic.

This is code.

This is a filename.

This is an ampersand escape: &.

This is a non-breaking space sequence.

This is an index entry. (Nothing to see)

This line contains a Z sequence.

Pod-POM-0.29/t/testcases/200-simple-sequences.pod0000644000175000017500000000046211355203553020673 0ustar andrewandrew=head1 NAME 200-simple-sequences =head1 TESTCASES This is B. This is I. This is C. This is a F. This is an ampersand escape: E. This is a S. This is an index entry.X (Nothing to see) This line contains a Z sequence.Z<> Pod-POM-0.29/t/testcases/200-simple-sequences.view-pod0000644000175000017500000000046311355203554021645 0ustar andrewandrew=head1 NAME 200-simple-sequences =head1 TESTCASES This is B. This is I. This is C. This is a F. This is an ampersand escape: E. This is a S. This is an index entry.X (Nothing to see) This line contains a Z sequence.Z<> Pod-POM-0.29/t/testcases/220-mixed-sequences.pod0000644000175000017500000000051611355203552020511 0ustar andrewandrew=head1 NAME 220-mixed-sequences =head1 TESTCASES This is B>. This is I>. This is code with a replacable text as italic: C)>. This is an bold with embedded escapes: B bold>. Code within non-breaking space sequence: S<< C<< code code code >> >> Pod-POM-0.29/t/testcases/230-alternate-delimters.view-html0000644000175000017500000000036511355203553022515 0ustar andrewandrew

NAME

230-alternate-delimiters

TESTCASES

Code containing a greater than symbol should be legal:

$obj->clone makes a deep copy of the object.

Pod-POM-0.29/t/testcases/120-verbatim-paragraphs.view-html0000644000175000017500000000113711355203554022504 0ustar andrewandrew

NAME

120-verbatim-paragraphs

EXAMPLES

Simple Verbatim Section Content

    First line

    Second line
    (note blank line with one space and empty line follow)
 

    Third line

Verbatim Interspersed with Normal Text

Text before verbatim paragraph.

    Verbatim paragraph

Text between verbatim paragraphs

    Two line
    verbatim paragraph

Text between verbatim paragraphs

    Verbatim paragraph

    More text after a blank line

[EOF]

Pod-POM-0.29/t/testcases/230-alternate-delimters.view-pod0000644000175000017500000000024611355203554022332 0ustar andrewandrew=head1 NAME 230-alternate-delimiters =head1 TESTCASES Code containing a greater than symbol should be legal: C<< $obj->clone >> makes a deep copy of the object. Pod-POM-0.29/t/testcases/230-alternate-delimters.pom-dump0000644000175000017500000000054111355203553022333 0ustar andrewandrewpod head1 @title "NAME" text @text "230-alternate-delimiters" head1 @title "TESTCASES" text @text "Code containing a greater than symbol should be legal:" text @text C<< "$obj-" ">" "clone" >> " makes a deep copy of the object." Pod-POM-0.29/t/testcases/130-blockquote-paragraphs.view-html0000644000175000017500000000076611355203554023053 0ustar andrewandrew

NAME

130-blockquote-paragraphs

EXAMPLES

Text before blockquote paragraph.

Blockquote paragraph.

Text between blockquote paragraphs.

Multi-paragraph blockquote.

Here is the second paragraph in the blockquote.

Here is the third paragraph in the blockquote.

Nested blockquote paragraph.

[EOF]

Pod-POM-0.29/t/testcases/120-verbatim-paragraphs.view-pod0000644000175000017500000000073711355203553022326 0ustar andrewandrew=head1 NAME 120-verbatim-paragraphs =head1 EXAMPLES =head2 Simple Verbatim Section Content First line Second line (note blank line with one space and empty line follow) Third line =head2 Verbatim Interspersed with Normal Text Text before verbatim paragraph. Verbatim paragraph Text between verbatim paragraphs Two line verbatim paragraph Text between verbatim paragraphs Verbatim paragraph More text after a blank line [EOF] Pod-POM-0.29/t/testcases/100-simple-document.view-html0000644000175000017500000000020611355203553021643 0ustar andrewandrew

NAME

100-simple

DESCRIPTION

A very simple Pod file.

Pod-POM-0.29/t/testcases/140-lists.yml0000644000175000017500000000030111355203553016561 0ustar andrewandrew--- notes: > Lists consist of =over/=back sequences containing =items. view-html: todo: definition lists not working properly yet view-text: todo: itemized lists not working properly yet Pod-POM-0.29/t/testcases/220-mixed-sequences.view-html0000644000175000017500000000072011355203553021641 0ustar andrewandrew

NAME

220-mixed-sequences

TESTCASES

This is bold and bold italic.

This is italic and bold italic.

This is code with a replacable text as italic: function(argument).

This is an bold with embedded escapes: bold & bold.

Code within non-breaking space sequence: code code code

Pod-POM-0.29/t/text.t0000644000175000017500000000142011355203555013556 0ustar andrewandrew#!/usr/bin/perl -w # -*- perl -*- use strict; use lib qw( ./lib ../lib ); use Pod::POM::Test; my $DEBUG = 1; ntests(7); my $parser = Pod::POM->new(); my $pom = $parser->parse_file(\*DATA); assert( $pom ); my $text = $pom->head1->[0]->text; assert( $text ); match( scalar @$text, 2 ); match( $text->[0], "A test Pod document.\n\n" ); match( $text->[1], "Another paragraph with a B tag.\n\n" ); match( $text, "A test Pod document.\n\n" . "Another paragraph with a B tag.\n\n" ); match( $pom->head1->[0], "=head1 NAME\n\n" . "A test Pod document.\n\n" . "Another paragraph with a B tag.\n\n" ); __DATA__ =head1 NAME A test Pod document. Another paragraph with a B tag. Pod-POM-0.29/t/list.t0000644000175000017500000000104011355203555013543 0ustar andrewandrew#!/usr/bin/perl -w # -*- perl -*- use strict; use lib qw( ./lib ../lib ); use Pod::POM::Test; #$Pod::POM::Node::DEBUG = 1; my $DEBUG = 1; ntests(2); my $text; { local $/ = undef; $text = ; } my $parser = Pod::POM->new(); my $pom = $parser->parse_text($text); assert( defined $pom ); my $out = "$pom"; $out =~ s/\s+$//; match( $out, $text ); __DATA__ =over 4 =item Foo This is Foo =item Bar This is Bar =over 4 =item Bar/Baz This is Bar/Baz =back =item Baz This is Baz =backPod-POM-0.29/t/10-parser.t0000755000175000017500000000041111355203555014306 0ustar andrewandrew#!/usr/bin/perl -w # -*- perl -*- # $Id: 10-features.t 4114 2009-03-04 22:28:43Z andrew $ use strict; use Cwd qw(abs_path); use FindBin qw($Bin); use lib ($Bin, "$Bin/../lib"); use PodPOMTestLib; run_tests(Pom => 'dump'); Pod-POM-0.29/t/YAML/0000755000175000017500000000000012260471766013161 5ustar andrewandrewPod-POM-0.29/t/YAML/Tiny.pm0000644000175000017500000006632411355203554014445 0ustar andrewandrewpackage YAML::Tiny; use strict; BEGIN { require 5.004; require Exporter; $YAML::Tiny::VERSION = '1.36'; $YAML::Tiny::errstr = ''; @YAML::Tiny::ISA = qw{ Exporter }; @YAML::Tiny::EXPORT = qw{ Load Dump }; @YAML::Tiny::EXPORT_OK = qw{ LoadFile DumpFile freeze thaw }; } my $ESCAPE_CHAR = '[\\x00-\\x08\\x0b-\\x0d\\x0e-\\x1f\"\n]'; # Escapes for unprintable characters my @UNPRINTABLE = qw( z x01 x02 x03 x04 x05 x06 a x08 t n v f r x0e x0f x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x1a e x1c x1d x1e x1f ); # Printable characters for escapes my %UNESCAPES = ( z => "\x00", a => "\x07", t => "\x09", n => "\x0a", v => "\x0b", f => "\x0c", r => "\x0d", e => "\x1b", '\\' => '\\', ); # Create an empty YAML::Tiny object sub new { my $class = shift; bless [ @_ ], $class; } # Create an object from a file sub read { my $class = ref $_[0] ? ref shift : shift; # Check the file my $file = shift or return $class->_error( 'You did not specify a file name' ); return $class->_error( "File '$file' does not exist" ) unless -e $file; return $class->_error( "'$file' is a directory, not a file" ) unless -f _; return $class->_error( "Insufficient permissions to read '$file'" ) unless -r _; # Slurp in the file local $/ = undef; local *CFG; unless ( open(CFG, $file) ) { return $class->_error( "Failed to open file '$file': $!" ); } my $contents = ; unless ( close(CFG) ) { return $class->_error( "Failed to close file '$file': $!" ); } $class->read_string( $contents ); } # Create an object from a string sub read_string { my $class = ref $_[0] ? ref shift : shift; my $self = bless [], $class; # Handle special cases return undef unless defined $_[0]; return $self unless length $_[0]; unless ( $_[0] =~ /[\012\015]+$/ ) { return $class->_error("Stream does not end with newline character"); } # Split the file into lines my @lines = grep { ! /^\s*(?:\#.*)?$/ } split /(?:\015{1,2}\012|\015|\012)/, shift; # Strip the initial YAML header @lines and $lines[0] =~ /^\%YAML[: ][\d\.]+.*$/ and shift @lines; # A nibbling parser while ( @lines ) { # Do we have a document header? if ( $lines[0] =~ /^---\s*(?:(.+)\s*)?$/ ) { # Handle scalar documents shift @lines; if ( defined $1 and $1 !~ /^(?:\#.+|\%YAML[: ][\d\.]+)$/ ) { push @$self, $self->_read_scalar( "$1", [ undef ], \@lines ); next; } } if ( ! @lines or $lines[0] =~ /^(?:---|\.\.\.)/ ) { # A naked document push @$self, undef; while ( @lines and $lines[0] !~ /^---/ ) { shift @lines; } } elsif ( $lines[0] =~ /^\s*\-/ ) { # An array at the root my $document = [ ]; push @$self, $document; $self->_read_array( $document, [ 0 ], \@lines ); } elsif ( $lines[0] =~ /^(\s*)\S/ ) { # A hash at the root my $document = { }; push @$self, $document; $self->_read_hash( $document, [ length($1) ], \@lines ); } else { die "YAML::Tiny does not support the line '$lines[0]'"; } } $self; } # Deparse a scalar string to the actual scalar sub _read_scalar { my ($self, $string, $indent, $lines) = @_; # Trim trailing whitespace $string =~ s/\s*$//; # Explitic null/undef return undef if $string eq '~'; # Quotes if ( $string =~ /^\'(.*?)\'$/ ) { return '' unless defined $1; my $rv = $1; $rv =~ s/\'\'/\'/g; return $rv; } if ( $string =~ /^\"((?:\\.|[^\"])*)\"$/ ) { my $str = $1; $str =~ s/\\"/"/g; $str =~ s/\\([never\\fartz]|x([0-9a-fA-F]{2}))/(length($1)>1)?pack("H2",$2):$UNESCAPES{$1}/gex; return $str; } # Special cases die "Unsupported YAML feature" if $string =~ /^['"!&]/; return {} if $string eq '{}'; return [] if $string eq '[]'; # Regular unquoted string return $string unless $string =~ /^[>|]/; # Error die "Multi-line scalar content missing" unless @$lines; # Check the indent depth $lines->[0] =~ /^(\s*)/; $indent->[-1] = length("$1"); if ( defined $indent->[-2] and $indent->[-1] <= $indent->[-2] ) { die "Illegal line indenting"; } # Pull the lines my @multiline = (); while ( @$lines ) { $lines->[0] =~ /^(\s*)/; last unless length($1) >= $indent->[-1]; push @multiline, substr(shift(@$lines), length($1)); } my $j = (substr($string, 0, 1) eq '>') ? ' ' : "\n"; my $t = (substr($string, 1, 1) eq '-') ? '' : "\n"; return join( $j, @multiline ) . $t; } # Parse an array sub _read_array { my ($self, $array, $indent, $lines) = @_; while ( @$lines ) { # Check for a new document if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) { while ( @$lines and $lines->[0] !~ /^---/ ) { shift @$lines; } return 1; } # Check the indent level $lines->[0] =~ /^(\s*)/; if ( length($1) < $indent->[-1] ) { return 1; } elsif ( length($1) > $indent->[-1] ) { die "Hash line over-indented"; } if ( $lines->[0] =~ /^(\s*\-\s+)[^\'\"]\S*\s*:(?:\s+|$)/ ) { # Inline nested hash my $indent2 = length("$1"); $lines->[0] =~ s/-/ /; push @$array, { }; $self->_read_hash( $array->[-1], [ @$indent, $indent2 ], $lines ); } elsif ( $lines->[0] =~ /^\s*\-(\s*)(.+?)\s*$/ ) { # Array entry with a value shift @$lines; push @$array, $self->_read_scalar( "$2", [ @$indent, undef ], $lines ); } elsif ( $lines->[0] =~ /^\s*\-\s*$/ ) { shift @$lines; unless ( @$lines ) { push @$array, undef; return 1; } if ( $lines->[0] =~ /^(\s*)\-/ ) { my $indent2 = length("$1"); if ( $indent->[-1] == $indent2 ) { # Null array entry push @$array, undef; } else { # Naked indenter push @$array, [ ]; $self->_read_array( $array->[-1], [ @$indent, $indent2 ], $lines ); } } elsif ( $lines->[0] =~ /^(\s*)\S/ ) { push @$array, { }; $self->_read_hash( $array->[-1], [ @$indent, length("$1") ], $lines ); } else { die "YAML::Tiny does not support the line '$lines->[0]'"; } } elsif ( defined $indent->[-2] and $indent->[-1] == $indent->[-2] ) { # This is probably a structure like the following... # --- # foo: # - list # bar: value # # ... so lets return and let the hash parser handle it return 1; } else { die "YAML::Tiny does not support the line '$lines->[0]'"; } } return 1; } # Parse an array sub _read_hash { my ($self, $hash, $indent, $lines) = @_; while ( @$lines ) { # Check for a new document if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) { while ( @$lines and $lines->[0] !~ /^---/ ) { shift @$lines; } return 1; } # Check the indent level $lines->[0] =~ /^(\s*)/; if ( length($1) < $indent->[-1] ) { return 1; } elsif ( length($1) > $indent->[-1] ) { die "Hash line over-indented"; } # Get the key unless ( $lines->[0] =~ s/^\s*([^\'\" ][^\n]*?)\s*:(\s+|$)// ) { die "Unsupported YAML feature" if $lines->[0] =~ /^\s*[?'"]/; die "Bad or unsupported hash line"; } my $key = $1; # Do we have a value? if ( length $lines->[0] ) { # Yes $hash->{$key} = $self->_read_scalar( shift(@$lines), [ @$indent, undef ], $lines ); } else { # An indent shift @$lines; unless ( @$lines ) { $hash->{$key} = undef; return 1; } if ( $lines->[0] =~ /^(\s*)-/ ) { $hash->{$key} = []; $self->_read_array( $hash->{$key}, [ @$indent, length($1) ], $lines ); } elsif ( $lines->[0] =~ /^(\s*)./ ) { my $indent2 = length("$1"); if ( $indent->[-1] >= $indent2 ) { # Null hash entry $hash->{$key} = undef; } else { $hash->{$key} = {}; $self->_read_hash( $hash->{$key}, [ @$indent, length($1) ], $lines ); } } } } return 1; } # Save an object to a file sub write { my $self = shift; my $file = shift or return $self->_error( 'No file name provided' ); # Write it to the file open( CFG, '>' . $file ) or return $self->_error( "Failed to open file '$file' for writing: $!" ); print CFG $self->write_string; close CFG; return 1; } # Save an object to a string sub write_string { my $self = shift; return '' unless @$self; # Iterate over the documents my $indent = 0; my @lines = (); foreach my $cursor ( @$self ) { push @lines, '---'; # An empty document if ( ! defined $cursor ) { # Do nothing # A scalar document } elsif ( ! ref $cursor ) { $lines[-1] .= ' ' . $self->_write_scalar( $cursor, $indent ); # A list at the root } elsif ( ref $cursor eq 'ARRAY' ) { unless ( @$cursor ) { $lines[-1] .= ' []'; next; } push @lines, $self->_write_array( $cursor, $indent, {} ); # A hash at the root } elsif ( ref $cursor eq 'HASH' ) { unless ( %$cursor ) { $lines[-1] .= ' {}'; next; } push @lines, $self->_write_hash( $cursor, $indent, {} ); } else { Carp::croak("Cannot serialize " . ref($cursor)); } } join '', map { "$_\n" } @lines; } sub _write_scalar { my $str = $_[1]; return '~' unless defined $str; if ( $str =~ /$ESCAPE_CHAR/ ) { $str =~ s/\\/\\\\/g; $str =~ s/"/\\"/g; $str =~ s/\n/\\n/g; $str =~ s/([\x00-\x1f])/\\$UNPRINTABLE[ord($1)]/g; return qq{"$str"}; } if ( length($str) == 0 or $str =~ /(?:^\W|\s)/ ) { $str =~ s/\'/\'\'/; return "'$str'"; } return $str; } sub _write_array { my ($self, $array, $indent, $seen) = @_; if ( $seen->{refaddr($array)}++ ) { die "YAML::Tiny does not support circular references"; } my @lines = (); foreach my $el ( @$array ) { my $line = (' ' x $indent) . '-'; my $type = ref $el; if ( ! $type ) { $line .= ' ' . $self->_write_scalar( $el, $indent + 1 ); push @lines, $line; } elsif ( $type eq 'ARRAY' ) { if ( @$el ) { push @lines, $line; push @lines, $self->_write_array( $el, $indent + 1, $seen ); } else { $line .= ' []'; push @lines, $line; } } elsif ( $type eq 'HASH' ) { if ( keys %$el ) { push @lines, $line; push @lines, $self->_write_hash( $el, $indent + 1, $seen ); } else { $line .= ' {}'; push @lines, $line; } } else { die "YAML::Tiny does not support $type references"; } } @lines; } sub _write_hash { my ($self, $hash, $indent, $seen) = @_; if ( $seen->{refaddr($hash)}++ ) { die "YAML::Tiny does not support circular references"; } my @lines = (); foreach my $name ( sort keys %$hash ) { my $el = $hash->{$name}; my $line = (' ' x $indent) . "$name:"; my $type = ref $el; if ( ! $type ) { $line .= ' ' . $self->_write_scalar( $el, $indent + 1 ); push @lines, $line; } elsif ( $type eq 'ARRAY' ) { if ( @$el ) { push @lines, $line; push @lines, $self->_write_array( $el, $indent + 1, $seen ); } else { $line .= ' []'; push @lines, $line; } } elsif ( $type eq 'HASH' ) { if ( keys %$el ) { push @lines, $line; push @lines, $self->_write_hash( $el, $indent + 1, $seen ); } else { $line .= ' {}'; push @lines, $line; } } else { die "YAML::Tiny does not support $type references"; } } @lines; } # Set error sub _error { $YAML::Tiny::errstr = $_[1]; undef; } # Retrieve error sub errstr { $YAML::Tiny::errstr; } ##################################################################### # YAML Compatibility sub Dump { YAML::Tiny->new(@_)->write_string; } sub Load { my $self = YAML::Tiny->read_string(@_) or Carp::croak("Failed to load YAML document from string"); if ( wantarray ) { return @$self; } else { # To match YAML.pm, return the last document return $self->[-1]; } } BEGIN { *freeze = *Dump; *thaw = *Load; } sub DumpFile { my $file = shift; YAML::Tiny->new(@_)->write($file); } sub LoadFile { my $self = YAML::Tiny->read($_[0]) or Carp::croak("Failed to load YAML document from '" . ($_[0] || '') . "'"); if ( wantarray ) { return @$self; } else { # To match YAML.pm, return the last document return $self->[-1]; } } ##################################################################### # Use Scalar::Util if possible, otherwise emulate it BEGIN { eval { require Scalar::Util; }; if ( $@ ) { # Failed to load Scalar::Util eval <<'END_PERL'; sub refaddr { my $pkg = ref($_[0]) or return undef; if (!!UNIVERSAL::can($_[0], 'can')) { bless $_[0], 'Scalar::Util::Fake'; } else { $pkg = undef; } "$_[0]" =~ /0x(\w+)/; my $i = do { local $^W; hex $1 }; bless $_[0], $pkg if defined $pkg; $i; } END_PERL } else { Scalar::Util->import('refaddr'); } } 1; __END__ =pod =head1 NAME YAML::Tiny - Read/Write YAML files with as little code as possible =head1 PREAMBLE The YAML specification is huge. Really, B huge. It contains all the functionality of XML, except with flexibility and choice, which makes it easier to read, but with a formal specification that is more complex than XML. The original pure-Perl implementation L costs just over 4 megabytes of memory to load. Just like with Windows .ini files (3 meg to load) and CSS (3.5 meg to load) the situation is just asking for a B module, an incomplete but correct and usable subset of the functionality, in as little code as possible. Like the other C<::Tiny> modules, YAML::Tiny will have no non-core dependencies, not require a compiler, and be back-compatible to at least perl 5.005_03, and ideally 5.004. =head1 SYNOPSIS ############################################# # In your file --- rootproperty: blah section: one: two three: four Foo: Bar empty: ~ ############################################# # In your program use YAML::Tiny; # Create a YAML file my $yaml = YAML::Tiny->new; # Open the config $yaml = YAML::Tiny->read( 'file.yml' ); # Reading properties my $root = $yaml->[0]->{rootproperty}; my $one = $yaml->[0]->{section}->{one}; my $Foo = $yaml->[0]->{section}->{Foo}; # Changing data $yaml->[0]->{newsection} = { this => 'that' }; # Add a section $yaml->[0]->{section}->{Foo} = 'Not Bar!'; # Change a value delete $yaml->[0]->{section}; # Delete a value or section # Add an entire document $yaml->[1] = [ 'foo', 'bar', 'baz' ]; # Save the file $yaml->write( 'file.conf' ); =head1 DESCRIPTION B is a perl class for reading and writing YAML-style files, written with as little code as possible, reducing load time and memory overhead. Most of the time it is accepted that Perl applications use a lot of memory and modules. The B<::Tiny> family of modules is specifically intended to provide an ultralight and zero-dependency alternative to many more-thorough standard modules. This module is primarily for reading human-written files (like simple config files) and generating very simple human-readable files. Note that I said B and not B. The sort of files that your average manager or secretary should be able to look at and make sense of. L does not generate comments, it won't necesarily preserve the order of your hashes, and it will normalise if reading in and writing out again. It only supports a very basic subset of the full YAML specification. Usage is targetted at files like Perl's META.yml, for which a small and easily-embeddable module is extremely attractive. Features will only be added if they are human readable, and can be written in a few lines of code. Please don't be offended if your request is refused. Someone has to draw the line, and for YAML::Tiny that someone is me. If you need something with more power move up to L (4 megabytes of memory overhead) or L (275k, but requires libsyck and a C compiler). To restate, L does B preserve your comments, whitespace, or the order of your YAML data. But it should round-trip from Perl structure to file and back again just fine. =head1 YAML TINY SPECIFICATION This section of the documentation provides a specification for "YAML Tiny", a subset of the YAML specification. It is based on and described comparatively to the YAML 1.1 Working Draft 2004-12-28 specification, located at L. Terminology and chapter numbers are based on that specification. =head2 1. Introduction and Goals The purpose of the YAML Tiny specification is to describe a useful subset of the YAML specification that can be used for typical document-oriented uses such as configuration files and simple data structure dumps. Many specification elements that add flexibility or extensibility are intentionally removed, as is support for complex datastructures, class and object-orientation. In general, YAML Tiny targets only those data structures available in JSON, with the additional limitation that only simple keys are supported. As a result, all possible YAML Tiny documents should be able to be transformed into an equivalent JSON document, although the reverse is not necesarily true (but will be true in simple cases). As a result of these simplifications the YAML Tiny specification should be implementable in a relatively small amount of code in any language that supports Perl Compatible Regular Expressions (PCRE). =head2 2. Introduction YAML Tiny supports three data structures. These are scalars (in a variety of forms), block-form sequences and block-form mappings. Flow-style sequences and mappings are not supported, with some minor exceptions detailed later. The use of three dashes "---" to indicate the start of a new document is supported, and multiple documents per file/stream is allowed. Both line and inline comments are supported. Scalars are supported via the plain style, single quote and double quote, as well as literal-style and folded-style multi-line scalars. The use of tags is not supported. The use of anchors and aliases is not supported. The use of directives is supported only for the %YAML directive. =head2 3. Processing YAML Tiny Information B The YAML specification dictates three-phase serialization and three-phase deserialization. The YAML Tiny specification does not mandate any particular methodology or mechanism for parsing. Any compliant parser is only required to parse a single document at a time. The ability to support streaming documents is optional and most likely non-typical. Because anchors and aliases are not supported, the resulting representation graph is thus directed but (unlike the main YAML specification) B. Circular references/pointers are not possible, and any YAML Tiny serializer detecting a circulars should error with an appropriate message. B YAML Tiny is notionally unicode, but support for unicode is required if the underlying language or system being used to implement a parser does not support Unicode. If unicode is encountered in this case an error should be returned. B YAML Tiny parsers and emitters are not expected to recover from adapt to errors. The specific error modality of any implementation is not dictated (return codes, exceptions, etc) but is expected to be consistant. =head2 4. Syntax B YAML Tiny streams are implemented primarily using the ASCII character set, although the use of Unicode inside strings is allowed if support by the implementation. Specific YAML Tiny encoded document types aiming for maximum compatibility should restrict themselves to ASCII. The escaping and unescaping of the 8-bit YAML escapes is required. The escaping and unescaping of 16-bit and 32-bit YAML escapes is not required. B Support for the "~" null/undefined indicator is required. Implementations may represent this as appropriate for the underlying language. Support for the "-" block sequence indicator is required. Support for the "?" mapping key indicator is B required. Support for the ":" mapping value indicator is required. Support for the "," flow collection indicator is B required. Support for the "[" flow sequence indicator is B required, with one exception (detailed below). Support for the "]" flow sequence indicator is B required, with one exception (detailed below). Support for the "{" flow mapping indicator is B required, with one exception (detailed below). Support for the "}" flow mapping indicator is B required, with one exception (detailed below). Support for the "#" comment indicator is required. Support for the "&" anchor indicator is B required. Support for the "*" alias indicator is B required. Support for the "!" tag indicator is B required. Support for the "|" literal block indicator is required. Support for the ">" folded block indicator is required. Support for the "'" single quote indicator is required. Support for the """ double quote indicator is required. Support for the "%" directive indicator is required, but only for the special case of a %YAML version directive before the "---" document header, or on the same line as the document header. For example: %YAML 1.1 --- - A sequence with a single element Special Exception: To provide the ability to support empty sequences and mappings, support for the constructs [] (empty sequence) and {} (empty mapping) are required. For example, %YAML 1.1 # A document consisting of only an empty mapping --- {} # A document consisting of only an empty sequence --- [] # A document consisting of an empty mapping within a sequence - foo - {} - bar B Other than the empty sequence and mapping cases described above, YAML Tiny supports only the indentation-based block-style group of contexts. All five scalar contexts are supported. Indentation spaces work as per the YAML specification in all cases. Comments work as per the YAML specification in all simple cases. Support for indented multi-line comments is B required. Seperation spaces work as per the YAML specification in all cases. B The only directive supported by the YAML Tiny specification is the %YAML language/version identifier. Although detected, this directive will have no control over the parsing itself. The parser must recognise both the YAML 1.0 and YAML 1.1+ formatting of this directive (as well as the commented form, although no explicit code should be needed to deal with this case, being a comment anyway) That is, all of the following should be supported. --- #YAML:1.0 - foo %YAML:1.0 --- - foo % YAML 1.1 --- - foo Support for the %TAG directive is B required. Support for additional directives is B required. Support for the document boundary marker "---" is required. Support for the document boundary market "..." is B required. If necesary, a document boundary should simply by indicated with a "---" marker, with not preceding "..." marker. Support for empty streams (containing no documents) is required. Support for implicit document starts is required. That is, the following must be equivalent. # Full form %YAML 1.1 --- foo: bar # Implicit form foo: bar B Support for nodes optional anchor and tag properties are B required. Support for node anchors is B required. Supprot for node tags is B required. Support for alias nodes is B required. Support for flow nodes is B required. Support for block nodes is required. B Support for all five scalar styles are required as per the YAML specification, although support for quoted scalars spanning more than one line is B required. Support for the chomping indicators on multi-line scalar styles is required. B Support for block-style sequences is required. Support for flow-style sequences is B required. Support for block-style mappings is required. Support for flow-style mappings is B required. Both sequences and mappings should be able to be arbitrarily nested. Support for plain-style mapping keys is required. Support for quoted keys in mappings is B required. Support for "?"-indicated explicit keys is B required. Here endeth the specification. =head2 Additional Perl-Specific Notes For some Perl applications, it's important to know if you really have a number and not a string. That is, in some contexts is important that 3 the number is distinctive from "3" the string. Because even Perl itself is not trivially able to understand the difference (certainly without XS-based modules) Perl implementations of the YAML Tiny specification are not required to retain the distinctiveness of 3 vs "3". =head1 METHODS =head2 new The constructor C creates and returns an empty C object. =head2 read $filename The C constructor reads a YAML file, and returns a new C object containing the contents of the file. Returns the object on success, or C on error. When C fails, C sets an error message internally you can recover via Cerrstr>. Although in B cases a failed C will also set the operating system error variable C<$!>, not all errors do and you should not rely on using the C<$!> variable. =head2 read_string $string; The C method takes as argument the contents of a YAML file (a YAML document) as a string and returns the C object for it. =head2 write $filename The C method generates the file content for the properties, and writes it to disk to the filename specified. Returns true on success or C on error. =head2 write_string Generates the file content for the object and returns it as a string. =head2 errstr When an error occurs, you can retrieve the error message either from the C<$YAML::Tiny::errstr> variable, or using the C method. =head1 FUNCTIONS YAML::Tiny implements a number of functions to add compatibility with the L API. These should be a drop-in replacement, except that YAML::Tiny will B export functions by default, and so you will need to explicitly import the functions. =head2 Dump my $string = Dump(list-of-Perl-data-structures); Turn Perl data into YAML. This function works very much like Data::Dumper::Dumper(). It takes a list of Perl data strucures and dumps them into a serialized form. It returns a string containing the YAML stream. The structures can be references or plain scalars. =head2 Load my @documents = Load(string-containing-a-YAML-stream); Turn YAML into Perl data. This is the opposite of Dump. Just like L's thaw() function or the eval() function in relation to L. It parses a string containing a valid YAML stream into a list of Perl data structures. =head2 freeze() and thaw() Aliases to Dump() and Load() for L fans. This will also allow YAML::Tiny to be plugged directly into modules like POE.pm, that use the freeze/thaw API for internal serialization. =head2 DumpFile(filepath, list) Writes the YAML stream to a file instead of just returning a string. =head2 LoadFile(filepath) Reads the YAML stream from a file instead of a string. =head1 SUPPORT Bugs should be reported via the CPAN bug tracker at L =begin html For other issues, or commercial enhancement or support, please contact Adam Kennedy directly. =end html =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 SEE ALSO L, L, L, L, L, L =head1 COPYRIGHT Copyright 2006 - 2009 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut Pod-POM-0.29/t/view.t0000644000175000017500000000316011355203555013547 0ustar andrewandrew#!/usr/bin/perl -w # -*- perl -*- use strict; use lib qw( ./lib ../lib ); use Pod::POM; use Pod::POM::View; use Pod::POM::Test; ntests(2); #------------------------------------------------------------------------ package My::View; use base qw( Pod::POM::View::Text ); sub view_head1 { my ($self, $head1) = @_; my $title = $head1->title->present($self); $self->visit('head1'); my $output = "

$title

\n\n" . $head1->content->present($self); $self->leave('head1'); return $output; } sub view_head2 { my ($self, $head2) = @_; my $title = $head2->title->present($self); if ($self->visiting('head1')) { return "

$title

\n\n" . $head2->content->present($self); } else { return "

$title

\n\n" . $head2->content->present($self); } } #------------------------------------------------------------------------ package main; my $text; { local $/ = undef; $text = ; } my ($test, $expect) = split(/\s*-------+\s*/, $text); my $parser = Pod::POM->new(); my $pom = $parser->parse_text($test); assert( $pom ); $Pod::POM::DEFAULT_VIEW = 'My::View'; my $result = "$pom"; for ($result, $expect) { s/^\s*//; s/\s*$//; } match($result, $expect); __DATA__ =head2 TWO Outer head2 =head1 FIRST First head1 =head1 SECOND Second head1 =head2 INNER Inner head2 =head1 THIRD Third head1 ------------------------------------------------------------------------

TWO

Outer head2

FIRST

First head1

SECOND

Second head1

INNER

Inner head2

THIRD

Third head1 Pod-POM-0.29/t/00-use-modules.t0000755000175000017500000000036711355203555015265 0ustar andrewandrew#!/usr/bin/perl # $Id: 00-basic.t 4092 2009-02-24 17:46:48Z andrew $ use Test::More tests => 4; BEGIN { use_ok( 'Pod::POM' ); use_ok( 'Pod::POM::View::Text' ); use_ok( 'Pod::POM::View::HTML' ); use_ok( 'Pod::POM::View::Pod' ); } Pod-POM-0.29/t/textview.t0000644000175000017500000000073011355203555014454 0ustar andrewandrew#!/usr/bin/perl -w # -*- perl -*- use strict; use lib qw( ./lib ../lib ); use Pod::POM; use Pod::POM::View::Text; use Pod::POM::Test; ntests(2); my $file = -d 't' ? 't/test.pod' : 'test.pod'; my $parser = Pod::POM->new(); my $pom = $parser->parse_file($file) || die $parser->error(); assert( $pom ); $Pod::POM::DEFAULT_VIEW = 'Pod::POM::View::Text'; #print $pom; # yet another crap test match( length $pom, 1825 ); Pod-POM-0.29/t/htmlescp.t0000644000175000017500000000236211355203555014417 0ustar andrewandrew#!/usr/bin/perl -w # -*- perl -*- use strict; use lib qw( ./lib ../lib ); use Pod::POM; use Pod::POM::View::HTML; use Pod::POM::Test; ntests(2); $Pod::POM::DEFAULT_VIEW = 'Pod::POM::View::HTML'; my $text; { local $/ = undef; $text = ; } my ($test, $expect) = split(/\s*-------+\s*/, $text); my $parser = Pod::POM->new(); my $pom = $parser->parse_text($test); assert( $pom ); my $result = "$pom"; for ($result, $expect) { s/^\s*//; s/\s*$//; } match($result, $expect); #print $pom; __DATA__ =head1 NAME I am a stupid fool who puts naked < & > characters in my POD instead of escaping them as E and E. Here is some B text, some I plus F file and something that looks like an EhtmlE tag. This is some C<$code($arg1)>. ------------------------------------------------------------------------

NAME

I am a stupid fool who puts naked < & > characters in my POD instead of escaping them as < and >.

Here is some bold text, some italic plus /etc/fstab file and something that looks like an <html> tag. This is some $code($arg1).

Pod-POM-0.29/t/htmllist.t0000644000175000017500000000274611355203555014446 0ustar andrewandrew#!/usr/bin/perl -w # -*- perl -*- # # test the generation of HTML lists use strict; use lib qw( ./lib ../lib ); use Pod::POM; use Pod::POM::View::HTML; use Pod::POM::Test; $Pod::POM::DEFAULT_VIEW = 'Pod::POM::View::HTML'; ntests(2); my $text; { local $/ = undef; $text = ; } my ($test, $expect) = split(/\s*-------+\s*/, $text); my $parser = Pod::POM->new(); my $pom = $parser->parse_text($test); assert( $pom ); my $result = "$pom"; for ($result, $expect) { s/^\s*//; s/\s*$//; } match($result, $expect); #print $pom; __DATA__ =head1 Test =over 4 =item * The first item =item * The second item =back =over 4 =item 1 The 1st item =item 2 The 2nd item =back =over 4 =item 1. The 1st item =item 2. The 2nd item =back =over 4 =item foo The foo item =item bar The bar item =item crash bang wallop! The crazy item =back ------------------------------------------------------------------------

Test

  • The first item

  • The second item

  1. The 1st item

  2. The 2nd item

  1. The 1st item

  2. The 2nd item

  • foo

    The foo item

  • bar

    The bar item

  • crash bang wallop!

    The crazy item

Pod-POM-0.29/t/test.pod0000644000175000017500000000354711355203555014104 0ustar andrewandrew=head1 NAME My::Module - a sample Pod document for testing Pod::POM =head1 SYNOPSIS use My::Module; my $module = My::Module->new(); my $item = $module->item(); =head1 DESCRIPTION This is a sample Pod document for testing the Pod::POM module. Here is a verbatim section, indented from the left margin by some whitespace This is some more regular text. Here is some B text, some I and something that looks like an EhtmlE tag. This is some C<$code($arg1)>. This C and I tags>. These can be nested, allowing B italic> text>. The module also supports the extended B<< syntax >> and permits I<< nested tags E other B<<< cool >>> stuff >> =head1 METHODS =E OTHER STUFF Here is a list of methods =head2 new() Constructor method. Accepts the following config options: =over 4 =item foo The foo item. =item bar The bar item. =over 4 This is a list within a list =item wiz The wiz item. =item waz The waz item. =back =item baz The baz item. =back =head2 old() Destructor method =head1 IMPORTANT STUFF Here is some important stuff. =over 4 =item Chew Your Food Always chew your food properly before swallowing. =item Running With Scissors Don't run with scissors. =back =head1 TESTING FOR AND BEGIN =for html

blah blah

intermediate text =begin html HTML some text =end =head1 AUTHOR Andy Wardley Eabw@kfs.orgE. =head1 VERSION This is version 0.1 of My::Module. I like being S, wow. =head1 COPYRIGHT This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO See also L, L, L and the other interesting file F as well. =cut Pod-POM-0.29/t/11-view-pod.t0000755000175000017500000000041111355203555014545 0ustar andrewandrew#!/usr/bin/perl -w # -*- perl -*- # $Id: 10-features.t 4114 2009-03-04 22:28:43Z andrew $ use strict; use Cwd qw(abs_path); use FindBin qw($Bin); use lib ($Bin, "$Bin/../lib"); use PodPOMTestLib; run_tests(View => 'Pod'); Pod-POM-0.29/t/complete.t0000644000175000017500000000441111355203555014405 0ustar andrewandrew#!/usr/bin/perl -w # -*- perl -*- use strict; use lib qw( ./lib ../lib ); use Pod::POM::Test; #$Pod::POM::Node::DEBUG = 1; my $DEBUG = 1; ntests(2); my $text; { local $/ = undef; $text = ; } my $parser = Pod::POM->new(); my $pom = $parser->parse_text($text); assert( defined $pom ); # something of a crap test... match( length $pom, 1898 ); __DATA__ =head1 NAME A test Pod document. =head1 NAME My::Module - a sample Pod document for testing Pod::POM =head1 SYNOPSIS use My::Module; my $module = My::Module->new(); my $item = $module->item(); =head1 DESCRIPTION This is a sample Pod document for testing the Pod::POM module. Here is a verbatim section, indented from the left margin by some whitespace This is some more regular text. Here is some B text, some I and something that looks like an EhtmlE tag. This is some C<$code($arg1)>. This C and I tags>. These can be nested, allowing B text>. The module also supports the extended B<< syntax >> and permits I<< nested tags E other B<<< cool >>> stuff >> =head1 METHODS =E OTHER STUFF Here is a list of methods =head2 new() Constructor method. Accepts the following config options: =over 4 =item foo The foo item. =item bar The bar item. =over 4 This is a list within a list =item wiz The wiz item. =item waz The waz item. =back =item baz The baz item. =back =head2 old() Destructor method =head1 IMPORTANT STUFF Here is some important stuff. =over 4 =item Chew Your Food Always chew your food properly before swallowing. =item Running With Scissors Don't run with scissors. =back =head1 TESTING FOR AND BEGIN =for html

blah blah

intermediate text =begin html HTML some text =end =head1 AUTHOR Andy Wardley Eabw@kfs.orgE. =head1 VERSION This is version 0.1 of My::Module. I like being S, wow. =head1 COPYRIGHT This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO See also L, L, L and the file F as well. =cut Pod-POM-0.29/t/warn.t0000644000175000017500000000416211355203555013547 0ustar andrewandrew#!/usr/bin/perl -w # -*- perl -*- use strict; use lib qw( ./lib ../lib ); use Pod::POM::Test; #$Pod::POM::Node::DEBUG = 1; my $DEBUG = 1; my $text; { local $/ = undef; $text = ; } ntests(27); my ($parser, $pom, @warn, @warnings); $parser = Pod::POM->new( ); $pom = $parser->parse_text( $text ); assert( $pom ); @warn = $parser->warnings(); match( scalar @warn, 6 ); match( $warn[0], 'over expected a terminating back at line 14' ); match( $warn[1], 'head1 expected a title at line 18' ); match( $warn[2], 'unexpected item at line 22' ); match( $warn[3], "expected '>>' not '>' at line 27" ); match( $warn[4], "unterminated 'B<<' starting at line 26" ); match( $warn[5], "spurious '>' at line 29" ); my $fullwarn1 = join("\n", @warn); $SIG{__WARN__} = sub { my $msg = join('', @_); chomp($msg); # print "warning: [$msg]\n"; push(@warnings, $msg); }; $parser = Pod::POM->new( warn => 1 ); $pom = $parser->parse_text( $text ); assert( defined $pom ); @warn = $parser->warnings(); match( scalar @warn, 6 ); match( scalar @warnings, 6 ); foreach (@warn) { match( shift @warnings, $_ ); } my $fullwarn2 = join("\n", @warn); @warnings = (); sub warnsub { my $msg = shift; push(@warnings, "[$msg]"); } $parser = Pod::POM->new( warn => \&warnsub ); $pom = $parser->parse_text( $text ); assert( defined $pom ); @warn = $parser->warnings(); match( scalar @warn, 6 ); match( scalar @warnings, 6 ); foreach (@warn) { match( shift @warnings, "[$_]" ); } $parser = Pod::POM->new( warn => 1 ); $pom = $parser->parse_text("=head1 Foo\n\nBlah blah"); assert( defined $pom ); #use Data::Dumper; #$Data::Dumper::Indent=1; #print Dumper($pom); #print $pom; __DATA__ =head1 NAME A test Pod document. =head1 DESCRIPTION This Pod document contains errors that should raise warnings but not fatal errors. =over 4 =item Foo =head1 NEXT This is the next section. =head1 Missing head1 title! =item foo This shouldn't be outside an =over! This B<< text isn't properly terminated. >oh dear! Blah > Blah Pod-POM-0.29/t/meta.t0000644000175000017500000000157611355203555013534 0ustar andrewandrew#!/usr/bin/perl -w # -*- perl -*- use strict; use lib qw( ./lib ../lib ); use Pod::POM qw( meta ); use Pod::POM::Nodes; use Pod::POM::Test; #$Pod::POM::Node::DEBUG = 1; my $DEBUG = 1; ntests(6); my $parser = Pod::POM->new( warn => 1 ); my $pom = $parser->parse_file(\*DATA); assert( $pom ); my @w = $parser->warnings(); if (@w) { print STDERR scalar @w, " warnings\n"; foreach my $w (@w) { print STDERR "warning: $w\n"; } } else { ok(1); # print "Syntax OK, no warnings\n"; } match( $pom->meta('module'), 'Foo::Bar::Baz' ); match( $pom->meta('author'), 'Andy Wardley' ); my $meta = $pom->meta(); match( $meta->{ module }, 'Foo::Bar::Baz' ); match( $meta->{ author }, 'Andy Wardley' ); __DATA__ =meta module Foo::Bar::Baz =meta author Andy Wardley =head1 NAME A test Pod document. Another paragraph with a B tag. Pod-POM-0.29/t/head.t0000644000175000017500000000300411355203555013473 0ustar andrewandrew#!/usr/bin/perl -w # -*- perl -*- use strict; use lib qw( ./lib ../lib ); use Pod::POM::Test; #$Pod::POM::DEBUG = 1; #$Pod::POM::Node::DEBUG = 1; #my $DEBUG = 1; ntests(13); package My::View; use base qw( Pod::POM::View ); sub view_seq_entity { my ($self, $text) = @_; return "ENTITY: [$text]"; } package main; my $parser = Pod::POM->new(); my $pom = $parser->parse_file(\*DATA); assert( $pom ); my $sections = $pom->head1(); match( scalar @$sections, 2 ); match( $sections->[0]->title(), 'NAME' ); match( $sections->[1]->title(), 'DESCRIPTION' ); match( $sections->[0]->type(), 'head1' ); my $items = $pom->head1->[1]->head2->[0]->over->[0]->item; my $view = My::View->new(); match( $items->[0]->title, 'new() =E $object' ); match( $view->print($items->[0]->title), 'new() =ENTITY: [gt] $object' ); match( $view->print($sections->[0]->title()), 'NAME' ); match( $view->print($sections->[1]->title()), 'DESCRIPTION' ); my @expect = qw( NAME DESCRIPTION ); foreach my $head1 ($pom->head1()) { match( $head1->title(), shift @expect ); } my $h3 = $pom->head1->[1]->head2->[0]->head3->[0]; match($view->print($h3->title), 'New Heading'); my $h4 = $h3->head4->[0]; match($view->print($h4->title), 'Newer Heading'); __DATA__ =head1 NAME Document Name =head1 DESCRIPTION This is a description. =head2 METHODS These are the methods: =over 4 =item new() =E $object This is the constructor method. =back =head3 New Heading Blah blah =head4 Newer Heading yah yah Pod-POM-0.29/t/13-view-html.t0000755000175000017500000000041211355203555014732 0ustar andrewandrew#!/usr/bin/perl -w # -*- perl -*- # $Id: 10-features.t 4114 2009-03-04 22:28:43Z andrew $ use strict; use Cwd qw(abs_path); use FindBin qw($Bin); use lib ($Bin, "$Bin/../lib"); use PodPOMTestLib; run_tests(View => 'HTML'); Pod-POM-0.29/t/12-view-text.t0000755000175000017500000000041211355203556014752 0ustar andrewandrew#!/usr/bin/perl -w # -*- perl -*- # $Id: 10-features.t 4114 2009-03-04 22:28:43Z andrew $ use strict; use Cwd qw(abs_path); use FindBin qw($Bin); use lib ($Bin, "$Bin/../lib"); use PodPOMTestLib; run_tests(View => 'Text'); Pod-POM-0.29/t/wrap.t0000644000175000017500000000326212151743473013554 0ustar andrewandrew#!/usr/bin/perl -w # -*- perl -*- use strict; use lib qw( ./lib ../lib ); use Pod::POM::Test; #$Pod::POM::View::DEBUG = 1; #$Pod::POM::Node::DEBUG = 1; ##------------------------------------------------------------------------ ## NOTE: this test doesn't do much (yet) ##------------------------------------------------------------------------ my $DEBUG = 1; ntests(5); my $parser = Pod::POM->new(); my $pom = $parser->parse_file(\*DATA); assert( defined $pom ); my $head1 = $pom->head1->[0]; assert( defined $head1 ); my $head2 = $head1->head2->[0]; assert( defined $head2 ); my $list = $head2->over->[0]; assert( defined $list ); my $text = $head2->text->[0]; assert( defined $text ); { no warnings 'once'; # $Pod::POM::ERROR is only used once Pod::POM->default_view('Pod::POM::View::Text') || die "$Pod::POM::ERROR\n"; } # uncomment this to see the results #print $pom; __DATA__ =head1 Outer This is the outer block following a =head1 a b c d e f g h i j k l m n o p q r s t u v w x y z. =head2 Inner Block for which I am obliged to provide a long an arduous title to ensure that it is correctly wrapped This is the inner block following a =head2 a b c d e f g h i j k l m n o p q r s t u v w x y z. =over 4 This is the list block following an =over 4 a b c d e f g h i j k l m n o p q r s t u v w x y z. =item Wiz This paragraph wraps onto several lines and hopefully will be correctly formatted thanks to the Text::Wrap module. =item Wiz Waz Woz Wuz Biz Baz Boz Buz Diz Daz Doz Duz Liz Laz Loz Luz Fiz Faz Foz Fuz This paragraph wraps onto several lines and hopefully will be correctly formatted thanks to the Text::Wrap module. =back Pod-POM-0.29/t/PodPOMTestLib.pm0000644000175000017500000000643512151743473015346 0ustar andrewandrew# $Id: TestUtils.pm 4100 2009-02-25 22:20:47Z andrew $ package PodPOMTestLib; use strict; use vars qw(@EXPORT); use base 'Exporter'; use Pod::POM; use Test::More; use File::Slurp; use YAML::Tiny; # use Data::Dumper; # for debugging @EXPORT = qw(run_tests get_tests); #------------------------------------------------------------------------ # run_tests() # # Runs all the tests of the specified type/subtype (e.g. Pom => 'dump', # or View => $view #------------------------------------------------------------------------ sub run_tests { my ($type, $subtype) = @_; my $view; my @tests = get_tests(@_); my $pod_parser = Pod::POM->new(); if (lc $type eq 'view') { $view = "Pod::POM::View::$subtype"; eval "use $view;"; if ($@) { plan skip_all => "couldn't load $view"; exit(0); } } plan tests => int @tests; # Select whether to use eq_or_diff() or is() according to whether # Test::Differences is available. eval { require Test::Differences; Test::Differences->import; }; my $eq = $@ ? \&is : \&eq_or_diff; foreach my $test (@tests) { TODO: eval { local $TODO; $TODO = $test->options->{todo} || ''; my $pom = $pod_parser->parse_text($test->input) or die $pod_parser->error; my $result = $view ? $pom->present($view) : $pom->dump; $eq->($result, $test->expect, $test->title); }; if ($@) { diag($@); fail($test->title); } } } #------------------------------------------------------------------------ # get_tests() # # Finds all the tests of the specified type/subtype #------------------------------------------------------------------------ sub get_tests { my ($type, $subtype) = @_; (my $testcasedir = $0) =~ s{([^/]+)\.t}{testcases/}; my (@tests, $testno); my $expect_ext = $type; $expect_ext .= "-$subtype" if $subtype; $expect_ext = lc $expect_ext; foreach my $podfile (sort <$testcasedir/*.pod>) { $testno++; (my $basepath = $podfile) =~ s/\.pod$//; (my $basename = $basepath) =~ s{.*/}{}; next unless -f "${basepath}.$expect_ext"; my ($title, $options); my $podtext = read_file($podfile); my $expect = read_file("${basepath}.$expect_ext"); require Encode; Encode::_utf8_on($expect); # fetch options from YAML files - need to work out semantics if (my $ymltext = -f "${basepath}.yml" && read_file("${basepath}.yml")) { my $data = Load $ymltext; $title = $data->{title}; if (exists $data->{$expect_ext}) { $options = $data->{$expect_ext}; } } push @tests, PodPOMTestCase->new( { input => $podtext, options => $options || {}, expect => $expect, title => $title || $basename } ); } return @tests; } 1; package PodPOMTestCase; use strict; sub new { my ($class, $opts) = @_; return bless $opts, $class; } sub input { return $_[0]->{input}; } sub options { return $_[0]->{options}; } sub expect { return $_[0]->{expect}; } sub title { return $_[0]->{title}; } 1; Pod-POM-0.29/t/code.t0000644000175000017500000000276411355203555013520 0ustar andrewandrew#!/usr/bin/perl -w # -*- perl -*- use strict; use lib qw( ./lib ../lib ); use Pod::POM::Test; use Pod::POM::View::Text; my $DEBUG = 1; my $text; { local $/ = undef; $text = ; } ntests(17); my ($parser, $podpom, @warn, @warnings); my ($h1, $code); my $textview = Pod::POM::View::Text->new(); $parser = Pod::POM->new( ); $podpom = $parser->parse_text( $text ); assert( $podpom ); $h1 = $podpom->head1(); match( scalar @$h1, 3 ); match( $textview->print($h1->[0]->title()), 'NAME' ); $code = $podpom->code(); ok( ! @$code ); $parser = Pod::POM->new( code => 1 ); $podpom = $parser->parse_text( $text ); assert( $podpom ); ok( $parser->{ CODE } == 1 ); $h1 = $podpom->head1(); match( scalar @$h1, 3 ); match( $textview->print($h1->[0]->title()), 'NAME' ); $code = $podpom->code(); ok( defined $code ); match( scalar @$code, 1 ); match( $textview->print($code->[0]->{ text }), "This is some code\n\n" ); match( $code->[0]->{ text }, "This is some code\n\n" ); match( $code->[0], "This is some code\n\n" ); $h1 = $podpom->head1->[1]; assert( $h1 ); $code = $h1->code(); match( scalar @$code, 2 ); match( $textview->print($code->[0]), "Some more code here\n\n" ); match( $textview->print($code->[1]), "even more code\n\n" ); __DATA__ This is some code =head1 NAME A test Pod document. =head1 DESCRIPTION This document has mixed code/Pod =cut Some more code here =pod Some more description =cut even more code =head1 SYNOPSIS use Blah; =cut The end. Pod-POM-0.29/t/htmlview.t0000644000175000017500000001215411355203555014437 0ustar andrewandrew#!/usr/bin/perl -w # -*- perl -*- use strict; use lib qw( ./lib ../lib ); use Pod::POM; use Pod::POM::View::HTML; use Pod::POM::Test; ntests(2); $Pod::POM::DEFAULT_VIEW = 'Pod::POM::View::HTML'; my $text; { local $/ = undef; $text = ; } my ($test, $expect) = split(/\s*-------+\s*/, $text); my $parser = Pod::POM->new(); my $pom = $parser->parse_text($test); assert( $pom ); my $result = "$pom"; for ($result, $expect) { s/^\s*//; s/\s*$//; } #match($result, $expect); use constant HAS_TEXT_DIFF => eval { require Text::Diff}; if (HAS_TEXT_DIFF) { diff($expect, $result, 2); } else { match($result, $expect); } sub diff { my($expect, $result, $tnum) = @_; my $diff = Text::Diff::diff(\$expect, \$result, {STYLE=> "Unified"}); if ($diff) { print "not ok $tnum\n"; print $diff; } else { print "ok $tnum\n"; } } #print $pom; __DATA__ =head1 NAME Test =head1 SYNOPSIS use My::Module; my $module = My::Module->new(); =head1 DESCRIPTION This is the description. Here is a verbatim section. This is some more regular text. Here is some B text, some I and something that looks like an EhtmlE tag. This is some C<$code($arg1)>. This C and I tags>. These can be nested, allowing B italic> text>. The module also supports the extended B<< syntax >> and permits I<< nested tags E other B<<< cool >>> stuff >> =head1 METHODS =E OTHER STUFF Here is a list of methods =head2 new() Constructor method. Accepts the following config options: =over 4 =item foo The foo item. =item bar The bar item. =over 4 This is a list within a list =item * The wiz item. =item * The waz item. =back =item baz The baz item. =back Title on the same line as the =item + * bullets =over =item * C Cat =item * Sat S the> =item * MatE!E =back Title on the same line as the =item + numerical bullets =over =item 1 Cat =item 2 Sat =item 3 Mat =back No bullets, no title =over =item Cat =item Sat =item Mat =back =head2 old() Destructor method =head1 TESTING FOR AND BEGIN =for html

blah blah

intermediate text =begin html HTML some text =end =head1 TESTING URLs hyperlinking This is an href link1: http://example.com This is an href link2: http://example.com/foo/bar.html This is an email link: mailto:foo@bar.com =head1 SEE ALSO See also L, the L and L manpages and the other interesting file F as well. =cut ------------------------------------------------------------------------

NAME

Test

SYNOPSIS

    use My::Module;

    my $module = My::Module->new();

DESCRIPTION

This is the description.

    Here is a verbatim section.

This is some more regular text.

Here is some bold text, some italic and something that looks like an <html> tag. This is some $code($arg1).

This text contains embedded bold and italic tags. These can be nested, allowing bold and bold & italic text. The module also supports the extended syntax and permits nested tags & other cool stuff

METHODS => OTHER STUFF

Here is a list of methods

new()

Constructor method. Accepts the following config options:

  • foo

    The foo item.

  • bar

    The bar item.

      This is a list within a list

    • The wiz item.

    • The waz item.

  • baz

    The baz item.

Title on the same line as the =item + * bullets

  • Black Cat
  • Sat on the
  • Mat<!>

Title on the same line as the =item + numerical bullets

  1. Cat
  2. Sat
  3. Mat

No bullets, no title

  • Cat

  • Sat

  • Mat

old()

Destructor method

TESTING FOR AND BEGIN


blah blah

intermediate text

HTML some text

TESTING URLs hyperlinking

This is an href link1: http://example.com

This is an href link2: http://example.com/foo/bar.html

This is an email link: mailto:foo@bar.com

SEE ALSO

See also Test Page 2, the Your::Module and Their::Module manpages and the other interesting file /usr/local/my/module/rocks as well.

Pod-POM-0.29/Makefile.PL0000644000175000017500000000104211355203561014111 0ustar andrewandrewuse 5.006; use inc::Module::Install; # Define metadata name 'Pod-POM'; author 'Andy Wardley '; license 'perl'; perl_version '5.006'; all_from 'lib/Pod/POM.pm'; requires 'Encode' => 0; requires 'Text::Wrap' => 2001.0929; # prior versions always unexpand tabs requires 'parent' => 0; test_requires 'File::Slurp' => 0; test_requires 'Test::More' => 0; install_script 'bin/pom2'; install_script 'bin/podlint'; install_script 'bin/pomdump'; WriteAll; Pod-POM-0.29/bin/0000755000175000017500000000000012260471766012724 5ustar andrewandrewPod-POM-0.29/bin/custom-pom20000755000175000017500000000501211355203561015023 0ustar andrewandrew#!/usr/bin/perl -w # # This program demonstrates how you can easily write a custom # processor for converting Pod documents to the format of your # choice in the style of your choice. # # Written by Ron Savage with some minor # changes by Andy Wardley . # # Also check out Ron's Perl pages for his own version of this # script, fancy-pom2.pl, which is likely to be further advanced # and more recently updated: # # http://savage.net.au/Perl.html#fancy-pom2.pl # use Pod::POM; use File::Basename; my $BGCOLOR = '#80C0ff'; my $program = basename($0); my $format; die usage() if grep(/^--?h(elp)?$/, @ARGV); my $file = shift || die "usage: $program podfile\n"; # create a Pod::POM parser my $parser = Pod::POM->new( warn => 1 ) || die "$Pod::POM::ERROR\n"; # parse the file to build a POM my $pom = $parser->parse_file($file) || die $parser->error(), "\n"; my (@toc, @content); # get each =head1 to make a table of content for my $head1 ($pom->head1()) { push(@toc, My::View->print($head1->title()) ); } # generate HTML for table of contents @toc = map { my $name = $_; $name =~ s/\W+/_/g; "$_\n" } @toc; # generate HTML for page content @content = My::View->print($pom); # cleanup file name to use as title $file =~ s|\\|/|g; $file =~ s|.*/||; $file = $1 if ($file =~ /^(.+)\..+$/); $file = ucfirst lc $file; # print! print <

Table of Contents

@toc

$file

@content
 
Top of page
EOF #------------------------------------------------------------------------ # Here we define a custom view as a subclass of Pod::POM::View::HTML. # You can add any methods here like view_head2(), view_over(), etc., # to implement different handlers for different elements in the document. #------------------------------------------------------------------------ package My::View; use base qw( Pod::POM::View::HTML ); sub view_head1 { my($self, $item) = @_; # convert non-word characters in name to _ my $title = $item->title->present($self); my $name = $title; $name =~ s/\W+/_/g; return "

$title

\n\n" . $item->content->present($self); } Pod-POM-0.29/bin/pom20000755000175000017500000000734111355203561013522 0ustar andrewandrew#!/usr/bin/perl -w # # This program implements a simple translator to convert POD # to HTML, Text, or back to POD again (e.g. for normalising a # document). You can easily extend it to work with any other # view modules you create which convert POD to different formats # or in different styles. # # Written by Andy Wardley . This is free software. # # Extended by Andrew Ford to check for any other installed viewers. use Pod::POM; use File::Basename; use Getopt::Long; my $PROGRAM = 'pom2'; my $program = basename($0); my $format; my $views = { pod => 'Pod', text => 'Text', html => 'HTML', }; my %options; die usage() if grep(/^--?h(elp)?$/, @ARGV); while (@ARGV and $ARGV[0] =~ /^--([^=]+)(=(.*))?$/) { $options{$1} = $2 ? $3 : 1; shift; } if ($program =~ /^$PROGRAM(.+)$/) { $format = $1; } else { $format = shift || die usage('no output format specified'); } while (@ARGV and $ARGV[0] =~ /^--([^=]+)(=(.*))?$/) { $options{$1} = $2 ? $3 : 1; shift; } my $file = shift || die usage('no filename specified'); $format = lc $format; my $view = $views->{ $format }; if (!$view) { DIR: foreach my $libdir (@INC) { foreach (<$libdir/Pod/POM/View/*.pm>) { (my $module = $_) =~ s{.*/([^/]+).pm$}{$1}; if (lc($module) eq $format) { $view = $1; last DIR; } else { $views->{lc($module)} = $module; } } } $view || die usage("invalid format '$format', try one of: " . join(', ', sort keys %$views)); } $view = "Pod::POM::View::$view"; if (keys %options) { eval "use $view"; $view = $view->new(%options); } Pod::POM->default_view($view) || die "$Pod::POM::ERROR\n"; my $parser = Pod::POM->new( warn => 1 ) || die "$Pod::POM::ERROR\n"; my $pom = $parser->parse_file($file) || die $parser->error(), "\n"; print $pom; #------------------------------------------------------------------------ sub usage { my $msg = shift || ''; if ($program =~ /^$PROGRAM$/) { $program = "pom2 format"; } return < MyFile.txt pom2 html MyFile.pm > MyFile.html pom2 pod MyFile.pm > Myfile.pod pom2 format [options] MyFile.pm > Myfile.xyz =head1 DESCRIPTION This script uses C to convert a Pod document into text, HTML, back into Pod (e.g. to normalise a document to fix any markup errors), or any other format for which you have a view module. If the viewer is not one of the viewers bundled with C, the script searches for an installed C module that matches the specified format. For example if you have C installed then you could say: pod2 docbook MyFile.pm > MyFile.xml If any options other than C<--help> are specified then they are passed to the constructor method of the view class. For example: pod2 docbook --root=chapter --titlecasing MyFile.pm > MyFile.xml would convert the Pod document to a DocBook chapter document with the titlecasing option enabled. Note that any string prefixed by "C<-->" is taken as a valid option and passed to the constructor; if no value is specified then a value of 1 is passed in. =head1 AUTHOR Andy Wardley Eabw@kfs.orgE extended by Andrew Ford EA.Ford@ford-mason.co.ukE =head1 VERSION This is version 0.3 of pom2. =head1 COPYRIGHT Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. Copyright (C) 2009 Andrew Ford. All Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO For further information please see L. Pod-POM-0.29/bin/pomdump0000755000175000017500000000225711355203561014327 0ustar andrewandrew#!/usr/bin/perl -w use strict; use FindBin qw($Bin); use lib "$Bin/../lib"; use Pod::POM; use Getopt::Std; use File::Basename; my $program = basename($0); my %opts; getopts('h', \%opts); die usage() if $opts{ h }; my $file = shift || die usage(); my $parser = Pod::POM->new( code => 1 ) || die "$Pod::POM::ERROR\n"; my $pom = $parser->parse_file($file) || die $parser->error(), "\n"; print $pom->dump; sub usage { return <A.Ford@ford-mason.co.ukE =head1 VERSION This is version 0.1 of pomdump. =head1 COPYRIGHT Copyright (C) 2009 Andrew Ford. All Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO For further information please see L. Pod-POM-0.29/bin/podlint0000755000175000017500000000273011355203561014313 0ustar andrewandrew#!/usr/bin/perl -w use Pod::POM; use Getopt::Std; use File::Basename; my $program = basename($0); my %opts; getopts('fh', \%opts); die usage() if $opts{ h }; my $file = shift || die usage(); my $parser = Pod::POM->new( warn => 1, code => 1 ) || die "$Pod::POM::ERROR\n"; my $pom = $parser->parse_file($file) || die $parser->error(), "\n"; print $pom if $opts{ f }; sub usage { return <abw@kfs.orgE =head1 VERSION This is version 0.2 of podlint. =head1 COPYRIGHT Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO For further information please see L. Pod-POM-0.29/lib/0000755000175000017500000000000012260471766012722 5ustar andrewandrewPod-POM-0.29/lib/Pod/0000755000175000017500000000000012260471766013444 5ustar andrewandrewPod-POM-0.29/lib/Pod/POM/0000755000175000017500000000000012260471766014077 5ustar andrewandrewPod-POM-0.29/lib/Pod/POM/Node.pm0000644000175000017500000004467012260471742015327 0ustar andrewandrew#============================================================= -*-Perl-*- # # Pod::POM::Node # # DESCRIPTION # Base class for a node in a Pod::POM tree. # # AUTHOR # Andy Wardley # # COPYRIGHT # Copyright (C) 2000-2003 Andy Wardley. All Rights Reserved. # # This module is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # # REVISION # $Id: Node.pm 91 2013-12-31 07:36:02Z ford $ # #======================================================================== package Pod::POM::Node; require 5.004; use strict; use Pod::POM::Nodes; use Pod::POM::Constants qw( :all ); use vars qw( $VERSION $DEBUG $ERROR $NODES $NAMES $AUTOLOAD ); use constant DUMP_LINE_LENGTH => 80; $VERSION = sprintf("%d.%02d", q$Revision: 1.5 $ =~ /(\d+)\.(\d+)/); $DEBUG = 0 unless defined $DEBUG; $NODES = { pod => 'Pod::POM::Node::Pod', head1 => 'Pod::POM::Node::Head1', head2 => 'Pod::POM::Node::Head2', head3 => 'Pod::POM::Node::Head3', head4 => 'Pod::POM::Node::Head4', over => 'Pod::POM::Node::Over', item => 'Pod::POM::Node::Item', begin => 'Pod::POM::Node::Begin', for => 'Pod::POM::Node::For', text => 'Pod::POM::Node::Text', code => 'Pod::POM::Node::Code', verbatim => 'Pod::POM::Node::Verbatim', }; $NAMES = { map { ( $NODES->{ $_ } => $_ ) } keys %$NODES, }; # overload stringification to present node via a view use overload '""' => 'present', fallback => 1, 'bool' => sub { 1 }; # alias meta() to metadata() *meta = \*metadata; #------------------------------------------------------------------------ # new($pom, @attr) # # Constructor method. Returns a new Pod::POM::Node::* object or undef # on error. First argument is the Pod::POM parser object, remaining # arguments are node attributes as specified in @ATTRIBS in derived class # package. #------------------------------------------------------------------------ sub new { my $class = shift; my $pom = shift; my ($type, @attribs, $accept); $type = $NAMES->{ $class }; { no strict qw( refs ); @attribs = @{"$class\::ATTRIBS"}; $accept = \@{"$class\::ACCEPT"} || [ ]; unless (%{"$class\::ACCEPT"}) { %{"$class\::ACCEPT"} = ( map { ( $_ => $NODES->{ $_ } ) } @$accept, ); } } # create object with slots for each acceptable child and overall content my $self = bless { type => $type, content => bless([ ], 'Pod::POM::Node::Content'), map { ($_ => bless([ ], 'Pod::POM::Node::Content')) } (@$accept, 'code'), }, $class; # set attributes from arguments while(my ($key, $default) = splice(@attribs, 0, 2)) { my $value = shift || $default; return $class->error("$type expected a $key") unless $value; $self->{ $key } = $value; } return $self; } #------------------------------------------------------------------------ # add($pom, $type, @attr) # # Adds a new node as a child element (content) of the current node. # First argument is the Pod::POM parser object. Second argument is the # child node type specified by name (e.g. 'head1') which is mapped via # the $NODES hash to a class name against which new() can be called. # Remaining arguments are attributes passed to the child node constructor. # Returns a reference to the new node (child was accepted) or one of the # constants REDUCE (child terminated node, e.g. '=back' terminates an # '=over' node), REJECT (child rejected, e.g. '=back' expected to terminate # '=over' but something else found instead) or IGNORE (node didn't expect # child and is implicitly terminated). #------------------------------------------------------------------------ sub add { my $self = shift; my $pom = shift; my $type = shift; my $class = ref $self; my ($name, $attribs, $accept, $expect, $nodeclass, $node); $name = $NAMES->{ $class } || return $self->error("no name for $class"); { no strict qw( refs ); $accept = \%{"$class\::ACCEPT"}; $expect = ${"$class\::EXPECT"}; } # SHIFT: accept indicates child nodes that can be accepted; a # new node is created, added it to content list and node specific # list, then returned by reference. if ($nodeclass = $accept->{ $type }) { defined($node = $nodeclass->new($pom, @_)) || return $self->error($nodeclass->error()) unless defined $node; push(@{ $self->{ $type } }, $node); push(@{ $self->{ content } }, $node); $pom->{in_begin} = 1 if $nodeclass eq 'Pod::POM::Node::Begin'; return $node; } # REDUCE: expect indicates the token that should terminate this node if (defined $expect && ($type eq $expect)) { DEBUG("$name terminated by expected $type\n"); $pom->{in_begin} = 0 if $name eq 'begin'; return REDUCE; } # REJECT: expected terminating node was not found if (defined $expect) { DEBUG("$name rejecting $type, expecting a terminating $expect\n"); $self->error("$name expected a terminating $expect"); return REJECT; } # IGNORE: don't know anything about this node DEBUG("$name ignoring $type\n"); return IGNORE; } #------------------------------------------------------------------------ # present($view) # # Present the node by making a callback on the appropriate method against # the view object passed as an argument. $Pod::POM::DEFAULT_VIEW is used # if $view is unspecified. #------------------------------------------------------------------------ sub present { my ($self, $view, @args) = @_; $view ||= $Pod::POM::DEFAULT_VIEW; my $type = $self->{ type }; my $method = "view_$type"; DEBUG("presenting method $method to $view\n"); my $txt = $view->$method($self, @args); if ($view->can("encode")){ return $view->encode($txt); } else { return $txt; } } #------------------------------------------------------------------------ # metadata() # metadata($key) # metadata($key, $value) # # Returns the metadata hash when called without any arguments. Returns # the value of a metadata item when called with a single argument. # Sets a metadata item to a value when called with two arguments. #------------------------------------------------------------------------ sub metadata { my ($self, $key, $value) = @_; my $metadata = $self->{ METADATA } ||= { }; return $metadata unless defined $key; if (defined $value) { $metadata->{ $key } = $value; } else { $value = $self->{ METADATA }->{ $key }; return defined $value ? $value : $self->error("no such metadata item: $key"); } } #------------------------------------------------------------------------ # error() # error($msg, ...) # # May be called as a class or object method to set or retrieve the # package variable $ERROR (class method) or internal member # $self->{ _ERROR } (object method). The presence of parameters indicates # that the error value should be set. Undef is then returned. In the # absence of parameters, the current error value is returned. #------------------------------------------------------------------------ sub error { my $self = shift; my $errvar; # use Carp; { no strict qw( refs ); if (ref $self) { # my ($pkg, $file, $line) = caller(); # print STDERR "called from $file line $line\n"; # croak "cannot get/set error in non-hash: $self\n" # unless UNIVERSAL::isa($self, 'HASH'); $errvar = \$self->{ ERROR }; } else { $errvar = \${"$self\::ERROR"}; } } if (@_) { $$errvar = ref($_[0]) ? shift : join('', @_); return undef; } else { return $$errvar; } } #------------------------------------------------------------------------ # dump() # # Returns a representation of the element and all its children in a # format useful only for debugging. The structure of the document is # shown by indentation (inspired by HTML::Element). #------------------------------------------------------------------------ sub dump { my($self, $depth) = @_; my $output; $depth = 0 unless defined $depth; my $nodepkg = ref $self; if ($self->isa('REF')) { $self = $$self; my $cmd = $self->[CMD]; my @content = @{ $self->[CONTENT] }; if ($cmd) { $output .= (" " x $depth) . $cmd . $self->[LPAREN] . "\n"; } foreach my $item (@content) { if (ref $item) { $output .= $item->dump($depth+1); # recurse } else { # text node $output .= _dump_text($item, $depth+1); } } if ($cmd) { $output .= (" " x $depth) . $self->[RPAREN] . "\n", ; } } else { no strict 'refs'; my @attrs = sort keys %{{ @{"${nodepkg}::ATTRIBS"} }}; $output .= (" " x $depth) . $self->type . "\n"; foreach my $attr (@attrs) { if (my $value = $self->{$attr}) { $output .= (" " x ($depth+1)) . "\@$attr\n"; if (ref $value) { $output .= $value->dump($depth+1); } else { $output .= _dump_text($value, $depth+2); } } } foreach my $item (@{$self->{content}}) { if (ref $item) { # element $output .= $item->dump($depth+1); # recurse } else { # text node $output .= _dump_text($item, $depth+1); } } } return $output; } sub _dump_text { my ($text, $depth) = @_; my $output = ""; my $padding = " " x $depth; my $max_text_len = DUMP_LINE_LENGTH - length($depth) - 2; foreach my $line (split(/\n/, $text)) { $output .= $padding; if (length($line) > $max_text_len or $line =~ m<[\x00-\x1F]>) { # it needs prettyin' up somehow or other my $x = (length($line) <= $max_text_len) ? $_ : (substr($line, 0, $max_text_len) . '...'); $x =~ s<([\x00-\x1F])> <'\\x'.(unpack("H2",$1))>eg; $output .= qq{"$x"\n}; } else { $output .= qq{"$line"\n}; } } return $output; } #------------------------------------------------------------------------ # AUTOLOAD #------------------------------------------------------------------------ sub AUTOLOAD { my $self = shift; my $name = $AUTOLOAD; my $item; $name =~ s/.*:://; return if $name eq 'DESTROY'; # my ($pkg, $file, $line) = caller(); # print STDERR "called from $file line $line to return ", ref($item), "\n"; return $self->error("can't manipulate \$self") unless UNIVERSAL::isa($self, 'HASH'); return $self->error("no such member: $name") unless defined ($item = $self->{ $name }); return wantarray ? ( UNIVERSAL::isa($item, 'ARRAY') ? @$item : $item ) : $item; } #------------------------------------------------------------------------ # DEBUG(@msg) #------------------------------------------------------------------------ sub DEBUG { print STDERR "DEBUG: ", @_ if $DEBUG; } 1; =head1 NAME Pod::POM::Node - base class for a POM node =head1 SYNOPSIS package Pod::POM::Node::Over; use base qw( Pod::POM::Node ); use vars qw( @ATTRIBS @ACCEPT $EXPECT $ERROR ); @ATTRIBS = ( indent => 4 ); @ACCEPT = qw( over item begin for text verbatim ); $EXPECT = q( back ); package main; my $list = Pod::POM::Node::Over->new(8); $list->add('item', 'First Item'); $list->add('item', 'Second Item'); ... =head1 DESCRIPTION This documentation describes the inner workings of the Pod::POM::Node module and gives a brief overview of the relationship between it and its derived classes. It is intended more as a guide to the internals for interested hackers than as general user documentation. See L for information on using the modules. This module implements a base class node which is subclassed to represent different elements within a Pod Object Model. package Pod::POM::Node::Over; use base qw( Pod::POM::Node ); The base class implements the new() constructor method to instantiate new node objects. my $list = Pod::POM::Node::Over->new(); The characteristics of a node can be specified by defining certain variables in the derived class package. The C<@ATTRIBS> list can be used to denote attributes that the node should accept. In the case of an C<=over> node, for example, an C attribute can be specified which otherwise defaults to 4. package Pod::POM::Node::Over; use base qw( Pod::POM::Node ); use vars qw( @ATTRIBS $ERROR ); @ATTRIBS = ( indent => 4 ); The new() method will now expect an argument to set the indent value, or will use 4 as the default if no argument is provided. my $list = Pod::POM::Node::Over->new(8); # indent: 8 my $list = Pod::POM::Node::Over->new( ); # indent: 4 If the default value is undefined then the argument is mandatory. package Pod::POM::Node::Head1; use base qw( Pod::POM::Node ); use vars qw( @ATTRIBS $ERROR ); @ATTRIBS = ( title => undef ); package main; my $head = Pod::POM::Node::Head1->new('My Title'); If a mandatory argument isn't provided then the constructor will return undef to indicate failure. The $ERROR variable in the derived class package is set to contain a string of the form "$type expected a $attribute". # dies with error: "head1 expected a title" my $head = Pod::POM::Node::Head1->new() || die $Pod::POM::Node::Head1::ERROR; For convenience, the error() subroutine can be called as a class method to retrieve this value. my $type = 'Pod::POM::Node::Head1'; my $head = $type->new() || die $type->error(); The C<@ACCEPT> package variable can be used to indicate the node types that are permitted as children of a node. package Pod::POM::Node::Head1; use base qw( Pod::POM::Node ); use vars qw( @ATTRIBS @ACCEPT $ERROR ); @ATTRIBS = ( title => undef ); @ACCEPT = qw( head2 over begin for text verbatim ); The add() method can then be called against a node to add a new child node as part of its content. $head->add('over', 8); The first argument indicates the node type. The C<@ACCEPT> list is examined to ensure that the child node type is acceptable for the parent node. If valid, the constructor for the relevant child node class is called passing any remaining arguments as attributes. The new node is then returned. my $list = $head->add('over', 8); The error() method can be called against the I node to retrieve any constructor error generated by the I node. my $list = $head->add('over', 8); die $head->error() unless defined $list; If the child node is not acceptable to the parent then the add() method returns one of the constants IGNORE, REDUCE or REJECT, as defined in Pod::POM::Constants. These return values are used by the Pod::POM parser module to implement a simple shift/reduce parser. In the most common case, IGNORE is returned to indicate that the parent node doesn't know anything about the new child node. The parser uses this as an indication that it should back up through the parse stack until it finds a node which I accept this child node. Through this mechanism, the parser is able to implicitly terminate certain POD blocks. For example, a list item initiated by a C<=item> tag will I accept another C<=item> tag, but will instead return IGNORE. The parser will back out until it finds the enclosing C<=over> node which I accept it. Thus, a new C<=item> implicitly terminates any previous C<=item>. The C<$EXPECT> package variable can be used to indicate a node type which a parent expects to terminate itself. An C<=over> node, for example, should always be terminated by a matching C<=back>. When such a match is made, the add() method returns REDUCE to indicate successful termination. package Pod::POM::Node::Over; use base qw( Pod::POM::Node ); use vars qw( @ATTRIBS @ACCEPT $EXPECT $ERROR ); @ATTRIBS = ( indent => 4 ); @ACCEPT = qw( over item begin for text verbatim ); $EXPECT = q( back ); package main; my $list = Pod::POM::Node::Over->new(); my $item = $list->add('item'); $list->add('back'); # returns REDUCE If a child node isn't specified in the C<@ACCEPT> list or doesn't match any C<$EXPECT> specified then REJECT is returned. The parent node sets an internal error of the form "$type expected a terminating $expect". The parser uses this to detect missing POD tags. In nearly all cases the parser is smart enough to fix the incorrect structure and downgrades any errors to warnings. # dies with error 'over expected terminating back' ref $list->add('head1', 'My Title') # returns REJECT || die $list->error(); Each node contains a 'type' field which contains a simple string indicating the node type, e.g. 'head1', 'over', etc. The $NODES and $NAMES package variables (in the base class) reference hash arrays which map these names to and from package names (e.g. head1 E=E Pod::POM::Node::Head1). print $list->{ type }; # 'over' An AUTOLOAD method is provided to access to such internal items for those who don't like violating an object's encapsulation. print $list->type(); Nodes also contain a 'content' list, blessed into the Pod::POM::Node::Content class, which contains the content (child elements) for the node. The AUTOLOAD method returns this as a list reference or as a list of items depending on the context in which it is called. my $items = $list->content(); my @items = $list->content(); Each node also contains a content list for each individual child node type that it may accept. my @items = $list->item(); my @text = $list->text(); my @vtext = $list->verbatim(); The present() method is used to present a node through a particular view. This simply maps the node type to a method which is then called against the view object. This is known as 'double dispatch'. my $view = 'Pod::POM::View::HTML'; print $list->present($view); The method name is constructed from the node type prefixed by 'view_'. Thus the following are roughly equivalent. $list->present($view); $view->view_list($list); The benefit of the former over the latter is, of course, that the caller doesn't need to know or determine the type of the node. The node itself is in the best position to determine what type it is. =head1 AUTHOR Andy Wardley Eabw@kfs.orgE =head1 COPYRIGHT Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO Consult L for a general overview and examples of use. Pod-POM-0.29/lib/Pod/POM/Node/0000755000175000017500000000000012260471766014764 5ustar andrewandrewPod-POM-0.29/lib/Pod/POM/Node/Over.pm0000644000175000017500000000351512151743473016235 0ustar andrewandrew#============================================================= -*-Perl-*- # # Pod::POM::Node::Over # # DESCRIPTION # Module implementing specific nodes in a Pod::POM, subclassed from # Pod::POM::Node. # # AUTHOR # Andy Wardley # Andrew Ford # # COPYRIGHT # Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. # Copyright (C) 2009 Andrew Ford. All Rights Reserved. # # This module is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # # REVISION # $Id: Over.pm 89 2013-05-30 07:41:52Z ford $ # #======================================================================== package Pod::POM::Node::Over; use strict; use parent qw( Pod::POM::Node ); our @ATTRIBS = ( indent => 4 ); our @ACCEPT = qw( over item begin for text verbatim code ); our $EXPECT = 'back'; sub list_type { my $self = shift; my ($first, @rest) = $self->content; my $first_type = $first->type; return; } 1; =head1 NAME Pod::POM::Node::Over - POM '=over' node class =head1 SYNOPSIS use Pod::POM::Nodes; =head1 DESCRIPTION This class implements '=over' Pod nodes. As described by the L man page =over/=back regions are used for various kinds of list-like structures (including blockquote paragraphs). =item 1. ordered list =item * text paragraph unordered list =item text text paragraph definition list =head1 AUTHOR Andrew Ford Ea.ford@ford-mason.co.ukE Andy Wardley Eabw@kfs.orgE =head1 COPYRIGHT Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. Copyright (C) 2009 Andrew Ford. All Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO Consult L for a discussion of nodes. Pod-POM-0.29/lib/Pod/POM/Node/Pod.pm0000644000175000017500000000264712151743473016051 0ustar andrewandrew#============================================================= -*-Perl-*- # # Pod::POM::Node::Pod # # DESCRIPTION # Module implementing specific nodes in a Pod::POM, subclassed from # Pod::POM::Node. # # AUTHOR # Andy Wardley # Andrew Ford # # COPYRIGHT # Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. # Copyright (C) 2009 Andrew Ford. All Rights Reserved. # # This module is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # # REVISION # $Id: Pod.pm 89 2013-05-30 07:41:52Z ford $ # #======================================================================== package Pod::POM::Node::Pod; use strict; use parent qw( Pod::POM::Node ); our @ACCEPT = qw( head1 head2 head3 head4 over begin for text verbatim code ); 1; =head1 NAME Pod::POM::Node::Pod - =head1 SYNOPSIS use Pod::POM::Nodes; =head1 DESCRIPTION This module implements a specialization of the node class to represent C<=pod> elements. =head1 AUTHOR Andrew Ford Ea.ford@ford-mason.co.ukE Andy Wardley Eabw@kfs.orgE =head1 COPYRIGHT Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. Copyright (C) 2009 Andrew Ford. All Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO Consult L for a discussion of nodes. Pod-POM-0.29/lib/Pod/POM/Node/Content.pm0000644000175000017500000000313311355203557016727 0ustar andrewandrew#============================================================= -*-Perl-*- # # Pod::POM::Node::Content # # DESCRIPTION # Module implementing specific nodes in a Pod::POM, subclassed from # Pod::POM::Node. # # AUTHOR # Andy Wardley # Andrew Ford # # COPYRIGHT # Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. # Copyright (C) 2009 Andrew Ford. All Rights Reserved. # # This module is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # # REVISION # $Id: Content.pm 76 2009-08-20 20:41:33Z ford $ # #======================================================================== package Pod::POM::Node::Content; use strict; use Pod::POM::Constants qw( :all ); use parent qw( Pod::POM::Node ); sub new { my $class = shift; return bless [ @_ ], $class; } sub present { my ($self, $view) = @_; $view ||= $Pod::POM::DEFAULT_VIEW; return join('', map { ref $_ ? $_->present($view) : $_ } @$self); } 1; =head1 NAME Pod::POM::Node::Content - =head1 SYNOPSIS use Pod::POM::Nodes; =head1 DESCRIPTION This module implements a specialization of the node class to represent =head1 AUTHOR Andrew Ford Ea.ford@ford-mason.co.ukE Andy Wardley Eabw@kfs.orgE =head1 COPYRIGHT Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. Copyright (C) 2009 Andrew Ford. All Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO Consult L for a discussion of nodes. Pod-POM-0.29/lib/Pod/POM/Node/Text.pm0000644000175000017500000000362512151743473016250 0ustar andrewandrew#============================================================= -*-Perl-*- # # Pod::POM::Node::Text # # DESCRIPTION # Module implementing specific nodes in a Pod::POM, subclassed from # Pod::POM::Node. # # AUTHOR # Andy Wardley # Andrew Ford # # COPYRIGHT # Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. # Copyright (C) 2009 Andrew Ford. All Rights Reserved. # # This module is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # # REVISION # $Id: Text.pm 89 2013-05-30 07:41:52Z ford $ # #======================================================================== package Pod::POM::Node::Text; use strict; use Pod::POM::Constants qw( :all ); use parent qw( Pod::POM::Node ); our @ATTRIBS = ( text => '' ); sub new { my $class = shift; my $pom = shift; my $text = shift; $text = $pom->parse_sequence($text) || return $class->error($pom->error()) if length $text && ! $pom->{in_begin}; return $class->SUPER::new($pom, $text); } sub add { return IGNORE; } sub present { my ($self, $view) = @_; my $text = $self->{ text }; $view ||= $Pod::POM::DEFAULT_VIEW; $text = $text->present($view) if ref $text; return $view->view_textblock($text); } 1; =head1 NAME Pod::POM::Node::Text - =head1 SYNOPSIS use Pod::POM::Nodes; =head1 DESCRIPTION This module implements a specialization of the node class to represent text elements. =head1 AUTHOR Andrew Ford Ea.ford@ford-mason.co.ukE Andy Wardley Eabw@kfs.orgE =head1 COPYRIGHT Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. Copyright (C) 2009 Andrew Ford. All Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO Consult L for a discussion of nodes. Pod-POM-0.29/lib/Pod/POM/Node/Head2.pm0000644000175000017500000000322212151743473016240 0ustar andrewandrew#============================================================= -*-Perl-*- # # Pod::POM::Node::Head2 # # DESCRIPTION # Module implementing specific nodes in a Pod::POM, subclassed from # Pod::POM::Node. # # AUTHOR # Andy Wardley # Andrew Ford # # COPYRIGHT # Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. # Copyright (C) 2009 Andrew Ford. All Rights Reserved. # # This module is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # # REVISION # $Id: Head2.pm 89 2013-05-30 07:41:52Z ford $ # #======================================================================== package Pod::POM::Node::Head2; use strict; use parent qw( Pod::POM::Node ); our @ATTRIBS = ( title => undef ); our @ACCEPT = qw( head3 head4 over begin for text verbatim code ); sub new { my ($class, $pom, $title) = @_; $title = $pom->parse_sequence($title) || return $class->error($pom->error()) if length $title; return $class->SUPER::new($pom, $title); } 1; =head1 NAME Pod::POM::Node::Head2 - =head1 SYNOPSIS use Pod::POM::Nodes; =head1 DESCRIPTION This module implements a specialization of the node class to represent C<=head2> elements. =head1 AUTHOR Andrew Ford Ea.ford@ford-mason.co.ukE Andy Wardley Eabw@kfs.orgE =head1 COPYRIGHT Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. Copyright (C) 2009 Andrew Ford. All Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO Consult L for a discussion of nodes. Pod-POM-0.29/lib/Pod/POM/Node/Head1.pm0000644000175000017500000000323012151743473016236 0ustar andrewandrew#============================================================= -*-Perl-*- # # Pod::POM::Node::Head1 # # DESCRIPTION # Module implementing specific nodes in a Pod::POM, subclassed from # Pod::POM::Node. # # AUTHOR # Andy Wardley # Andrew Ford # # COPYRIGHT # Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. # Copyright (C) 2009 Andrew Ford. All Rights Reserved. # # This module is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # # REVISION # $Id: Head1.pm 89 2013-05-30 07:41:52Z ford $ # #======================================================================== package Pod::POM::Node::Head1; use strict; use parent qw( Pod::POM::Node ); our @ATTRIBS = ( title => undef ); our @ACCEPT = qw( head2 head3 head4 over begin for text verbatim code ); sub new { my ($class, $pom, $title) = @_; $title = $pom->parse_sequence($title) || return $class->error($pom->error()) if length $title; return $class->SUPER::new($pom, $title); } 1; =head1 NAME Pod::POM::Node::Head1 - =head1 SYNOPSIS use Pod::POM::Nodes; =head1 DESCRIPTION This module implements a specialization of the node class to represent C<=head1> elements. =head1 AUTHOR Andrew Ford Ea.ford@ford-mason.co.ukE Andy Wardley Eabw@kfs.orgE =head1 COPYRIGHT Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. Copyright (C) 2009 Andrew Ford. All Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO Consult L for a discussion of nodes. Pod-POM-0.29/lib/Pod/POM/Node/Head3.pm0000644000175000017500000000321412151743473016242 0ustar andrewandrew#============================================================= -*-Perl-*- # # Pod::POM::Node::Head3 # # DESCRIPTION # Module implementing specific nodes in a Pod::POM, subclassed from # Pod::POM::Node. # # AUTHOR # Andy Wardley # Andrew Ford # # COPYRIGHT # Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. # Copyright (C) 2009 Andrew Ford. All Rights Reserved. # # This module is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # # REVISION # $Id: Head3.pm 89 2013-05-30 07:41:52Z ford $ # #======================================================================== package Pod::POM::Node::Head3; use strict; use parent qw( Pod::POM::Node ); our @ATTRIBS = ( title => undef ); our @ACCEPT = qw( head4 over begin for text verbatim code ); sub new { my ($class, $pom, $title) = @_; $title = $pom->parse_sequence($title) || return $class->error($pom->error()) if length $title; return $class->SUPER::new($pom, $title); } 1; =head1 NAME Pod::POM::Node::Head3 - =head1 SYNOPSIS use Pod::POM::Nodes; =head1 DESCRIPTION This module implements a specialization of the node class to represent C<=head3> elements. =head1 AUTHOR Andrew Ford Ea.ford@ford-mason.co.ukE Andy Wardley Eabw@kfs.orgE =head1 COPYRIGHT Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. Copyright (C) 2009 Andrew Ford. All Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO Consult L for a discussion of nodes. Pod-POM-0.29/lib/Pod/POM/Node/Code.pm0000644000175000017500000000274012151743473016173 0ustar andrewandrew#============================================================= -*-Perl-*- # # Pod::POM::Node::Code # # DESCRIPTION # Module implementing specific nodes in a Pod::POM, subclassed from # Pod::POM::Node. # # AUTHOR # Andy Wardley # Andrew Ford # # COPYRIGHT # Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. # Copyright (C) 2009 Andrew Ford. All Rights Reserved. # # This module is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # # REVISION # $Id: Code.pm 89 2013-05-30 07:41:52Z ford $ # #======================================================================== package Pod::POM::Node::Code; use strict; use parent qw( Pod::POM::Node ); our @ATTRIBS = ( text => '' ); sub present { my ($self, $view) = @_; $view ||= $Pod::POM::DEFAULT_VIEW; return $view->view_code($self->{ text }); } 1; =head1 NAME Pod::POM::Node::Code - =head1 SYNOPSIS =head1 DESCRIPTION This module implements a specialization of the node class to represent code elements. =head1 AUTHOR Andrew Ford Ea.ford@ford-mason.co.ukE Andy Wardley Eabw@kfs.orgE =head1 COPYRIGHT Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. Copyright (C) 2009 Andrew Ford. All Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO Consult L for a discussion of nodes. Pod-POM-0.29/lib/Pod/POM/Node/Sequence.pm0000644000175000017500000000440312151743473017067 0ustar andrewandrew#============================================================= -*-Perl-*- # # Pod::POM::Node::Sequence # # DESCRIPTION # Module implementing specific nodes in a Pod::POM, subclassed from # Pod::POM::Node. # # AUTHOR # Andy Wardley # Andrew Ford # # COPYRIGHT # Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. # Copyright (C) 2009 Andrew Ford. All Rights Reserved. # # This module is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # # REVISION # $Id: Sequence.pm 89 2013-05-30 07:41:52Z ford $ # #======================================================================== package Pod::POM::Node::Sequence; use strict; use Pod::POM::Constants qw( :all ); use parent qw( Pod::POM::Node ); our %NAME = ( C => 'code', B => 'bold', I => 'italic', L => 'link', S => 'space', F => 'file', X => 'index', Z => 'zero', E => 'entity', ); sub new { my ($class, $self) = @_; local $" = '] ['; return bless \$self, $class; } sub add { return IGNORE; } sub present { my ($self, $view) = @_; my ($cmd, $method, $result); $view ||= $Pod::POM::DEFAULT_VIEW; $self = $$self; return $self unless ref $self eq 'ARRAY'; my $text = join('', map { ref $_ ? $_->present($view) : $view->view_seq_text($_) } @{ $self->[CONTENT] }); if ($cmd = $self->[CMD]) { my $method = $NAME{ $cmd } || $cmd; $method = "view_seq_$method"; return $view->$method($text); } else { return $text; } } 1; =head1 NAME Pod::POM::Node::Sequence - =head1 SYNOPSIS use Pod::POM::Nodes; =head1 DESCRIPTION This module implements a specialization of the node class to represent sequence elements. =head1 AUTHOR Andrew Ford Ea.ford@ford-mason.co.ukE Andy Wardley Eabw@kfs.orgE =head1 COPYRIGHT Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. Copyright (C) 2009 Andrew Ford. All Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO Consult L for a discussion of nodes. Pod-POM-0.29/lib/Pod/POM/Node/Verbatim.pm0000644000175000017500000000302212151743473017064 0ustar andrewandrew#============================================================= -*-Perl-*- # # Pod::POM::Node::Verbatim # # DESCRIPTION # Module implementing specific nodes in a Pod::POM, subclassed from # Pod::POM::Node. # # AUTHOR # Andy Wardley # Andrew Ford # # COPYRIGHT # Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. # Copyright (C) 2009 Andrew Ford. All Rights Reserved. # # This module is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # # REVISION # $Id: Verbatim.pm 89 2013-05-30 07:41:52Z ford $ # #======================================================================== package Pod::POM::Node::Verbatim; use strict; use parent qw( Pod::POM::Node ); our @ATTRIBS = ( text => '' ); sub present { my ($self, $view) = @_; $view ||= $Pod::POM::DEFAULT_VIEW; return $view->view_verbatim($self->{ text }); } 1; =head1 NAME Pod::POM::Node::Verbatim - =head1 SYNOPSIS use Pod::POM::Nodes; =head1 DESCRIPTION This module implements a specialization of the node class to represent verbatim elements. =head1 AUTHOR Andrew Ford Ea.ford@ford-mason.co.ukE Andy Wardley Eabw@kfs.orgE =head1 COPYRIGHT Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. Copyright (C) 2009 Andrew Ford. All Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO Consult L for a discussion of nodes. Pod-POM-0.29/lib/Pod/POM/Node/Head4.pm0000644000175000017500000000320612151743473016244 0ustar andrewandrew#============================================================= -*-Perl-*- # # Pod::POM::Node::Head4 # # DESCRIPTION # Module implementing specific nodes in a Pod::POM, subclassed from # Pod::POM::Node. # # AUTHOR # Andy Wardley # Andrew Ford # # COPYRIGHT # Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. # Copyright (C) 2009 Andrew Ford. All Rights Reserved. # # This module is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # # REVISION # $Id: Head4.pm 89 2013-05-30 07:41:52Z ford $ # #======================================================================== package Pod::POM::Node::Head4; use strict; use parent qw( Pod::POM::Node ); our @ATTRIBS = ( title => undef ); our @ACCEPT = qw( over begin for text verbatim code ); sub new { my ($class, $pom, $title) = @_; $title = $pom->parse_sequence($title) || return $class->error($pom->error()) if length $title; return $class->SUPER::new($pom, $title); } 1; =head1 NAME Pod::POM::Node::Head4 - =head1 SYNOPSIS use Pod::POM::Nodes; =head1 DESCRIPTION This module implements a specialization of the node class to represent C<=head4> elements. =head1 AUTHOR Andrew Ford Ea.ford@ford-mason.co.ukE Andy Wardley Eabw@kfs.orgE =head1 COPYRIGHT Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. Copyright (C) 2009 Andrew Ford. All Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO Consult L for a discussion of nodes. Pod-POM-0.29/lib/Pod/POM/Node/Begin.pm0000644000175000017500000000270412151743473016345 0ustar andrewandrew#============================================================= -*-Perl-*- # # Pod::POM::Node::Begin # # DESCRIPTION # Module implementing specific nodes in a Pod::POM, subclassed from # Pod::POM::Node. # # AUTHOR # Andy Wardley # Andrew Ford # # COPYRIGHT # Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. # Copyright (C) 2009 Andrew Ford. All Rights Reserved. # # This module is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # # REVISION # $Id: Begin.pm 89 2013-05-30 07:41:52Z ford $ # #======================================================================== package Pod::POM::Node::Begin; use strict; use parent qw( Pod::POM::Node ); our @ATTRIBS = ( format => undef ); our @ACCEPT = qw( text verbatim code ); our $EXPECT = 'end'; 1; =head1 NAME Pod::POM::Node::Begin - POM '=begin' node class =head1 SYNOPSIS =head1 DESCRIPTION This module implements a specialization of the node class to represent '=begin' elements. =head1 AUTHOR Andrew Ford Ea.ford@ford-mason.co.ukE Andy Wardley Eabw@kfs.orgE =head1 COPYRIGHT Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. Copyright (C) 2009 Andrew Ford. All Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO Consult L for a discussion of nodes. Pod-POM-0.29/lib/Pod/POM/Node/For.pm0000644000175000017500000000302412151743473016043 0ustar andrewandrew#============================================================= -*-Perl-*- # # Pod::POM::Nodes # # DESCRIPTION # Module implementing specific nodes in a Pod::POM, subclassed from # Pod::POM::Node. # # AUTHOR # Andy Wardley # Andrew Ford # # COPYRIGHT # Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. # Copyright (C) 2009 Andrew Ford. All Rights Reserved. # # This module is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # # REVISION # $Id: For.pm 89 2013-05-30 07:41:52Z ford $ # #======================================================================== package Pod::POM::Node::For; use strict; use parent qw( Pod::POM::Node ); our @ATTRIBS = ( format => undef, text => '' ); sub new { my $class = shift; my $pom = shift; my $text = shift; return $class->SUPER::new($pom, split(/\s+/, $text, 2)); } 1; =head1 NAME Pod::POM::Node::For - =head1 SYNOPSIS use Pod::POM::Nodes; =head1 DESCRIPTION This module implements a specialization of the node class to represent C<=for> elements. =head1 AUTHOR Andrew Ford Ea.ford@ford-mason.co.ukE Andy Wardley Eabw@kfs.orgE =head1 COPYRIGHT Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. Copyright (C) 2009 Andrew Ford. All Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO Consult L for a discussion of nodes. Pod-POM-0.29/lib/Pod/POM/Node/Item.pm0000644000175000017500000000317212151743473016217 0ustar andrewandrew#============================================================= -*-Perl-*- # # Pod::POM::Nodes # # DESCRIPTION # Module implementing specific nodes in a Pod::POM, subclassed from # Pod::POM::Node. # # AUTHOR # Andy Wardley # Andrew Ford # # COPYRIGHT # Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. # Copyright (C) 2009 Andrew Ford. All Rights Reserved. # # This module is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # # REVISION # $Id: Item.pm 89 2013-05-30 07:41:52Z ford $ # #======================================================================== package Pod::POM::Node::Item; use strict; use parent qw( Pod::POM::Node ); our @ATTRIBS = ( title => '*' ); our @ACCEPT = qw( over begin for text verbatim code ); sub new { my ($class, $pom, $title) = @_; $title = $pom->parse_sequence($title) || return $class->error($pom->error()) if length $title; return $class->SUPER::new($pom, $title); } 1; =head1 NAME Pod::POM::Node::Item - =head1 SYNOPSIS use Pod::POM::Nodes; =head1 DESCRIPTION This module implements a specialization of the node class to represent C<=item> elements. =head1 AUTHOR Andrew Ford Ea.ford@ford-mason.co.ukE Andy Wardley Eabw@kfs.orgE =head1 COPYRIGHT Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. Copyright (C) 2009 Andrew Ford. All Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO Consult L for a discussion of nodes. Pod-POM-0.29/lib/Pod/POM/Nodes.pm0000644000175000017500000000357611355203560015505 0ustar andrewandrew#============================================================= -*-Perl-*- # # Pod::POM::Nodes # # DESCRIPTION # Module implementing specific nodes in a Pod::POM, subclassed from # Pod::POM::Node. # # AUTHOR # Andy Wardley # # COPYRIGHT # Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. # # This module is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # # REVISION # $Id: Nodes.pm 76 2009-08-20 20:41:33Z ford $ # #======================================================================== package Pod::POM::Nodes; require 5.004; require Exporter; use strict; use Pod::POM::Node::Pod; use Pod::POM::Node::Head1; use Pod::POM::Node::Head2; use Pod::POM::Node::Head3; use Pod::POM::Node::Head4; use Pod::POM::Node::Over; use Pod::POM::Node::Item; use Pod::POM::Node::Begin; use Pod::POM::Node::For; use Pod::POM::Node::Verbatim; use Pod::POM::Node::Code; use Pod::POM::Node::Text; use Pod::POM::Node::Sequence; use Pod::POM::Node::Content; use vars qw( $VERSION $DEBUG $ERROR @EXPORT_OK @EXPORT_FAIL ); use base qw( Exporter ); $VERSION = sprintf("%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/); $DEBUG = 0 unless defined $DEBUG; 1; =head1 NAME Pod::POM::Nodes - convenience class to load all node classes =head1 SYNOPSIS use Pod::POM::Nodes; =head1 DESCRIPTION This module implements a convenience class that simply uses all of the subclasses of Pod::POM::Node. (It used to include all the individual classes inline, but the node classes have been factored out into individual modules.) =head1 AUTHOR Andy Wardley Eabw@kfs.orgE =head1 COPYRIGHT Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO Consult L for a general overview and examples of use. Pod-POM-0.29/lib/Pod/POM/View.pm0000644000175000017500000000606311355203560015341 0ustar andrewandrew#============================================================= -*-Perl-*- # # Pod::POM::View # # DESCRIPTION # Visitor class for creating a view of all or part of a Pod Object # Model. # # AUTHOR # Andy Wardley # # COPYRIGHT # Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. # # This module is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # # REVISION # $Id: View.pm 32 2009-03-17 21:08:25Z ford $ # #======================================================================== package Pod::POM::View; require 5.004; use strict; use vars qw( $VERSION $DEBUG $ERROR $AUTOLOAD $INSTANCE ); $VERSION = sprintf("%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/); $DEBUG = 0 unless defined $DEBUG; #------------------------------------------------------------------------ # new($pom) #------------------------------------------------------------------------ sub new { my $class = shift; my $args = ref $_[0] eq 'HASH' ? shift : { @_ }; bless { %$args }, $class; } sub print { my ($self, $item) = @_; return UNIVERSAL::can($item, 'present') ? $item->present($self) : $item; } sub view { my ($self, $type, $node) = @_; return $node; } sub instance { my $self = shift; my $class = ref $self || $self; no strict 'refs'; my $instance = \${"$class\::_instance"}; defined $$instance ? $$instance : ($$instance = $class->new(@_)); } sub visit { my ($self, $place) = @_; $self = $self->instance() unless ref $self; my $visit = $self->{ VISIT } ||= [ ]; push(@$visit, $place); return $place; } sub leave { my ($self, $place) = @_; $self = $self->instance() unless ref $self; my $visit = $self->{ VISIT }; return $self->error('empty VISIT stack') unless @$visit; pop(@$visit); } sub visiting { my ($self, $place) = @_; $self = $self->instance() unless ref $self; my $visit = $self->{ VISIT }; return 0 unless $visit && @$visit; foreach (reverse @$visit) { return 1 if $_ eq $place; } return 0; } sub AUTOLOAD { my $self = shift; my $name = $AUTOLOAD; my $item; $name =~ s/.*:://; return if $name eq 'DESTROY'; if ($name =~ s/^view_//) { return $self->view($name, @_); } elsif (! ref $self) { die "can't access $name in $self\n"; } else { die "no such method for $self: $name ($AUTOLOAD)" unless defined ($item = $self->{ $name }); return wantarray ? ( ref $item eq 'ARRAY' ? @$item : $item ) : $item; } } 1; =head1 NAME Pod::POM::View =head1 DESCRIPTION Visitor class for creating a view of all or part of a Pod Object Model. =head1 METHODS =over 4 =item C =item C =item C =item C =item C =item C =item C =back =head1 AUTHOR Andy Wardley Eabw@kfs.orgE =head1 COPYRIGHT AND LICENSE Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Pod-POM-0.29/lib/Pod/POM/Constants.pm0000644000175000017500000000340512151743473016407 0ustar andrewandrew#============================================================= -*-Perl-*- # # Pod::POM::Constants # # DESCRIPTION # Constants used by Pod::POM. # # AUTHOR # Andy Wardley # Andrew Ford # # COPYRIGHT # Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. # Copyright (C) 2009 Andrew Ford. All Rights Reserved. # # This module is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # # REVISION # $Id: Constants.pm 89 2013-05-30 07:41:52Z ford $ # #======================================================================== package Pod::POM::Constants; require 5.004; use strict; use parent qw( Exporter ); our $VERSION = sprintf("%d.%02d", q$Revision: 1.1.1.1 $ =~ /(\d+)\.(\d+)/); our @SEQUENCE = qw( CMD LPAREN RPAREN FILE LINE CONTENT ); our @STATUS = qw( IGNORE REDUCE REJECT ); our @EXPORT_OK = ( @SEQUENCE, @STATUS ); our %EXPORT_TAGS = ( status => [ @STATUS ], seq => [ @SEQUENCE ], all => [ @STATUS, @SEQUENCE ], ); # sequence items use constant CMD => 0; use constant LPAREN => 1; use constant RPAREN => 2; use constant FILE => 3; use constant LINE => 4; use constant CONTENT => 5; # node add return values use constant IGNORE => 0; use constant REDUCE => 1; use constant REJECT => 2; 1; =head1 NAME Pod::POM::Constants =head1 DESCRIPTION Constants used by Pod::POM. =head1 AUTHOR Andy Wardley Eabw@kfs.orgE Andrew Ford Ea.ford@ford-mason.co.ukE =head1 COPYRIGHT AND LICENSE Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. Copyright (C) 2009 Andrew Ford. All Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Pod-POM-0.29/lib/Pod/POM/Test.pm0000644000175000017500000000312111355203560015336 0ustar andrewandrew#============================================================= -*-Perl-*- # # Pod::POM::Test # # DESCRIPTION # Module implementing some useful subroutines for testing. # # AUTHOR # Andy Wardley # # COPYRIGHT # Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. # # This module is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # # REVISION # $Id: Test.pm 14 2009-03-13 08:19:40Z ford $ # #======================================================================== package Pod::POM::Test; require 5.004; use strict; use Pod::POM; use base qw( Exporter ); use vars qw( $VERSION @EXPORT ); $VERSION = sprintf("%d.%02d", q$Revision: 1.1.1.1 $ =~ /(\d+)\.(\d+)/); @EXPORT = qw( ntests ok match assert ); my $ok_count; sub ntests { my $ntests = shift; $ok_count = 1; print "1..$ntests\n"; } sub ok { my ($ok, $msg) = @_; if ($ok) { print "ok ", $ok_count++, "\n"; } else { print "FAILED $ok_count: $msg\n" if defined $msg; print "not ok ", $ok_count++, "\n"; } } sub assert { my ($ok, $err) = @_; return ok(1) if $ok; # failed my ($pkg, $file, $line) = caller(); $err ||= "assert failed"; $err .= " at $file line $line\n"; ok(0); die $err; } sub match { my ($result, $expect) = @_; # force stringification of $result to avoid 'no eq method' overload errors $result = "$result" if ref $result; if ($result eq $expect) { ok(1); } else { print "FAILED $ok_count:\n expect: [$expect]\n result: [$result]\n"; ok(0); } } 1; Pod-POM-0.29/lib/Pod/POM/View/0000755000175000017500000000000012260471766015011 5ustar andrewandrewPod-POM-0.29/lib/Pod/POM/View/HTML.pm0000644000175000017500000002426311355203560016107 0ustar andrewandrew#============================================================= -*-Perl-*- # # Pod::POM::View::HTML # # DESCRIPTION # HTML view of a Pod Object Model. # # AUTHOR # Andy Wardley # # COPYRIGHT # Copyright (C) 2000 Andy Wardley. All Rights Reserved. # # This module is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # # REVISION # $Id: HTML.pm 84 2009-08-20 21:07:00Z ford $ # #======================================================================== package Pod::POM::View::HTML; require 5.004; use strict; use Pod::POM::View; use parent qw( Pod::POM::View ); use vars qw( $VERSION $DEBUG $ERROR $AUTOLOAD ); use Text::Wrap; $VERSION = sprintf("%d.%02d", q$Revision: 1.6 $ =~ /(\d+)\.(\d+)/); $DEBUG = 0 unless defined $DEBUG; my $HTML_PROTECT = 0; my @OVER; sub new { my $class = shift; my $self = $class->SUPER::new(@_) || return; # initalise stack for maintaining info for nested lists $self->{ OVER } = []; return $self; } sub view { my ($self, $type, $item) = @_; if ($type =~ s/^seq_//) { return $item; } elsif (UNIVERSAL::isa($item, 'HASH')) { if (defined $item->{ content }) { return $item->{ content }->present($self); } elsif (defined $item->{ text }) { my $text = $item->{ text }; return ref $text ? $text->present($self) : $text; } else { return ''; } } elsif (! ref $item) { return $item; } else { return ''; } } sub view_pod { my ($self, $pod) = @_; return "\n\n" . $pod->content->present($self) . "\n\n"; } sub view_head1 { my ($self, $head1) = @_; my $title = $head1->title->present($self); return "

$title

\n\n" . $head1->content->present($self); } sub view_head2 { my ($self, $head2) = @_; my $title = $head2->title->present($self); return "

$title

\n" . $head2->content->present($self); } sub view_head3 { my ($self, $head3) = @_; my $title = $head3->title->present($self); return "

$title

\n" . $head3->content->present($self); } sub view_head4 { my ($self, $head4) = @_; my $title = $head4->title->present($self); return "

$title

\n" . $head4->content->present($self); } sub view_over { my ($self, $over) = @_; my ($start, $end, $strip); my $items = $over->item(); if (@$items) { my $first_title = $items->[0]->title(); if ($first_title =~ /^\s*\*\s*/) { # '=item *' =>
    $start = "
      \n"; $end = "
    \n"; $strip = qr/^\s*\*\s*/; } elsif ($first_title =~ /^\s*\d+\.?\s*/) { # '=item 1.' or '=item 1 ' =>
      $start = "
        \n"; $end = "
      \n"; $strip = qr/^\s*\d+\.?\s*/; } else { $start = "
        \n"; $end = "
      \n"; $strip = ''; } my $overstack = ref $self ? $self->{ OVER } : \@OVER; push(@$overstack, $strip); my $content = $over->content->present($self); pop(@$overstack); return $start . $content . $end; } else { return "
      \n" . $over->content->present($self) . "
      \n"; } } sub view_item { my ($self, $item) = @_; my $over = ref $self ? $self->{ OVER } : \@OVER; my $title = $item->title(); my $strip = $over->[-1]; if (defined $title) { $title = $title->present($self) if ref $title; $title =~ s/$strip// if $strip; if (length $title) { my $anchor = $title; $anchor =~ s/^\s*|\s*$//g; # strip leading and closing spaces $anchor =~ s/\W/_/g; $title = qq{$title}; } } return '
    1. ' . "$title\n" . $item->content->present($self) . "
      2. \n"; } sub view_for { my ($self, $for) = @_; return '' unless $for->format() =~ /\bhtml\b/; return $for->text() . "\n\n"; } sub view_begin { my ($self, $begin) = @_; return '' unless $begin->format() =~ /\bhtml\b/; $HTML_PROTECT++; my $output = $begin->content->present($self); $HTML_PROTECT--; return $output; } sub view_textblock { my ($self, $text) = @_; return $HTML_PROTECT ? "$text\n" : "

      $text

      \n"; } sub view_verbatim { my ($self, $text) = @_; for ($text) { s/&/&/g; s//>/g; } return "
      $text
      \n\n"; } sub view_seq_bold { my ($self, $text) = @_; return "$text"; } sub view_seq_italic { my ($self, $text) = @_; return "$text"; } sub view_seq_code { my ($self, $text) = @_; return "$text"; } sub view_seq_file { my ($self, $text) = @_; return "$text"; } sub view_seq_space { my ($self, $text) = @_; $text =~ s/\s/ /g; return $text; } sub view_seq_entity { my ($self, $entity) = @_; return "&$entity;" } sub view_seq_index { return ''; } sub view_seq_link { my ($self, $link) = @_; # view_seq_text has already taken care of L if ($link =~ /^view_seq_link_transform_path($page); } # append the #section if exists $url .= "#$section" if defined $url and defined $section and length $section; return make_href($url, $linktext); } # should be sub-classed if extra transformations are needed # # for example a sub-class may search for the given page and return a # relative path to it. # # META: where this functionality should be documented? This module # doesn't have docs section # sub view_seq_link_transform_path { my($self, $page) = @_; # right now the default transform doesn't check whether the link # is not dead (i.e. whether there is a corresponding file. # therefore we don't link L<>'s other than L # subclass to change the default (and of course add validation) # this is the minimal transformation that will be required if enabled # $page = "$page.html"; # $page =~ s|::|/|g; #print "page $page\n"; return undef; } sub make_href { my($url, $title) = @_; if (!defined $url) { return defined $title ? "$title" : ''; } $title = $url unless defined $title; #print "$url, $title\n"; return qq{$title}; } # this code has been borrowed from Pod::Html my $urls = '(' . join ('|', qw{ http telnet mailto news gopher file wais ftp } ) . ')'; my $ltrs = '\w'; my $gunk = '/#~:.?+=&%@!\-'; my $punc = '.:!?\-;'; my $any = "${ltrs}${gunk}${punc}"; sub view_seq_text { my ($self, $text) = @_; unless ($HTML_PROTECT) { for ($text) { s/&/&/g; s//>/g; } } $text =~ s{ \b # start at word boundary ( # begin $1 { $urls : # need resource and a colon (?!:) # Ignore File::, among others. [$any] +? # followed by one or more of any valid # character, but be conservative and # take only what you need to.... ) # end $1 } (?= # look-ahead non-consumptive assertion [$punc]* # either 0 or more punctuation followed (?: # followed [^$any] # by a non-url char | # or $ # end of the string ) # | # or else $ # then end of the string ) }{$1}igox; return $text; } sub encode { my($self,$text) = @_; require Encode; return Encode::encode("ascii",$text,Encode::FB_XMLCREF()); } 1; =head1 NAME Pod::POM::View::HTML =head1 DESCRIPTION HTML view of a Pod Object Model. =head1 METHODS =over 4 =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C Returns the text of a CE> sequence enclosed in a Cb> element. =item C Returns the text of a CE> sequence enclosed in a Ci> element. =item C Returns the text of a CE> sequence enclosed in a Ccode> element. =item C =item C =item C Returns an empty string. Index sequences are suppressed in HTML view. =item C =back =head1 AUTHOR Andy Wardley Eabw@kfs.orgE =head1 COPYRIGHT AND LICENSE Copyright (C) 2000 Andy Wardley. All Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Pod-POM-0.29/lib/Pod/POM/View/Pod.pm0000644000175000017500000001041611355203560016060 0ustar andrewandrew#============================================================= -*-Perl-*- # # Pod::POM::View::Pod # # DESCRIPTION # Pod view of a Pod Object Model. # # AUTHOR # Andy Wardley # # COPYRIGHT # Copyright (C) 2000 Andy Wardley. All Rights Reserved. # # This module is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # # REVISION # $Id: Pod.pm 77 2009-08-20 20:44:14Z ford $ # #======================================================================== package Pod::POM::View::Pod; require 5.004; use strict; use Pod::POM::Nodes; use Pod::POM::View; use parent qw( Pod::POM::View ); use vars qw( $VERSION $DEBUG $ERROR $AUTOLOAD $MARKUP ); $VERSION = sprintf("%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/); $DEBUG = 0 unless defined $DEBUG; # create reverse lookup table mapping method name to original sequence $MARKUP = { map { ( $Pod::POM::Node::Sequence::NAME{ $_ } => $_ ) } keys %Pod::POM::Node::Sequence::NAME, }; sub view { my ($self, $type, $item) = @_; # my ($pkg, $file, $line) = caller; # print STDERR "called view ($type) from $file line $line\n"; if ($type =~ s/^seq_//) { if ($type eq 'text') { return "$item"; } if ($type = $MARKUP->{ $type }) { if ($item =~ /[<>]/) { return "$type<< $item >>"; } else { return "$type<$item>"; } } } elsif (ref $item eq 'HASH') { if (defined $item->{ content }) { return $item->{ content }->present($self); } elsif (defined $item->{ text }) { my $text = $item->{ text }; return ref $text ? $text->present($self) : $text; } else { return ''; } } elsif (! ref $item) { return $item; } else { return ''; } } sub view_pod { my ($self, $pod) = @_; # return "=pod\n\n" . $pod->content->present($self) . "=cut\n\n"; return $pod->content->present($self); } sub view_head1 { my ($self, $head1) = @_; return '=head1 ' . $head1->title->present($self) . "\n\n" . $head1->content->present($self); } sub view_head2 { my ($self, $head2) = @_; return '=head2 ' . $head2->title->present($self) . "\n\n" . $head2->content->present($self); } sub view_head3 { my ($self, $head3) = @_; return '=head3 ' . $head3->title->present($self) . "\n\n" . $head3->content->present($self); } sub view_head4 { my ($self, $head4) = @_; return '=head4 ' . $head4->title->present($self) . "\n\n" . $head4->content->present($self); } sub view_over { my ($self, $over) = @_; return '=over ' . $over->indent() . "\n\n" . $over->content->present($self) . "=back\n\n"; } sub view_item { my ($self, $item) = @_; my $title = $item->title(); $title = $title->present($self) if ref $title; return "=item $title\n\n" . $item->content->present($self); } sub view_for { my ($self, $for) = @_; return '=for ' . $for->format . ' ' . $for->text() . "\n\n" . $for->content->present($self); } sub view_begin { my ($self, $begin) = @_; return '=begin ' . $begin->format() . "\n\n" . $begin->content->present($self) . "=end " . $begin->format() . "\n\n"; } sub view_textblock { my ($self, $text) = @_; return "$text\n\n"; } sub view_verbatim { my ($self, $text) = @_; return "$text\n\n"; } sub view_meta { my ($self, $meta) = @_; return '=meta ' . $meta->name() . "\n\n" . $meta->content->present($self) . "=end\n\n"; } 1; =head1 NAME Pod::POM::View::Pod =head1 DESCRIPTION Pod view of a Pod Object Model. =head1 METHODS =over 4 =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =back =head1 AUTHOR Andy Wardley Eabw@kfs.orgE =head1 COPYRIGHT AND LICENSE Copyright (C) 2000 Andy Wardley. All Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Pod-POM-0.29/lib/Pod/POM/View/Text.pm0000644000175000017500000001513411355203560016264 0ustar andrewandrew#============================================================= -*-Perl-*- # # Pod::POM::View::Text # # DESCRIPTION # Text view of a Pod Object Model. # # AUTHOR # Andy Wardley # # COPYRIGHT # Copyright (C) 2000 Andy Wardley. All Rights Reserved. # # This module is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # # REVISION # $Id: Text.pm 77 2009-08-20 20:44:14Z ford $ # #======================================================================== package Pod::POM::View::Text; require 5.004; use strict; use Pod::POM::View; use parent qw( Pod::POM::View ); use vars qw( $VERSION $DEBUG $ERROR $AUTOLOAD $INDENT ); use Text::Wrap; $VERSION = sprintf("%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/); $DEBUG = 0 unless defined $DEBUG; $INDENT = 0; sub new { my $class = shift; my $args = ref $_[0] eq 'HASH' ? shift : { @_ }; bless { INDENT => 0, %$args, }, $class; } sub view { my ($self, $type, $item) = @_; if ($type =~ s/^seq_//) { return $item; } elsif (UNIVERSAL::isa($item, 'HASH')) { if (defined $item->{ content }) { return $item->{ content }->present($self); } elsif (defined $item->{ text }) { my $text = $item->{ text }; return ref $text ? $text->present($self) : $text; } else { return ''; } } elsif (! ref $item) { return $item; } else { return ''; } } sub view_head1 { my ($self, $head1) = @_; my $indent = ref $self ? \$self->{ INDENT } : \$INDENT; my $pad = ' ' x $$indent; local $Text::Wrap::unexpand = 0; my $title = wrap($pad, $pad, $head1->title->present($self)); $$indent += 4; my $output = "$title\n" . $head1->content->present($self); $$indent -= 4; return $output; } sub view_head2 { my ($self, $head2) = @_; my $indent = ref $self ? \$self->{ INDENT } : \$INDENT; my $pad = ' ' x $$indent; local $Text::Wrap::unexpand = 0; my $title = wrap($pad, $pad, $head2->title->present($self)); $$indent += 4; my $output = "$title\n" . $head2->content->present($self); $$indent -= 4; return $output; } sub view_head3 { my ($self, $head3) = @_; my $indent = ref $self ? \$self->{ INDENT } : \$INDENT; my $pad = ' ' x $$indent; local $Text::Wrap::unexpand = 0; my $title = wrap($pad, $pad, $head3->title->present($self)); $$indent += 4; my $output = "$title\n" . $head3->content->present($self); $$indent -= 4; return $output; } sub view_head4 { my ($self, $head4) = @_; my $indent = ref $self ? \$self->{ INDENT } : \$INDENT; my $pad = ' ' x $$indent; local $Text::Wrap::unexpand = 0; my $title = wrap($pad, $pad, $head4->title->present($self)); $$indent += 4; my $output = "$title\n" . $head4->content->present($self); $$indent -= 4; return $output; } #------------------------------------------------------------------------ # view_over($self, $over) # # Present an =over block - this is a blockquote if there are no =items # within the block. #------------------------------------------------------------------------ sub view_over { my ($self, $over) = @_; if (@{$over->item}) { return $over->content->present($self); } else { my $indent = ref $self ? \$self->{ INDENT } : \$INDENT; my $pad = ' ' x $$indent; $$indent += 4; my $content = $over->content->present($self); $$indent -= 4; return $content; } } sub view_item { my ($self, $item) = @_; my $indent = ref $self ? \$self->{ INDENT } : \$INDENT; my $pad = ' ' x $$indent; local $Text::Wrap::unexpand = 0; my $title = wrap($pad . '* ', $pad . ' ', $item->title->present($self)); $$indent += 2; my $content = $item->content->present($self); $$indent -= 2; return "$title\n\n$content"; } sub view_for { my ($self, $for) = @_; return '' unless $for->format() =~ /\btext\b/; return $for->text() . "\n\n"; } sub view_begin { my ($self, $begin) = @_; return '' unless $begin->format() =~ /\btext\b/; return $begin->content->present($self); } sub view_textblock { my ($self, $text) = @_; my $indent = ref $self ? \$self->{ INDENT } : \$INDENT; $text =~ s/\s+/ /mg; $$indent ||= 0; my $pad = ' ' x $$indent; local $Text::Wrap::unexpand = 0; return wrap($pad, $pad, $text) . "\n\n"; } sub view_verbatim { my ($self, $text) = @_; my $indent = ref $self ? \$self->{ INDENT } : \$INDENT; my $pad = ' ' x $$indent; $text =~ s/^/$pad/mg; return "$text\n\n"; } sub view_seq_bold { my ($self, $text) = @_; return "*$text*"; } sub view_seq_italic { my ($self, $text) = @_; return "_${text}_"; } sub view_seq_code { my ($self, $text) = @_; return "'$text'"; } sub view_seq_file { my ($self, $text) = @_; return "_${text}_"; } my $entities = { gt => '>', lt => '<', amp => '&', quot => '"', }; sub view_seq_entity { my ($self, $entity) = @_; return $entities->{ $entity } || $entity; } sub view_seq_index { return ''; } sub view_seq_link { my ($self, $link) = @_; if ($link =~ s/^.*?\|//) { return $link; } else { return "the $link manpage"; } } 1; =head1 NAME Pod::POM::View::Text =head1 DESCRIPTION Text view of a Pod Object Model. =head1 METHODS =over 4 =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C Returns the text of a CE> sequence in 'bold' (i.e. surrounded by asterisks, like *this*). =item C Returns the text of a CE> sequence in 'italics' (i.e. surrounded by underscores, like _this_). =item C =item C =item C =item C Returns an empty string. Index sequences are suppressed in text view. =item C =back =head1 AUTHOR Andy Wardley Eabw@kfs.orgE =head1 COPYRIGHT AND LICENSE Copyright (C) 2000 Andy Wardley. All Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Pod-POM-0.29/lib/Pod/POM.pm0000644000175000017500000013305212260471742014433 0ustar andrewandrew#============================================================= -*-Perl-*- # # Pod::POM # # DESCRIPTION # Parses POD from a file or text string and builds a tree structure, # hereafter known as the POD Object Model (POM). # # AUTHOR # Andy Wardley # # Andrew Ford (co-maintainer as of 03/2009) # # COPYRIGHT # Copyright (C) 2000-2009 Andy Wardley. All Rights Reserved. # Copyright (C) 2009 Andrew Ford. All Rights Reserved. # # This module is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # # REVISION # $Id: POM.pm 91 2013-12-31 07:36:02Z ford $ # #======================================================================== package Pod::POM; require 5.004; use strict; use Pod::POM::Constants qw( :all ); use Pod::POM::Nodes; use Pod::POM::View::Pod; use parent qw( Exporter ); our $VERSION = '0.29'; our $DEBUG = 0 unless defined $DEBUG; our $ROOT = 'Pod::POM::Node::Pod'; # root node class our $TEXTSEQ = 'Pod::POM::Node::Sequence'; # text sequence class our $DEFAULT_VIEW = 'Pod::POM::View::Pod'; # default view class #------------------------------------------------------------------------ # allow 'meta' to be specified as a load option to activate =meta tags #------------------------------------------------------------------------ our @EXPORT_OK = qw( meta ); our @EXPORT_FAIL = qw( meta ); our $ALLOW_META = 0; sub export_fail { my $class = shift; my $meta = shift; return ($meta, @_) unless $meta eq 'meta'; $ALLOW_META++; return @_; } #------------------------------------------------------------------------ # new(\%options) #------------------------------------------------------------------------ sub new { my $class = shift; my $config = ref $_[0] eq 'HASH' ? shift : { @_ }; bless { CODE => $config->{ code } || 0, WARN => $config->{ warn } || 0, META => $config->{ meta } || $ALLOW_META, WARNINGS => [ ], FILENAME => '', ERROR => '', }, $class; } #------------------------------------------------------------------------ # parse($text_or_file) # # General purpose parse method which attempts to Do The Right Thing in # calling parse_file() or parse_text() according to the argument # passed. A hash reference can be specified that contains a 'text' # or 'file' key and corresponding value. Otherwise, the argument can # be a reference to an input handle which is passed off to parse_file(). # If the argument is a text string that contains '=' at the start of # any line then it is treated as Pod text and passed to parse_text(), # otherwise it is assumed to be a filename and passed to parse_file(). #------------------------------------------------------------------------ sub parse { my ($self, $input) = @_; my $result; if (ref $input eq 'HASH') { if ($input = $input->{ text }) { $result = $self->parse_text($input, $input->{ name }); } elsif ($input = $input->{ file }) { $result = $self->parse_file($input); } else { $result = $self->error("no 'text' or 'file' specified"); } } elsif (ref $input || $input !~ /^=/m) { # doesn't look like POD text $result = $self->parse_file($input); } else { # looks like POD text $result = $self->parse_text($input); } return $result; } #------------------------------------------------------------------------ # parse_file($filename_or_handle) # # Reads the content of a Pod file specified by name or file handle, and # passes it to parse_text() for parsing. #------------------------------------------------------------------------ sub parse_file { my ($self, $file) = @_; my ($text, $name); if (ref $file) { # assume open filehandle local $/ = undef; $name = ''; $text = <$file>; } else { # a file which must be opened local *FP; local $/ = undef; $name = ( $file eq '-' ? '' : $file ); open(FP, $file) || return $self->error("$file: $!"); $text = ; close(FP); } $self->parse_text($text, $name); } #------------------------------------------------------------------------ # parse_text($text, $name) # # Main parser method. Scans the input text for Pod sections and splits # them into paragraphs. Builds a tree of Pod::POM::Node::* objects # to represent the Pod document in object model form. #------------------------------------------------------------------------ sub parse_text { my ($self, $text, $name) = @_; my ($para, $paralen, $gap, $type, $line, $inpod, $code, $result, $verbatim); my $warn = $self->{ WARNINGS } = [ ]; my @stack = ( ); my $item = $ROOT->new($self); return $self->error($ROOT->error()) unless defined $item; push(@stack, $item); $name = '' unless defined $name; $self->{ FILENAME } = $name; $code = $self->{ CODE }; $line = \$self->{ LINE }; $$line = 1; $inpod = 0; my @encchunks = split /^(=encoding.*)/m, $text; $text = shift @encchunks; while (@encchunks) { my($encline,$chunk) = splice @encchunks, 0, 2; require Encode; my($encoding) = $encline =~ /^=encoding\s+(\S+)/; Encode::from_to($chunk, $encoding, "utf8"); Encode::_utf8_on($chunk); # $text .= "xxx$encline"; $text .= $chunk; } # patch from JJ # while ($text =~ /(?:(.*?)(\n{2,}))|(.+$)/sg) { while ($text =~ /(?:(.*?)((?:\s*\n){2,}))|(.+$)/sg) { ($para, $gap) = defined $1 ? ($1, $2) : ($3, ''); if ($para =~ s/^==?(\w+)\s*//) { $type = $1; # switch on for =pod or any other =cmd, switch off for =cut if ($type eq 'pod') { $inpod = 1; next } elsif ($type eq 'cut') { $inpod = 0; next } else { $inpod = 1 }; if ($type eq 'meta') { $self->{ META } ? $stack[0]->metadata(split(/\s+/, $para, 2)) : $self->warning("metadata not allowed", $name, $$line); next; } } elsif (! $inpod) { next unless $code; $type = 'code'; $para .= $gap; $gap = ''; } elsif ($para =~ /^\s+/) { $verbatim .= $para; $verbatim .= $gap; next; } else { $type = 'text'; chomp($para); # catches last line in file } if ($verbatim) { while(@stack) { $verbatim =~ s/\s+$//s; $result = $stack[-1]->add($self, 'verbatim', $verbatim); if (! defined $result) { $self->warning($stack[-1]->error(), $name, $$line); undef $verbatim; last; } elsif (ref $result) { push(@stack, $result); undef $verbatim; last; } elsif ($result == REDUCE) { pop @stack; undef $verbatim; last; } elsif ($result == REJECT) { $self->warning($stack[-1]->error(), $name, $$line); pop @stack; } elsif (@stack == 1) { $self->warning("unexpected $type", $name, $$line); undef $verbatim; last; } else { pop @stack; } } } while(@stack) { $result = $stack[-1]->add($self, $type, $para); if (! defined $result) { $self->warning($stack[-1]->error(), $name, $$line); last; } elsif (ref $result) { push(@stack, $result); last; } elsif ($result == REDUCE) { pop @stack; last; } elsif ($result == REJECT) { $self->warning($stack[-1]->error(), $name, $$line); pop @stack; } elsif (@stack == 1) { $self->warning("unexpected $type", $name, $$line); last; } else { pop @stack; } } } continue { $$line += ($para =~ tr/\n//); $$line += ($gap =~ tr/\n//); } if ($verbatim) { while(@stack) { $verbatim =~ s/\s+$//s; $result = $stack[-1]->add($self, 'verbatim', $verbatim); if (! defined $result) { $self->warning($stack[-1]->error(), $name, $$line); undef $verbatim; last; } elsif (ref $result) { push(@stack, $result); undef $verbatim; last; } elsif ($result == REDUCE) { pop @stack; undef $verbatim; last; } elsif ($result == REJECT) { $self->warning($stack[-1]->error(), $name, $$line); pop @stack; } elsif (@stack == 1) { $self->warning("unexpected $type", $name, $$line); undef $verbatim; last; } else { pop @stack; } } } return $stack[0]; } #------------------------------------------------------------------------ # parse_sequence($text) # # Parse a text paragraph to identify internal sequences (e.g. B) # which may be nested within each other. Returns a simple scalar (no # embedded sequences) or a reference to a Pod::POM::Text object. #------------------------------------------------------------------------ sub parse_sequence { my ($self, $text) = @_; my ($cmd, $lparen, $rparen, $plain); my ($name, $line, $warn) = @$self{ qw( FILENAME LINE WARNINGS ) }; my @stack; push(@stack, [ '', '', 'EOF', $name, $line, [ ] ] ); while ($text =~ / (?: ([A-Z]) (< (?:<+\s)?) ) # open | ( (?:\s>+)? > ) # or close | (?: (.+?) # or text... (?= # ...up to (?: [A-Z]< ) # open | (?: (?: \s>+)? > ) # or close | $ # or EOF ) ) /gxs) { if (defined $1) { ($cmd, $lparen) = ($1, $2); $lparen =~ s/\s$//; ($rparen = $lparen) =~ tr//; push(@stack, [ $cmd, $lparen, $rparen, $name, $line, [ ] ]); } elsif (defined $3) { $rparen = $3; $rparen =~ s/^\s+//; if ($rparen eq $stack[-1]->[RPAREN]) { $cmd = $TEXTSEQ->new(pop(@stack)) || return $self->error($TEXTSEQ->error()); push(@{ $stack[-1]->[CONTENT] }, $cmd); } else { $self->warning((scalar @stack > 1 ? "expected '$stack[-1]->[RPAREN]' not '$rparen'" : "spurious '$rparen'"), $name, $line); push(@{ $stack[-1]->[CONTENT] }, $rparen); } } elsif (defined $4) { $plain = $4; push(@{ $stack[-1]->[CONTENT] }, $plain); $line += ($plain =~ tr/\n//); } else { $self->warning("unexpected end of input", $name, $line); last; } } while (@stack > 1) { $cmd = pop @stack; $self->warning("unterminated '$cmd->[CMD]$cmd->[LPAREN]' starting", $name, $cmd->[LINE]); $cmd = $TEXTSEQ->new($cmd) || $self->error($TEXTSEQ->error()); push(@{ $stack[-1]->[CONTENT] }, $cmd); } return $TEXTSEQ->new(pop(@stack)) || $self->error($TEXTSEQ->error()); } #------------------------------------------------------------------------ # default_view($viewer) # # Accessor method to return or update the $DEFVIEW package variable, # loading the module for any package name specified. #------------------------------------------------------------------------ sub default_view { my ($self, $viewer) = @_; return $DEFAULT_VIEW unless $viewer; unless (ref $viewer) { my $file = $viewer; $file =~ s[::][/]g; $file .= '.pm'; eval { require $file }; return $self->error($@) if $@; } return ($DEFAULT_VIEW = $viewer); } #------------------------------------------------------------------------ # warning($msg, $file, $line) # # Appends a string of the form " at $file line $line" to $msg if # $file is specified and then stores $msg in the internals # WARNINGS list. If the WARN option is set then the warning is # raised, either via warn(), or by dispatching to a subroutine # when WARN is defined as such. #------------------------------------------------------------------------ sub warning { my ($self, $msg, $file, $line) = @_; my $warn = $self->{ WARN }; $line = 'unknown' unless defined $line && length $line; $msg .= " at $file line $line" if $file; push(@{ $self->{ WARNINGS } }, $msg); if (ref $warn eq 'CODE') { &$warn($msg); } elsif ($warn) { warn($msg, "\n"); } } #------------------------------------------------------------------------ # warnings() # # Returns a reference to the (possibly empty) list of warnings raised by # the most recent call to any of the parse_XXX() methods #------------------------------------------------------------------------ sub warnings { my $self = shift; return wantarray ? @{ $self->{ WARNINGS } } : $self->{ WARNINGS }; } #------------------------------------------------------------------------ # error($msg) # # Sets the internal ERROR member and returns undef when called with an # argument(s), returns the current value when called without. #------------------------------------------------------------------------ sub error { my $self = shift; my $errvar; { no strict qw( refs ); if (ref $self) { $errvar = \$self->{ ERROR }; } else { $errvar = \${"$self\::ERROR"}; } } if (@_) { $$errvar = ref($_[0]) ? shift : join('', @_); return undef; } else { return $$errvar; } } sub DEBUG { print STDERR "DEBUG: ", @_ if $DEBUG; } 1; __END__ =head1 NAME Pod::POM - POD Object Model =head1 SYNOPSIS use Pod::POM; my $parser = Pod::POM->new(\%options); # parse from a text string my $pom = $parser->parse_text($text) || die $parser->error(); # parse from a file specified by name or filehandle my $pom = $parser->parse_file($file) || die $parser->error(); # parse from text or file my $pom = $parser->parse($text_or_file) || die $parser->error(); # examine any warnings raised foreach my $warning ($parser->warnings()) { warn $warning, "\n"; } # print table of contents using each =head1 title foreach my $head1 ($pom->head1()) { print $head1->title(), "\n"; } # print each section foreach my $head1 ($pom->head1()) { print $head1->title(), "\n"; print $head1->content(); } # print the entire document as HTML use Pod::POM::View::HTML; print Pod::POM::View::HTML->print($pom); # create custom view package My::View; use base qw( Pod::POM::View::HTML ); sub view_head1 { my ($self, $item) = @_; return '

      ', $item->title->present($self), "

      \n", $item->content->present($self); } package main; print My::View->print($pom); =head1 DESCRIPTION This module implements a parser to convert Pod documents into a simple object model form known hereafter as the Pod Object Model. The object model is generated as a hierarchical tree of nodes, each of which represents a different element of the original document. The tree can be walked manually and the nodes examined, printed or otherwise manipulated. In addition, Pod::POM supports and provides view objects which can automatically traverse the tree, or section thereof, and generate an output representation in one form or another. Let's look at a typical Pod document by way of example. =head1 NAME My::Module - just another My::Module =head1 DESCRIPTION This is My::Module, a deeply funky piece of Perl code. =head2 METHODS My::Module implements the following methods =over 4 =item new(\%config) This is the constructor method. It accepts the following configuration options: =over 4 =item name The name of the thingy. =item colour The colour of the thingy. =back =item print() This prints the thingy. =back =head1 AUTHOR My::Module was written by me Eme@here.orgE This document contains 3 main sections, NAME, DESCRIPTION and AUTHOR, each of which is delimited by an opening C<=head1> tag. NAME and AUTHOR each contain only a single line of text, but DESCRIPTION is more interesting. It contains a line of text followed by the C<=head2> subsection, METHODS. This contains a line of text and a list extending from the C<=over 4> to the final C<=back> just before the AUTHOR section starts. The list contains 2 items, C, which itself contains some text and a list of 2 items, and C. Presented as plain text and using indentation to indicate the element nesting, the model then looks something like this : NAME My::Module - just another My::Module DESCRIPTION This is My::Module, a deeply funky piece of Perl code. METHODS My::Module implements the following methods * new(\%config) This is the constructor method. It accepts the following configuration options: * name The name of the thingy. * colour The colour of the thingy. * item print() This prints the thingy. AUTHOR My::Myodule was written by me Those of you familiar with XML may prefer to think of it in the following way:

      My::Module - just another My::Module

      This is My::Module, a deeply funky piece of Perl code.

      My::Module implements the following methods

      This is the constructor method. It accepts the following configuration options:

      The name of the thingy.

      The colour of the thingy.

      This prints the thingy.

      My::Myodule was written by me <me@here.org> Notice how we can make certain assumptions about various elements. For example, we can assume that any C<=head1> section we find begins a new section and implicitly ends any previous section. Similarly, we can assume an C<=item> ends when the next one begins, and so on. In terms of the XML example shown above, we are saying that we're smart enough to add a C/head1E> element to terminate any previously opened Chead1E> when we find a new C<=head1> tag in the input document. However you like to visualise the content, it all comes down to the same underlying model. The job of the Pod::POM module is to read an input Pod document and build an object model to represent it in this structured form. Each node in the tree (i.e. element in the document) is represented by a Pod::POM::Node::* object. These encapsulate the attributes for an element (such as the title for a C<=head1> tag) and also act as containers for further Pod::POM::Node::* objects representing the content of the element. Right down at the leaf nodes, we have simple object types to represent formatted and verbatim text paragraphs and other basic elements like these. =head2 Parsing Pod The Pod::POM module implements the methods parse_file($file), parse_text($text) and parse($file_or_text) to parse Pod files and input text. They return a Pod::POM::Node::Pod object to represent the root of the Pod Object Model, effectively the CpodE> element in the XML tree shown above. use Pod::POM; my $parser = Pod::POM->new(); my $pom = $parser->parse_file($filename) || die $parser->error(); The parse(), parse_text() and parse_file() methods return undef on error. The error() method can be called to retrieve the error message generated. Parsing a document may also generate non-fatal warnings. These can be retrieved via the warnings() method which returns a reference to a list when called in scalar context or a list of warnings when called in list context. foreach my $warn ($parser->warnings()) { warn $warn, "\n"; } Alternatively, the 'warn' configuration option can be set to have warnings automatically raised via C as they are encountered. my $parser = Pod::POM->new( warn => 1 ); =head2 Walking the Object Model Having parsed a document into an object model, we can then select various items from it. Each node implements methods (via AUTOLOAD) which correspond to the attributes and content elements permitted within in. So to fetch the list of '=head1' sections within our parsed document, we would do the following: my $sections = $pom->head1(); Methods like this will return a list of further Pod::POM::Node::* objects when called in list context or a reference to a list when called in scalar context. In the latter case, the list is blessed into the Pod::POM::Node::Content class which gives it certain magical properties (more on that later). Given the list of Pod::POM::Node::Head1 objects returned by the above, we can print the title attributes of each like this: foreach my $s (@$sections) { print $s->title(); } Let's look at the second section, DESCRIPTION. my $desc = $sections->[1]; We can print the title of each subsection within it: foreach my $ss ($desc->head2()) { print $ss->title(); } Hopefully you're getting the idea by now, so here's a more studly example to print the title for each item contained in the first list within the METHODS section: foreach my $item ($desc->head2->[0]->over->[0]->item) { print $item->title(), "\n"; } =head2 Element Content This is all well and good if you know the precise structure of a document in advance. For those more common cases when you don't, each node that can contain other nodes provides a 'content' method to return a complete list of all the other nodes that it contains. The 'type' method can be called on any node to return its element type (e.g. 'head1', 'head2', 'over', item', etc). foreach my $item ($pom->content()) { my $type = $item->type(); if ($type eq 'head1') { ... } elsif ($type eq 'head2') { ... } ... } The content for an element is represented by a reference to a list, blessed into the Pod::POM::Node::Content class. This provides some magic in the form of an overloaded stringification operator which will automatically print the contents of the list if you print the object itself. In plain English, or rather, in plain Perl, this means you can do things like the following: foreach my $head1 ($pom->head1()) { print '

      ', $head1->title(), "

      \n\n"; print $head1->content(); } # print all the root content foreach my $item ($pom->content()) { print $item; } # same as above print $pom->content(); In fact, all Pod::POM::Node::* objects provide this same magic, and will attempt to Do The Right Thing to present themselves in the appropriate manner when printed. Thus, the following are all valid. print $pom; # entire document print $pom->content; # content of document print $pom->head1->[0]; # just first section print $pom->head1; # print all sections foreach my $h1 ($pom->head1()) { print $h1->head2(); # print all subsections } =head2 Output Views To understand how the different elements go about presenting themselves in "the appropriate manner", we must introduce the concept of a view. A view is quite simply a particular way of looking at the model. In real terms, we can think of a view as being some kind of output type generated by a pod2whatever converter. Notionally we can think in terms of reading in an input document, building a Pod Object Model, and then generating an HTML view of the document, and/or a LaTeX view, a plain text view, and so on. A view is represented in this case by an object class which contains methods for displaying each of the different element types that could be encountered in any Pod document. There's a method for displaying C<=head1> sections (view_head1()), another method for displaying C<=head2> sections (view_head2()), one for C<=over> (view_over()), another for C<=item> (view_item()) and so on. If we happen to have a reference to a $node and we know it's a 'head1' node, then we can directly call the right view method to have it displayed properly: $view = 'Pod::POM::View::HTML'; $view->view_head1($node); Thus our earlier example can be modified to be I less laborious and I more flexible. foreach my $node ($pom->content) { my $type = $node->type(); if ($type eq 'head1') { print $view->view_head1($node); } elsif ($type eq 'head2') { print $view->view_head2($node); } ... } However, this is still far from ideal. To make life easier, each Pod::POM::Node::* class inherits (or possibly redefines) a C method from the Pod::POM::Node base class. This method expects a reference to a view object passed as an argument, and it simply calls the appropriate view_xxx() method on the view object, passing itself back as an argument. In object parlance, this is known as "double dispatch". The beauty of it is that you don't need to know what kind of node you have to be able to print it. You simply pass it a view object and leave it to work out the rest. foreach my $node ($pom->content) { print $node->present($view); } If $node is a Pod::POM::Node::Head1 object, then the view_head1($node) method gets called against the $view object. Otherwise, if it's a Pod::POM::Node::Head2 object, then the view_head2($node) method is dispatched. And so on, and so on, with each node knowing what it is and where it's going as if determined by some genetically pre-programmed instinct. Fullfilling their destinies, so to speak. Double dispatch allows us to do away with all the explicit type checking and other nonsense and have the node objects themselves worry about where they should be routed to. At the cost of an extra method call per node, we get programmer convenience, and that's usually a Good Thing. Let's have a look at how the view and node classes might be implemented. package Pod::POM::View::HTML; sub view_pod { my ($self, $node) = @_; return $node->content->present($self); } sub view_head1 { my ($self, $node) = @_; return "

      ", $node->title->present($self), "

      \n\n" . $node->content->present($self); } sub view_head2 { my ($self, $node) = @_; return "

      ", $node->title->present($self), "

      \n\n" . $node->content->present($self); } ... package Pod::POM::Node::Pod; sub present { my ($self, $view) = @_; $view->view_pod($self); } package Pod::POM::Node::Head1; sub present { my ($self, $view) = @_; $view->view_head1($self); } package Pod::POM::Node::Head2; sub present { my ($self, $view) = @_; $view->view_head2($self); } ... Some of the view_xxx methods make calls back against the node objects to display their attributes and/or content. This is shown in, for example, the view_head1() method above, where the method prints the section title in Ch1E>...Ch1E> tags, followed by the remaining section content. Note that the title() attribute is printed by calling its present() method, passing on the reference to the current view. Similarly, the content present() method is called giving it a chance to Do The Right Thing to present itself correctly via the view object. There's a good chance that the title attribute is going to be regular text, so we might be tempted to simply print the title rather than call its present method. sub view_head1 { my ($self, $node) = @_; # not recommended, prefer $node->title->present($self) return "

      ", $node->title(), "

      \n\n", ... } However, it is entirely valid for titles and other element attributes, as well as regular, formatted text blocks to contain code sequences, such like CthisE> and CthisE>. These are used to indicate different markup styles, mark external references or index items, and so on. What's more, they can be Cnested IEindefinitelyEE>. Pod::POM takes care of all this by parsing such text, along with any embedded sequences, into Yet Another Tree, the root node of which is a Pod::POM::Node::Text object, possibly containing other Pod::POM::Node::Sequence objects. When the text is presented, the tree is automatically walked and relevant callbacks made against the view for the different sequence types. The methods called against the view are all prefixed 'view_seq_', e.g. 'view_seq_bold', 'view_seq_italic'. Now the real magic comes into effect. You can define one view to render bold/italic text in one style: package My::View::Text; use base qw( Pod::POM::View::Text ); sub view_seq_bold { my ($self, $text) = @_; return "*$text*"; } sub view_seq_italic { my ($self, $text) = @_; return "_$text_"; } And another view to render it in a different style: package My::View::HTML; use base qw( Pod::POM::View::HTML ); sub view_seq_bold { my ($self, $text) = @_; return "$text"; } sub view_seq_italic { my ($self, $text) = @_; return "$text"; } Then, you can easily view a Pod Object Model in either style: my $text = 'My::View::Text'; my $html = 'My::View::HTML'; print $pom->present($text); print $pom->present($html); And you can apply this technique to any node within the object model. print $pom->head1->[0]->present($text); print $pom->head1->[0]->present($html); In these examples, the view passed to the present() method has been a class name. Thus, the view_xxx methods get called as class methods, as if written: My::View::Text->view_head1(...); If your view needs to maintain state then you can create a view object and pass that to the present() method. my $view = My::View->new(); $node->present($view); In this case the view_xxx methods get called as object methods. sub view_head1 { my ($self, $node) = @_; my $title = $node->title(); if ($title eq 'NAME' && ref $self) { $self->{ title } = $title(); } $self->SUPER::view_head1($node); } Whenever you print a Pod::POM::Node::* object, or do anything to cause Perl to stringify it (such as including it another quoted string "like $this"), then its present() method is automatically called. When called without a view argument, the present() method uses the default view specified in $Pod::POM::DEFAULT_VIEW, which is, by default, 'Pod::POM::View::Pod'. This view regenerates the original Pod document, although it should be noted that the output generated may not be exactly the same as the input. The parser is smart enough to detect some common errors (e.g. not terminating an C<=over> with a C<=back>) and correct them automatically. Thus you might find a C<=back> correctly placed in the output, even if you forgot to add it to the input. Such corrections raise non-fatal warnings which can later be examined via the warnings() method. You can update the $Pod::POM::DEFAULT_VIEW package variable to set the default view, or call the default_view() method. The default_view() method will automatically load any package you specify. If setting the package variable directly, you should ensure that any packages required have been pre-loaded. use My::View::HTML; $Pod::POM::DEFAULT_VIEW = 'My::View::HTML'; or Pod::POM->default_view('My::View::HTML'); =head2 Template Toolkit Views One of the motivations for writing this module was to make it easier to customise Pod documentation to your own look and feel or local formatting conventions. By clearly separating the content (represented by the Pod Object Model) from the presentation style (represented by one or more views) it becomes much easier to achieve this. The latest version of the Template Toolkit (2.06 at the time of writing) provides a Pod plugin to interface to this module. It also implements a new (but experimental) VIEW directive which can be used to build different presentation styles for converting Pod to other formats. The Template Toolkit is available from CPAN: http://www.cpan.org/modules/by-module/Template/ Template Toolkit views are similar to the Pod::POM::View objects described above, except that they allow the presentation style for each Pod component to be written as a template file or block rather than an object method. The precise syntax and structure of the VIEW directive is subject to change (given that it's still experimental), but at present it can be used to define a view something like this: [% VIEW myview %] [% BLOCK view_head1 %]

      [% item.title.present(view) %]

      [% item.content.present(view) %] [% END %] [% BLOCK view_head2 %]

      [% item.title.present(view) %]

      [% item.content.present(view) %] [% END %] ... [% END %] A plugin is provided to interface to the Pod::POM module: [% USE pod %] [% pom = pod.parse('/path/to/podfile') %] The returned Pod Object Model instance can then be navigated and presented via the view in almost any way imaginable:

      Table of Contents

        [% FOREACH section = pom.head1 %]
      • [% section.title.present(view) %] [% END %]
      [% FOREACH section = pom.head1 %] [% section.present(myview) %] [% END %] You can either pass a reference to the VIEW (myview) to the present() method of a Pod::POM node: [% pom.present(myview) %] # present entire document Or alternately call the print() method on the VIEW, passing the Pod::POM node as an argument: [% myview.print(pom) %] Internally, the view calls the present() method on the node, passing itself as an argument. Thus it is equivalent to the previous example. The Pod::POM node and the view conspire to "Do The Right Thing" to process the right template block for the node. A reference to the node is available within the template as the 'item' variable. [% BLOCK view_head2 %]

      [% item.title.present(view) %]

      [% item.content.present(view) %] [% END %] The Template Toolkit documentation contains further information on defining and using views. However, as noted above, this may be subject to change or incomplete pending further development of the VIEW directive. =head1 METHODS =head2 new(\%config) Constructor method which instantiates and returns a new Pod::POM parser object. use Pod::POM; my $parser = Pod::POM->new(); A reference to a hash array of configuration options may be passed as an argument. my $parser = Pod::POM->new( { warn => 1 } ); For convenience, configuration options can also be passed as a list of (key =E value) pairs. my $parser = Pod::POM->new( warn => 1 ); The following configuration options are defined: =over 4 =item code This option can be set to have all non-Pod parts of the input document stored within the object model as 'code' elements, represented by objects of the Pod::POM::Node::Code class. It is disabled by default and code sections are ignored. my $parser = Pod::POM->new( code => 1 ); my $podpom = $parser->parse(\*DATA); foreach my $code ($podpom->code()) { print "
      $code
      \n"; } __DATA__ This is some program code. =head1 NAME ... This will generate the output: 
      This is some program code.
      Note that code elements are stored within the POM element in which they are encountered. For example, the code element below embedded within between Pod sections is stored in the array which can be retrieved by calling C<$podpom-Ehead1-E[0]-Ecode()>. =head1 NAME My::Module::Name; =cut Some program code embedded in Pod. =head1 SYNOPSIS ... =item warn Non-fatal warnings encountered while parsing a Pod document are stored internally and subsequently available via the warnings() method. my $parser = Pod::POM->new(); my $podpom = $parser->parse_file($filename); foreach my $warning ($parser->warnings()) { warn $warning, "\n"; } The 'warn' option can be set to have warnings raised automatically via C as and when they are encountered. my $parser = Pod::POM->new( warn => 1 ); my $podpom = $parser->parse_file($filename); If the configuration value is specified as a subroutine reference then the code will be called each time a warning is raised, passing the warning message as an argument. sub my_warning { my $msg = shift; warn $msg, "\n"; }; my $parser = Pod::POM->new( warn => \&my_warning ); my $podpom = $parser->parse_file($filename); =item meta The 'meta' option can be set to allow C<=meta> tags within the Pod document. my $parser = Pod::POM->new( meta => 1 ); my $podpom = $parser->parse_file($filename); This is an experimental feature which is not part of standard POD. For example: =meta author Andy Wardley These are made available as metadata items within the root node of the parsed POM. my $author = $podpom->metadata('author'); See the L section below for further information. =back =head2 parse_file($file) Parses the file specified by name or reference to a file handle. Returns a reference to a Pod::POM::Node::Pod object which represents the root node of the Pod Object Model on success. On error, undef is returned and the error message generated can be retrieved by calling error(). my $podpom = $parser->parse_file($filename) || die $parser->error(); my $podpom = $parser->parse_file(\*STDIN) || die $parser->error(); Any warnings encountered can be examined by calling the warnings() method. foreach my $warn ($parser->warnings()) { warn $warn, "\n"; } =head2 parse_text($text) Parses the Pod text string passed as an argument into a Pod Object Model, as per parse_file(). =head2 parse($text_or_$file) General purpose method which attempts to Do The Right Thing in calling parse_file() or parse_text() according to the argument passed. A hash reference can be passed as an argument that contains a 'text' or 'file' key and corresponding value. my $podpom = $parser->parse({ file => $filename }) || die $parser->error(); Otherwise, the argument can be a reference to an input handle which is passed off to parse_file(). my $podpom = $parser->parse(\*DATA) || die $parser->error(); If the argument is a text string that looks like Pod text (i.e. it contains '=' at the start of any line) then it is passed to parse_text(). my $podpom = $parser->parse($podtext) || die $parser->error(); Otherwise it is assumed to be a filename and is passed to parse_file(). my $podpom = $parser->parse($podfile) || die $parser->error(); =head1 NODE TYPES, ATTRIBUTES AND ELEMENTS This section lists the different nodes that may be present in a Pod Object Model. These are implemented as Pod::POM::Node::* object instances (e.g. head1 =E Pod::POM::Node::Head1). To present a node, a view should implement a method which corresponds to the node name prefixed by 'view_' (e.g. head1 =E view_head1()). =over 4 =item pod The C node is used to represent the root node of the Pod Object Model. Content elements: head1, head2, head3, head4, over, begin, for, verbatim, text, code. =item head1 A C node contains the Pod content from a C<=head1> tag up to the next C<=head1> tag or the end of the file. Attributes: title Content elements: head2, head3, head4, over, begin, for, verbatim, text, code. =item head2 A C node contains the Pod content from a C<=head2> tag up to the next C<=head1> or C<=head2> tag or the end of the file. Attributes: title Content elements: head3, head4, over, begin, for, verbatim, text, code. =item head3 A C node contains the Pod content from a C<=head3> tag up to the next C<=head1>, C<=head2> or C<=head3> tag or the end of the file. Attributes: title Content elements: head4, over, begin, for, verbatim, text, code. =item head4 A C node contains the Pod content from a C<=head4> tag up to the next C<=head1>, C<=head2>, C<=head3> or C<=head4> tag or the end of the file. Attributes: title Content elements: over, begin, for, verbatim, text, code. =item over The C node encloses the Pod content in a list starting at an C<=over> tag and continuing up to the matching C<=back> tag. Lists may be nested indefinitely. Attributes: indent (default: 4) Content elements: over, item, begin, for, verbatim, text, code. =item item The C node encloses the Pod content in a list item starting at an C<=item> tag and continuing up to the next C<=item> tag or a C<=back> tag which terminates the list. Attributes: title (default: *) Content elements: over, begin, for, verbatim, text, code. =item begin A C node encloses the Pod content in a conditional block starting with a C<=begin> tag and continuing up to the next C<=end> tag. Attributes: format Content elements: verbatim, text, code. =item for A C node contains a single paragraph containing text relevant to a particular format. Attributes: format, text =item verbatim A C node contains a verbatim text paragraph which is prefixed by whitespace in the source Pod document (i.e. indented). Attributes: text =item text A C node contains a regular text paragraph. This may include embedded inline sequences. Attributes: text =item code A C node contains Perl code which is by default, not considered to be part of a Pod document. The C configuration option must be set for Pod::POM to generate code blocks, otherwise they are ignored. Attributes: text =back =head1 INLINE SEQUENCES Embedded sequences are permitted within regular text blocks (i.e. not verbatim) and title attributes. To present these sequences, a view should implement methods corresponding to the sequence name, prefixed by 'view_seq_' (e.g. bold =E view_seq_bold()). =over 4 =item code Code extract, e.g. CEmy codeE =item bold Bold text, e.g. BEbold textE =item italic Italic text, e.g. IEitalic textE =item link A link (cross reference), e.g. LEMy::ModuleE =item space Text contains non-breaking space, e.g.SEBuffy The Vampire SlayerE =item file A filename, e.g. FE/etc/lilo.confE =item index An index entry, e.g. XEAngelE =item zero A zero-width character, e.g. ZEE =item entity An entity escape, e.g. EEltE =back =head1 BUNDLED MODULES AND TOOLS The Pod::POM module distribution includes a number of sample view objects for rendering Pod Object Models into particular formats. These are incomplete and may require some further work, but serve at present to illustrate the principal and can be used as the basis for your own view objects. =over 4 =item Pod::POM::View::Pod Regenerates the model as Pod. =item Pod::POM::View::Text Presents the model as plain text. =item Pod::POM::View::HTML Presents the model as HTML. =back A script is provided for converting Pod documents to other format by using the view objects provided. The C script should be called with two arguments, the first specifying the output format, the second the input filename. e.g. $ pom2 text My/Module.pm > README $ pom2 html My/Module.pm > ~/public_html/My/Module.html You can also create symbolic links to the script if you prefer and leave it to determine the output format from its own name. $ ln -s pom2 pom2text $ ln -s pom2 pom2html $ pom2text My/Module.pm > README $ pom2html My/Module.pm > ~/public_html/My/Module.html The distribution also contains a trivial script, C (previously C), which checks a Pod document for well-formedness by simply parsing it into a Pod Object Model with warnings enabled. Warnings are printed to STDERR. $ podlint My/Module.pm The C<-f> option can be set to have the script attempt to fix any problems it encounters. The regenerated Pod output is printed to STDOUT. $ podlint -f My/Module.pm > newfile =head1 METADATA This module includes support for an experimental new C<=meta> tag. This is disabled by default but can be enabled by loading Pod::POM with the C option. use Pod::POM qw( meta ); Alternately, you can specify the C option to be any true value when you instantiate a Pod::POM parser: my $parser = Pod::POM->new( meta => 1 ); my $pom = $parser->parse_file($filename); Any C<=meta> tags in the document will be stored as metadata items in the root node of the Pod model created. For example: =meta module Foo::Bar =meta author Andy Wardley You can then access these items via the metadata() method. print "module: ", $pom->metadata('module'), "\n"; print "author: ", $pom->metadata('author'), "\n"; or my $metadata = $pom->metadata(); print "module: $metadata->{ module }\n"; print "author: $metadata->{ author }\n"; Please note that this is an experimental feature which is not supported by other POD processors and is therefore likely to be most incompatible. Use carefully. =head1 AUTHOR Andy Wardley Eabw@kfs.orgE Andrew Ford EA.Ford@ford-mason.co.ukE (co-maintainer as of 03/2009) =head1 VERSION This is version 0.28 of the Pod::POM module. =head1 COPYRIGHT Copyright (C) 2000-2009 Andy Wardley. All Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO For the definitive reference on Pod, see L. For an overview of Pod::POM internals and details relating to subclassing of POM nodes, see L. There are numerous other fine Pod modules available from CPAN which perform conversion from Pod to other formats. In many cases these are likely to be faster and quite possibly more reliable and/or complete than this module. But as far as I know, there aren't any that offer the same kind of flexibility in being able to customise the generated output. But don't take my word for it - see your local CPAN site for further details: http://www.cpan.org/modules/by-module/Pod/ =cut