diff -Nru libpod-pom-perl-0.24/Changes libpod-pom-perl-0.27/Changes --- libpod-pom-perl-0.24/Changes 2009-03-21 10:18:17.000000000 +0000 +++ libpod-pom-perl-0.27/Changes 2010-04-02 14:37:41.000000000 +0100 @@ -10,10 +10,49 @@ # Andrew Ford # #------------------------------------------------------------------------ -# $Id: Changes 67 2009-03-21 10:18:17Z ford $ +# $Id: Changes 88 2010-04-02 13:37:41Z ford $ #======================================================================== #------------------------------------------------------------------------ +# 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 #------------------------------------------------------------------------ diff -Nru libpod-pom-perl-0.24/debian/changelog libpod-pom-perl-0.27/debian/changelog --- libpod-pom-perl-0.24/debian/changelog 2010-05-09 20:12:47.000000000 +0100 +++ libpod-pom-perl-0.27/debian/changelog 2010-04-03 19:34:17.000000000 +0100 @@ -1,3 +1,35 @@ +libpod-pom-perl (0.27-1) unstable; urgency=low + + [ Jonathan Yu ] + * New upstream release + * Standards-Version 3.8.4 (no changes) + * Use new short debhelper rules format + * Use new DEP5 copyright format + * Update to 3.0 (quilt) source format + * Rewrite control description + * Add myself to Uploaders + * Update copyright information + * Refresh POD whatis patch + * Do not install Pod::POM::Node::* manpages, as there is little + documentation contained in them + + [ Ryan Niebur ] + * New upstream release + * add copyright information for t/YAML/Tiny.pm + * drop build dependency on libyaml-perl + * fix my patch.. + * forwarded patch + * remove my patch, it's applied upstream in verion 0.26 + * Update ryan52's email address + + [ Nathan Handler ] + * debian/watch: Update to ignore development releases. + + [ gregor herrmann ] + * debian/copyright: add info about new third-party test file. + + -- Jonathan Yu Sat, 03 Apr 2010 01:25:15 -0400 + libpod-pom-perl (0.24-1) unstable; urgency=low [ Ryan Niebur ] diff -Nru libpod-pom-perl-0.24/debian/control libpod-pom-perl-0.27/debian/control --- libpod-pom-perl-0.24/debian/control 2010-05-09 20:12:47.000000000 +0100 +++ libpod-pom-perl-0.27/debian/control 2010-04-03 14:37:44.000000000 +0100 @@ -1,26 +1,25 @@ Source: libpod-pom-perl Section: perl Priority: optional +Build-Depends: debhelper (>= 7.0.50) +Build-Depends-Indep: perl, libtest-differences-perl, libfile-slurp-perl, + perl (>= 5.10.1) | libparent-perl Maintainer: Debian Perl Group Uploaders: Gunnar Wolf , gregor herrmann , - Ryan Niebur -Build-Depends: debhelper (>= 7), quilt -Build-Depends-Indep: libtest-differences-perl, libfile-slurp-perl, libyaml-perl -Standards-Version: 3.8.1 + Ryan Niebur , Jonathan Yu +Standards-Version: 3.8.4 Homepage: http://search.cpan.org/dist/Pod-POM/ Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libpod-pom-perl/ Vcs-Browser: http://svn.debian.org/viewsvn/pkg-perl/trunk/libpod-pom-perl/ Package: libpod-pom-perl Architecture: all -Depends: ${misc:Depends}, ${perl:Depends} -Description: Perl module of POD Object Model - Pod::POM implements a parser to convert Pod documents into a simple - object model called 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. +Depends: ${misc:Depends}, ${perl:Depends}, perl (>= 5.10.1) | libparent-perl +Description: module providing a Pod Object Model + Pod::POM is a Perl Pod document parser that exposes an object model called + 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. Pod::POM also provides view objects, which can automatically + traverse the tree, or section thereof, and generate an output representation + in one form or another. diff -Nru libpod-pom-perl-0.24/debian/copyright libpod-pom-perl-0.27/debian/copyright --- libpod-pom-perl-0.24/debian/copyright 2010-05-09 20:12:47.000000000 +0100 +++ libpod-pom-perl-0.27/debian/copyright 2010-04-03 19:34:01.000000000 +0100 @@ -1,36 +1,43 @@ -Format-Specification: - http://wiki.debian.org/Proposals/CopyrightFormat?action=recall&rev=196 -Upstream-Maintainer: Andrew Ford -Upstream-Source: http://search.cpan.org/dist/Pod-POM/ -Upstream-Name: Pod-POM +Format-Specification: http://svn.debian.org/wsvn/dep/web/deps/dep5.mdwn?op=file&rev=135 +Maintainer: Andrew Ford +Source: http://search.cpan.org/dist/Pod-POM/ +Name: Pod-POM Files: * -Copyright: 2000-2002, Andy Wardley - 2009, Andrew Ford -License-Alias: Perl -License: Artistic | GPL-1+ - -Files: inc/* -Copyright: Copyright 2002 - 2009 by Brian Ingerson, Audrey Tang and Adam Kennedy -License-Alias: Perl -License: GPL-1+ | Artistic +Copyright: 2009-2010, Andrew Ford + 2000-2009, Andy Wardley +License: Artistic or GPL-1+ + +Files: t/YAML/Tiny.pm +Copyright: 2006-2009, Adam Kennedy +License: Artistic or GPL-1+ + +Files: inc/Module/* +Copyright: 2002-2010, Adam Kennedy + 2002-2010, Audrey Tang + 2002-2010, Brian Ingerson +License: Artistic or GPL-1+ Files: debian/* -Copyright: +Copyright: 2010, Jonathan Yu + 2009, Ryan Niebur + 2009, gregor herrmann + 2007, Gunnar Wolf 2001-2006, Taku YASUI - 2007-2009, various members of the Debian Perl Group, cf. debian/changelog -License: Artistic | GPL-1+ +License: Artistic or GPL-1+ License: Artistic - This program is free software; you can redistribute it and/or modify - it under the terms of the Artistic License, which comes with Perl. - On Debian GNU/Linux systems, the complete text of the Artistic License - can be found in `/usr/share/common-licenses/Artistic' + This program is free software; you can redistribute it and/or modify + it under the terms of the Artistic License, which comes with Perl. + . + On Debian GNU/Linux systems, the complete text of the Artistic License + can be found in `/usr/share/common-licenses/Artistic' License: GPL-1+ - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 1, or (at your option) - any later version. - On Debian GNU/Linux systems, the complete text of the GNU General - Public License can be found in `/usr/share/common-licenses/GPL' + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 1, or (at your option) + any later version. + . + On Debian GNU/Linux systems, the complete text of the GNU General + Public License can be found in `/usr/share/common-licenses/GPL' diff -Nru libpod-pom-perl-0.24/debian/patches/fix-pod2man-errors libpod-pom-perl-0.27/debian/patches/fix-pod2man-errors --- libpod-pom-perl-0.24/debian/patches/fix-pod2man-errors 2010-05-09 20:12:47.000000000 +0100 +++ libpod-pom-perl-0.27/debian/patches/fix-pod2man-errors 1970-01-01 01:00:00.000000000 +0100 @@ -1,13 +0,0 @@ -fix teh syntax - ---- a/lib/Pod/POM/Constants.pm -+++ b/lib/Pod/POM/Constants.pm -@@ -63,7 +63,7 @@ - - =head1 AUTHOR - --Andy Wardley Eabw@kfs.orgE -+Andy Wardley - - =head1 COPYRIGHT AND LICENSE - diff -Nru libpod-pom-perl-0.24/debian/patches/series libpod-pom-perl-0.27/debian/patches/series --- libpod-pom-perl-0.24/debian/patches/series 2010-05-09 20:12:47.000000000 +0100 +++ libpod-pom-perl-0.27/debian/patches/series 2009-04-08 15:42:07.000000000 +0100 @@ -1,2 +1 @@ -fix-pod2man-errors whatis-entries diff -Nru libpod-pom-perl-0.24/debian/patches/whatis-entries libpod-pom-perl-0.27/debian/patches/whatis-entries --- libpod-pom-perl-0.24/debian/patches/whatis-entries 2010-05-09 20:12:47.000000000 +0100 +++ libpod-pom-perl-0.27/debian/patches/whatis-entries 2010-04-03 14:37:43.000000000 +0100 @@ -2,7 +2,7 @@ --- a/lib/Pod/POM/Constants.pm +++ b/lib/Pod/POM/Constants.pm -@@ -55,7 +55,7 @@ +@@ -58,7 +58,7 @@ =head1 NAME @@ -24,7 +24,7 @@ --- a/lib/Pod/POM/View/HTML.pm +++ b/lib/Pod/POM/View/HTML.pm -@@ -406,7 +406,7 @@ +@@ -411,7 +411,7 @@ =head1 NAME diff -Nru libpod-pom-perl-0.24/debian/README.source libpod-pom-perl-0.27/debian/README.source --- libpod-pom-perl-0.24/debian/README.source 2010-05-09 20:12:47.000000000 +0100 +++ libpod-pom-perl-0.27/debian/README.source 1970-01-01 01:00:00.000000000 +0100 @@ -1,5 +0,0 @@ -This package uses quilt to manage all modifications to the upstream -source. Changes are stored in the source package as diffs in -debian/patches and applied during the build. - -See /usr/share/doc/quilt/README.source for a detailed explanation. diff -Nru libpod-pom-perl-0.24/debian/rules libpod-pom-perl-0.27/debian/rules --- libpod-pom-perl-0.24/debian/rules 2010-05-09 20:12:47.000000000 +0100 +++ libpod-pom-perl-0.27/debian/rules 2010-04-03 19:29:13.000000000 +0100 @@ -1,25 +1,11 @@ #!/usr/bin/make -f -include /usr/share/quilt/quilt.make +PACKAGE = $(shell dh_listpackages) +TMP = $(CURDIR)/debian/$(PACKAGE) -build: build-stamp -build-stamp: $(QUILT_STAMPFN) - dh build - touch $@ - -clean: unpatch - dh $@ - -install: install-stamp -install-stamp: build-stamp - dh install - touch $@ - -binary-arch: - -binary-indep: install +%: dh $@ -binary: binary-arch binary-indep - -.PHONY: binary binary-arch binary-indep install clean build +override_dh_auto_install: + dh_auto_install + rm $(TMP)/usr/share/man/man3/Pod::POM::Node::* diff -Nru libpod-pom-perl-0.24/debian/source/format libpod-pom-perl-0.27/debian/source/format --- libpod-pom-perl-0.24/debian/source/format 1970-01-01 01:00:00.000000000 +0100 +++ libpod-pom-perl-0.27/debian/source/format 2010-05-09 20:12:47.000000000 +0100 @@ -0,0 +1 @@ +3.0 (quilt) diff -Nru libpod-pom-perl-0.24/debian/watch libpod-pom-perl-0.27/debian/watch --- libpod-pom-perl-0.24/debian/watch 2010-05-09 20:12:47.000000000 +0100 +++ libpod-pom-perl-0.27/debian/watch 2009-06-06 13:08:05.000000000 +0100 @@ -1,2 +1,2 @@ version=3 -http://search.cpan.org/dist/Pod-POM/ .*/Pod-POM-v?(\d[\d_.]+)\.(?:tar(?:\.gz|\.bz2)?|tgz|zip)$ +http://search.cpan.org/dist/Pod-POM/ .*/Pod-POM-v?(\d[\d.]+)\.(?:tar(?:\.gz|\.bz2)?|tgz|zip)$ diff -Nru libpod-pom-perl-0.24/inc/Module/Install/Base.pm libpod-pom-perl-0.27/inc/Module/Install/Base.pm --- libpod-pom-perl-0.24/inc/Module/Install/Base.pm 2009-03-21 10:18:23.000000000 +0000 +++ libpod-pom-perl-0.27/inc/Module/Install/Base.pm 2010-04-02 14:38:00.000000000 +0100 @@ -1,7 +1,11 @@ #line 1 package Module::Install::Base; -$VERSION = '0.79'; +use strict 'vars'; +use vars qw{$VERSION}; +BEGIN { + $VERSION = '0.91'; +} # Suspend handler for "redefined" warnings BEGIN { @@ -9,54 +13,56 @@ $SIG{__WARN__} = sub { $w }; } -### This is the ONLY module that shouldn't have strict on -# use strict; - -#line 41 +#line 42 sub new { - my ($class, %args) = @_; - - foreach my $method ( qw(call load) ) { - *{"$class\::$method"} = sub { - shift()->_top->$method(@_); - } unless defined &{"$class\::$method"}; - } - - bless( \%args, $class ); + 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 { - my $self = shift; - local $@; - my $autoload = eval { $self->_top->autoload } or return; - goto &$autoload; + local $@; + my $func = eval { shift->_top->autoload } or return; + goto &$func; } -#line 76 +#line 75 -sub _top { $_[0]->{_top} } +sub _top { + $_[0]->{_top}; +} -#line 89 +#line 90 sub admin { - $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; + $_[0]->_top->{admin} + or + Module::Install::Base::FakeAdmin->new; } -#line 101 +#line 106 sub is_admin { - $_[0]->admin->VERSION; + $_[0]->admin->VERSION; } sub DESTROY {} package Module::Install::Base::FakeAdmin; -my $Fake; -sub new { $Fake ||= bless(\@_, $_[0]) } +my $fake; + +sub new { + $fake ||= bless(\@_, $_[0]); +} sub AUTOLOAD {} @@ -69,4 +75,4 @@ 1; -#line 146 +#line 154 diff -Nru libpod-pom-perl-0.24/inc/Module/Install/Can.pm libpod-pom-perl-0.27/inc/Module/Install/Can.pm --- libpod-pom-perl-0.24/inc/Module/Install/Can.pm 1970-01-01 01:00:00.000000000 +0100 +++ libpod-pom-perl-0.27/inc/Module/Install/Can.pm 2010-04-02 14:38:00.000000000 +0100 @@ -0,0 +1,81 @@ +#line 1 +package Module::Install::Can; + +use strict; +use Config (); +use File::Spec (); +use ExtUtils::MakeMaker (); +use Module::Install::Base (); + +use vars qw{$VERSION @ISA $ISCORE}; +BEGIN { + $VERSION = '0.91'; + @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 ''; + my $abs = File::Spec->catfile($dir, $_[1]); + return $abs if (-x $abs or $abs = MM->maybe_command($abs)); + } + + return; +} + +# 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 156 diff -Nru libpod-pom-perl-0.24/inc/Module/Install/Fetch.pm libpod-pom-perl-0.27/inc/Module/Install/Fetch.pm --- libpod-pom-perl-0.24/inc/Module/Install/Fetch.pm 1970-01-01 01:00:00.000000000 +0100 +++ libpod-pom-perl-0.27/inc/Module/Install/Fetch.pm 2010-04-02 14:38:00.000000000 +0100 @@ -0,0 +1,93 @@ +#line 1 +package Module::Install::Fetch; + +use strict; +use Module::Install::Base (); + +use vars qw{$VERSION @ISA $ISCORE}; +BEGIN { + $VERSION = '0.91'; + @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; diff -Nru libpod-pom-perl-0.24/inc/Module/Install/Makefile.pm libpod-pom-perl-0.27/inc/Module/Install/Makefile.pm --- libpod-pom-perl-0.24/inc/Module/Install/Makefile.pm 2009-03-21 10:18:23.000000000 +0000 +++ libpod-pom-perl-0.27/inc/Module/Install/Makefile.pm 2010-04-02 14:38:00.000000000 +0100 @@ -2,14 +2,14 @@ package Module::Install::Makefile; use strict 'vars'; -use Module::Install::Base; -use ExtUtils::MakeMaker (); +use ExtUtils::MakeMaker (); +use Module::Install::Base (); -use vars qw{$VERSION $ISCORE @ISA}; +use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '0.79'; + $VERSION = '0.91'; + @ISA = 'Module::Install::Base'; $ISCORE = 1; - @ISA = qw{Module::Install::Base}; } sub Makefile { $_[0] } @@ -114,17 +114,32 @@ my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; - # Make sure we have a new enough - require ExtUtils::MakeMaker; + # 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"; + } - # MakeMaker can complain about module versions that include - # an underscore, even though its own version may contain one! - # Hence the funny regexp to get rid of it. See RT #35800 - # for details. + # Make sure we have a new enough MakeMaker + require ExtUtils::MakeMaker; - $self->configure_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ ); + if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) { + # MakeMaker can complain about module versions that include + # an underscore, even though its own version may contain one! + # Hence the funny regexp to get rid of it. See RT #35800 + # for details. + $self->build_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ ); + $self->configure_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ ); + } 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.42 ); + $self->configure_requires( 'ExtUtils::MakeMaker' => 6.42 ); + } - # Generate the + # Generate the MakeMaker params my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name; @@ -133,7 +148,7 @@ if ( $self->tests ) { $args->{test} = { TESTS => $self->tests }; } - if ($] >= 5.005) { + if ( $] >= 5.005 ) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = $self->author; } @@ -147,7 +162,7 @@ delete $args->{SIGN}; } - # merge both kinds of requires into prereq_pm + # Merge both kinds of requires into prereq_pm my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } @@ -250,4 +265,4 @@ __END__ -#line 379 +#line 394 diff -Nru libpod-pom-perl-0.24/inc/Module/Install/MakeMaker.pm libpod-pom-perl-0.27/inc/Module/Install/MakeMaker.pm --- libpod-pom-perl-0.24/inc/Module/Install/MakeMaker.pm 2009-03-21 10:18:23.000000000 +0000 +++ libpod-pom-perl-0.27/inc/Module/Install/MakeMaker.pm 1970-01-01 01:00:00.000000000 +0100 @@ -1,50 +0,0 @@ -#line 1 -package Module::Install::MakeMaker; - -use strict; -use Module::Install::Base; -use ExtUtils::MakeMaker (); - -use vars qw{$VERSION $ISCORE @ISA}; -BEGIN { - $VERSION = '0.79'; - $ISCORE = 1; - @ISA = qw{Module::Install::Base}; -} - -my $makefile; - -sub WriteMakefile { - my ($self, %args) = @_; - $makefile = $self->load('Makefile'); - - # mapping between MakeMaker and META.yml keys - $args{MODULE_NAME} = $args{NAME}; - unless ( $args{NAME} = $args{DISTNAME} or ! $args{MODULE_NAME} ) { - $args{NAME} = $args{MODULE_NAME}; - $args{NAME} =~ s/::/-/g; - } - - foreach my $key ( qw{name module_name version version_from abstract author installdirs} ) { - my $value = delete($args{uc($key)}) or next; - $self->$key($value); - } - - if (my $prereq = delete($args{PREREQ_PM})) { - while (my($k,$v) = each %$prereq) { - $self->requires($k,$v); - } - } - - # put the remaining args to makemaker_args - $self->makemaker_args(%args); -} - -END { - if ( $makefile ) { - $makefile->write; - $makefile->Meta->write; - } -} - -1; diff -Nru libpod-pom-perl-0.24/inc/Module/Install/Metadata.pm libpod-pom-perl-0.27/inc/Module/Install/Metadata.pm --- libpod-pom-perl-0.24/inc/Module/Install/Metadata.pm 2009-03-21 10:18:23.000000000 +0000 +++ libpod-pom-perl-0.27/inc/Module/Install/Metadata.pm 2010-04-02 14:38:00.000000000 +0100 @@ -2,15 +2,19 @@ package Module::Install::Metadata; use strict 'vars'; -use Module::Install::Base; +use Module::Install::Base (); -use vars qw{$VERSION $ISCORE @ISA}; +use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '0.79'; + $VERSION = '0.91'; + @ISA = 'Module::Install::Base'; $ISCORE = 1; - @ISA = qw{Module::Install::Base}; } +my @boolean_keys = qw{ + sign +}; + my @scalar_keys = qw{ name module_name @@ -37,16 +41,43 @@ repository }; +my @array_keys = qw{ + keywords +}; + 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->{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; }; } @@ -55,12 +86,12 @@ *$key = sub { my $self = shift; unless ( @_ ) { - return () unless $self->{values}{resources}; + return () unless $self->{values}->{resources}; return map { $_->[1] } grep { $_->[0] eq $key } - @{ $self->{values}{resources} }; + @{ $self->{values}->{resources} }; } - return $self->{values}{resources}{$key} unless @_; + return $self->{values}->{resources}->{$key} unless @_; my $uri = shift or die( "Did not provide a value to $key()" ); @@ -69,54 +100,19 @@ }; } -sub requires { - my $self = shift; - while ( @_ ) { - my $module = shift or last; - my $version = shift || 0; - push @{ $self->{values}{requires} }, [ $module, $version ]; - } - $self->{values}{requires}; -} - -sub build_requires { - my $self = shift; - while ( @_ ) { - my $module = shift or last; - my $version = shift || 0; - push @{ $self->{values}{build_requires} }, [ $module, $version ]; - } - $self->{values}{build_requires}; -} - -sub configure_requires { - my $self = shift; - while ( @_ ) { - my $module = shift or last; - my $version = shift || 0; - push @{ $self->{values}{configure_requires} }, [ $module, $version ]; - } - $self->{values}{configure_requires}; -} - -sub recommends { - my $self = shift; - while ( @_ ) { - my $module = shift or last; - my $version = shift || 0; - push @{ $self->{values}{recommends} }, [ $module, $version ]; - } - $self->{values}{recommends}; -} - -sub bundles { - my $self = shift; - while ( @_ ) { - my $module = shift or last; - my $version = shift || 0; - push @{ $self->{values}{bundles} }, [ $module, $version ]; - } - $self->{values}{bundles}; +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 @@ -135,29 +131,22 @@ 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} ||= []; + push @{ $self->{values}->{resources} }, [ $name, $value ]; } - $self->{values}{resources}; + $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(@_) } +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 sign { - my $self = shift; - return $self->{values}{sign} if defined wantarray and ! @_; - $self->{values}{sign} = ( @_ ? $_[0] : 1 ); - return $self; -} +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; @@ -165,13 +154,13 @@ warn "You MUST provide an explicit true/false value to dynamic_config\n"; return $self; } - $self->{values}{dynamic_config} = $_[0] ? 1 : 0; + $self->{values}->{dynamic_config} = $_[0] ? 1 : 0; return 1; } sub perl_version { my $self = shift; - return $self->{values}{perl_version} unless @_; + return $self->{values}->{perl_version} unless @_; my $version = shift or die( "Did not provide a value to perl_version()" ); @@ -184,20 +173,41 @@ die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n"; } - $self->{values}{perl_version} = $version; + $self->{values}->{perl_version} = $version; } +#Stolen from M::B +my %license_urls = ( + perl => 'http://dev.perl.org/licenses/', + apache => 'http://apache.org/licenses/LICENSE-2.0', + 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 @_; + return $self->{values}->{license} unless @_; my $license = shift or die( 'Did not provide a value to license()' ); - $self->{values}{license} = $license; + $self->{values}->{license} = $license; # Automatically fill in license URLs - if ( $license eq 'perl' ) { - $self->resources( license => 'http://dev.perl.org/licenses/' ); + if ( $license_urls{$license} ) { + $self->resources( license => $license_urls{$license} ); } return 1; @@ -239,7 +249,7 @@ sub provides { my $self = shift; - my $provides = ( $self->{values}{provides} ||= {} ); + my $provides = ( $self->{values}->{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } @@ -268,7 +278,7 @@ sub feature { my $self = shift; my $name = shift; - my $features = ( $self->{values}{features} ||= [] ); + my $features = ( $self->{values}->{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { @@ -296,16 +306,16 @@ while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } - return $self->{values}{features} - ? @{ $self->{values}{features} } + 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}; + push @{ $self->{values}->{no_index}->{$type} }, @_ if $type; + return $self->{values}->{no_index}; } sub read { @@ -429,21 +439,21 @@ /ixms ) { my $license_text = $1; my @phrases = ( - 'under the same (?:terms|license) as perl itself' => '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, - 'BSD license' => 'bsd', 1, - 'Artistic license' => 'artistic', 1, - 'GPL' => 'gpl', 1, - 'LGPL' => 'lgpl', 1, - 'BSD' => 'bsd', 1, - 'Artistic' => 'artistic', 1, - 'MIT' => 'mit', 1, - 'proprietary' => 'proprietary', 0, + 'under the same (?:terms|license) as (?:perl|the perl programming language) itself' => '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, + 'BSD license' => 'bsd', 1, + 'Artistic license' => 'artistic', 1, + 'GPL' => 'gpl', 1, + 'LGPL' => 'lgpl', 1, + 'BSD' => 'bsd', 1, + 'Artistic' => 'artistic', 1, + 'MIT' => 'mit', 1, + 'proprietary' => 'proprietary', 0, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s{\s+}{\\s+}g; @@ -458,10 +468,18 @@ return 'unknown'; } +sub _extract_bugtracker { + my @links = $_[0] =~ m#L<(\Qhttp://rt.cpan.org/\E[^>]+)>#g; + my %links; + @links{@links}=(); + @links=keys %links; + return @links; +} + sub bugtracker_from { my $self = shift; my $content = Module::Install::_read($_[0]); - my @links = $content =~ m/L\<(http\:\/\/rt\.cpan\.org\/[^>]+)\>/g; + my @links = _extract_bugtracker($content); unless ( @links ) { warn "Cannot determine bugtracker info from $_[0]\n"; return 0; @@ -476,17 +494,40 @@ 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+([\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?)$/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) ) { - $v = $v + 0; # Numify + # Numify + $v = $v + 0; } return $v; } @@ -496,17 +537,57 @@ ###################################################################### -# MYMETA.yml Support +# MYMETA Support sub WriteMyMeta { - $_[0]->write_mymeta; + 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 { +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 unless -f 'META.yml'; + 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}; @@ -523,8 +604,7 @@ } # Load the advisory META.yml file - require YAML::Tiny; - my @yaml = YAML::Tiny::LoadFile('META.yml'); + my @yaml = Parse::CPAN::Meta::LoadFile('META.yml'); my $meta = $yaml[0]; # Overwrite the non-configure dependency hashs @@ -538,8 +618,7 @@ $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } }; } - # Save as the MYMETA.yml file - YAML::Tiny::DumpFile('MYMETA.yml', $meta); + return $meta; } 1; diff -Nru libpod-pom-perl-0.24/inc/Module/Install/Scripts.pm libpod-pom-perl-0.27/inc/Module/Install/Scripts.pm --- libpod-pom-perl-0.24/inc/Module/Install/Scripts.pm 1970-01-01 01:00:00.000000000 +0100 +++ libpod-pom-perl-0.27/inc/Module/Install/Scripts.pm 2010-04-02 14:38:00.000000000 +0100 @@ -0,0 +1,29 @@ +#line 1 +package Module::Install::Scripts; + +use strict 'vars'; +use Module::Install::Base (); + +use vars qw{$VERSION @ISA $ISCORE}; +BEGIN { + $VERSION = '0.91'; + @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; diff -Nru libpod-pom-perl-0.24/inc/Module/Install/Win32.pm libpod-pom-perl-0.27/inc/Module/Install/Win32.pm --- libpod-pom-perl-0.24/inc/Module/Install/Win32.pm 1970-01-01 01:00:00.000000000 +0100 +++ libpod-pom-perl-0.27/inc/Module/Install/Win32.pm 2010-04-02 14:38:00.000000000 +0100 @@ -0,0 +1,64 @@ +#line 1 +package Module::Install::Win32; + +use strict; +use Module::Install::Base (); + +use vars qw{$VERSION @ISA $ISCORE}; +BEGIN { + $VERSION = '0.91'; + @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; diff -Nru libpod-pom-perl-0.24/inc/Module/Install/WriteAll.pm libpod-pom-perl-0.27/inc/Module/Install/WriteAll.pm --- libpod-pom-perl-0.24/inc/Module/Install/WriteAll.pm 1970-01-01 01:00:00.000000000 +0100 +++ libpod-pom-perl-0.27/inc/Module/Install/WriteAll.pm 2010-04-02 14:38:00.000000000 +0100 @@ -0,0 +1,60 @@ +#line 1 +package Module::Install::WriteAll; + +use strict; +use Module::Install::Base (); + +use vars qw{$VERSION @ISA $ISCORE}; +BEGIN { + $VERSION = '0.91';; + @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} ) { + $self->makemaker_args( PL_FILES => {} ); + } + + # 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; diff -Nru libpod-pom-perl-0.24/inc/Module/Install.pm libpod-pom-perl-0.27/inc/Module/Install.pm --- libpod-pom-perl-0.24/inc/Module/Install.pm 2009-03-21 10:18:22.000000000 +0000 +++ libpod-pom-perl-0.27/inc/Module/Install.pm 2010-04-02 14:38:00.000000000 +0100 @@ -17,12 +17,10 @@ # 3. The ./inc/ version of Module::Install loads # } -BEGIN { - require 5.004; -} +use 5.005; use strict 'vars'; -use vars qw{$VERSION}; +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 @@ -30,7 +28,10 @@ # 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 = '0.79'; + $VERSION = '0.91'; + + # Storage for the pseudo-singleton + $MAIN = undef; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; @@ -69,15 +70,26 @@ # 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 and (stat($0))[9] > time ) { die <<"END_DIE" } +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. +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 +} @@ -121,14 +133,22 @@ $sym->{$cwd} = sub { my $pwd = Cwd::cwd(); if ( my $code = $sym->{$pwd} ) { - # delegate back to parent dirs + # Delegate back to parent dirs goto &$code unless $cwd eq $pwd; } $$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym"; - unless ( uc($1) eq $1 ) { - unshift @_, ( $self, $1 ); - goto &{$self->can('call')}; + 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')}; }; } @@ -153,6 +173,9 @@ delete $INC{"$self->{file}"}; delete $INC{"$self->{path}.pm"}; + # Save to the singleton + $MAIN = $self; + return 1; } @@ -166,8 +189,7 @@ my @exts = @{$self->{extensions}}; unless ( @exts ) { - my $admin = $self->{admin}; - @exts = $admin->load_all_extensions; + @exts = $self->{admin}->load_all_extensions; } my %seen; @@ -250,7 +272,7 @@ sub load_extensions { my ($self, $path, $top) = @_; - unless ( grep { !ref $_ and lc $_ eq lc $self->{prefix} } @INC ) { + unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; } @@ -314,7 +336,7 @@ ##################################################################### -# Utility Functions +# Common Utility Functions sub _caller { my $depth = 0; @@ -328,31 +350,70 @@ sub _read { local *FH; - open FH, "< $_[0]" or die "open($_[0]): $!"; - my $str = do { local $/; }; + if ( $] >= 5.006 ) { + open( FH, '<', $_[0] ) or die "open($_[0]): $!"; + } else { + open( FH, "< $_[0]" ) or die "open($_[0]): $!"; + } + my $string = do { local $/; }; close FH or die "close($_[0]): $!"; - return $str; + return $string; +} + +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; } sub _write { local *FH; - open FH, "> $_[0]" or die "open($_[0]): $!"; - foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!" } + if ( $] >= 5.006 ) { + open( FH, '>', $_[0] ) or die "open($_[0]): $!"; + } else { + open( FH, "> $_[0]" ) or die "open($_[0]): $!"; + } + foreach ( 1 .. $#_ ) { + print FH $_[$_] or die "print($_[0]): $!"; + } close FH or die "close($_[0]): $!"; } # _version is for processing module versions (eg, 1.03_05) not # Perl versions (eg, 5.8.1). - sub _version ($) { my $s = shift || 0; - $s =~ s/^(\d+)\.?//; + 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; + 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($_[0]) <=> _version($_[1]); +} + # Cloned from Params::Util::_CLASS sub _CLASS ($) { ( @@ -360,7 +421,7 @@ and ! ref $_[0] and - $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*$/s + $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s ) ? $_[0] : undef; } diff -Nru libpod-pom-perl-0.24/lib/Pod/POM/Constants.pm libpod-pom-perl-0.27/lib/Pod/POM/Constants.pm --- libpod-pom-perl-0.24/lib/Pod/POM/Constants.pm 2009-03-19 10:05:51.000000000 +0000 +++ libpod-pom-perl-0.27/lib/Pod/POM/Constants.pm 2010-04-01 21:52:00.000000000 +0100 @@ -7,15 +7,17 @@ # # 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 32 2009-03-17 21:08:25Z ford $ +# $Id: Constants.pm 78 2009-08-20 20:44:53Z ford $ # #======================================================================== @@ -24,8 +26,9 @@ require 5.004; use strict; + use vars qw( $VERSION @SEQUENCE @STATUS @EXPORT_OK %EXPORT_TAGS ); -use base qw( Exporter ); +use parent qw( Exporter ); $VERSION = sprintf("%d.%02d", q$Revision: 1.1.1.1 $ =~ /(\d+)\.(\d+)/); @SEQUENCE = qw( CMD LPAREN RPAREN FILE LINE CONTENT ); @@ -63,12 +66,16 @@ =head1 AUTHOR -Andy Wardley Eabw@kfs.orgE +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. diff -Nru libpod-pom-perl-0.24/lib/Pod/POM/Node/Begin.pm libpod-pom-perl-0.27/lib/Pod/POM/Node/Begin.pm --- libpod-pom-perl-0.24/lib/Pod/POM/Node/Begin.pm 1970-01-01 01:00:00.000000000 +0100 +++ libpod-pom-perl-0.27/lib/Pod/POM/Node/Begin.pm 2010-04-01 21:51:59.000000000 +0100 @@ -0,0 +1,65 @@ +#============================================================= -*-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 76 2009-08-20 20:41:33Z ford $ +# +#======================================================================== + +package Pod::POM::Node::Begin; + +use strict; + +use parent qw( Pod::POM::Node ); +use vars qw( %ATTRIBS @ACCEPT $EXPECT $ERROR ); + +%ATTRIBS = ( format => undef ); +@ACCEPT = qw( text verbatim code ); +$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. diff -Nru libpod-pom-perl-0.24/lib/Pod/POM/Node/Code.pm libpod-pom-perl-0.27/lib/Pod/POM/Node/Code.pm --- libpod-pom-perl-0.24/lib/Pod/POM/Node/Code.pm 1970-01-01 01:00:00.000000000 +0100 +++ libpod-pom-perl-0.27/lib/Pod/POM/Node/Code.pm 2010-04-01 21:51:59.000000000 +0100 @@ -0,0 +1,69 @@ +#============================================================= -*-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 76 2009-08-20 20:41:33Z ford $ +# +#======================================================================== + +package Pod::POM::Node::Code; + +use strict; + +use parent qw( Pod::POM::Node ); +use vars qw( %ATTRIBS $ERROR ); + +%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. diff -Nru libpod-pom-perl-0.24/lib/Pod/POM/Node/Content.pm libpod-pom-perl-0.27/lib/Pod/POM/Node/Content.pm --- libpod-pom-perl-0.24/lib/Pod/POM/Node/Content.pm 1970-01-01 01:00:00.000000000 +0100 +++ libpod-pom-perl-0.27/lib/Pod/POM/Node/Content.pm 2010-04-01 21:51:59.000000000 +0100 @@ -0,0 +1,76 @@ +#============================================================= -*-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. diff -Nru libpod-pom-perl-0.24/lib/Pod/POM/Node/For.pm libpod-pom-perl-0.27/lib/Pod/POM/Node/For.pm --- libpod-pom-perl-0.24/lib/Pod/POM/Node/For.pm 1970-01-01 01:00:00.000000000 +0100 +++ libpod-pom-perl-0.27/lib/Pod/POM/Node/For.pm 2010-04-01 21:51:59.000000000 +0100 @@ -0,0 +1,72 @@ +#============================================================= -*-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 76 2009-08-20 20:41:33Z ford $ +# +#======================================================================== + +package Pod::POM::Node::For; + +use strict; + +use parent qw( Pod::POM::Node ); +use vars qw( %ATTRIBS $ERROR ); + +%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. diff -Nru libpod-pom-perl-0.24/lib/Pod/POM/Node/Head1.pm libpod-pom-perl-0.27/lib/Pod/POM/Node/Head1.pm --- libpod-pom-perl-0.24/lib/Pod/POM/Node/Head1.pm 1970-01-01 01:00:00.000000000 +0100 +++ libpod-pom-perl-0.27/lib/Pod/POM/Node/Head1.pm 2010-04-01 21:51:59.000000000 +0100 @@ -0,0 +1,74 @@ +#============================================================= -*-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 76 2009-08-20 20:41:33Z ford $ +# +#======================================================================== + +package Pod::POM::Node::Head1; + +use strict; + +use parent qw( Pod::POM::Node ); +use vars qw( %ATTRIBS @ACCEPT $ERROR ); + +%ATTRIBS = ( title => undef ); +@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. diff -Nru libpod-pom-perl-0.24/lib/Pod/POM/Node/Head2.pm libpod-pom-perl-0.27/lib/Pod/POM/Node/Head2.pm --- libpod-pom-perl-0.24/lib/Pod/POM/Node/Head2.pm 1970-01-01 01:00:00.000000000 +0100 +++ libpod-pom-perl-0.27/lib/Pod/POM/Node/Head2.pm 2010-04-01 21:51:59.000000000 +0100 @@ -0,0 +1,74 @@ +#============================================================= -*-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 76 2009-08-20 20:41:33Z ford $ +# +#======================================================================== + +package Pod::POM::Node::Head2; + +use strict; + +use parent qw( Pod::POM::Node ); +use vars qw( %ATTRIBS @ACCEPT $ERROR ); + +%ATTRIBS = ( title => undef ); +@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. diff -Nru libpod-pom-perl-0.24/lib/Pod/POM/Node/Head3.pm libpod-pom-perl-0.27/lib/Pod/POM/Node/Head3.pm --- libpod-pom-perl-0.24/lib/Pod/POM/Node/Head3.pm 1970-01-01 01:00:00.000000000 +0100 +++ libpod-pom-perl-0.27/lib/Pod/POM/Node/Head3.pm 2010-04-01 21:51:59.000000000 +0100 @@ -0,0 +1,74 @@ +#============================================================= -*-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 76 2009-08-20 20:41:33Z ford $ +# +#======================================================================== + +package Pod::POM::Node::Head3; + +use strict; + +use parent qw( Pod::POM::Node ); +use vars qw( %ATTRIBS @ACCEPT $ERROR ); + +%ATTRIBS = ( title => undef ); +@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. diff -Nru libpod-pom-perl-0.24/lib/Pod/POM/Node/Head4.pm libpod-pom-perl-0.27/lib/Pod/POM/Node/Head4.pm --- libpod-pom-perl-0.24/lib/Pod/POM/Node/Head4.pm 1970-01-01 01:00:00.000000000 +0100 +++ libpod-pom-perl-0.27/lib/Pod/POM/Node/Head4.pm 2010-04-01 21:51:59.000000000 +0100 @@ -0,0 +1,74 @@ +#============================================================= -*-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 76 2009-08-20 20:41:33Z ford $ +# +#======================================================================== + +package Pod::POM::Node::Head4; + +use strict; + +use parent qw( Pod::POM::Node ); +use vars qw( %ATTRIBS @ACCEPT $ERROR ); + +%ATTRIBS = ( title => undef ); +@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. diff -Nru libpod-pom-perl-0.24/lib/Pod/POM/Node/Item.pm libpod-pom-perl-0.27/lib/Pod/POM/Node/Item.pm --- libpod-pom-perl-0.24/lib/Pod/POM/Node/Item.pm 1970-01-01 01:00:00.000000000 +0100 +++ libpod-pom-perl-0.27/lib/Pod/POM/Node/Item.pm 2010-04-01 21:51:59.000000000 +0100 @@ -0,0 +1,74 @@ +#============================================================= -*-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 76 2009-08-20 20:41:33Z ford $ +# +#======================================================================== + +package Pod::POM::Node::Item; + +use strict; + +use parent qw( Pod::POM::Node ); +use vars qw( %ATTRIBS @ACCEPT $ERROR ); + +%ATTRIBS = ( title => '*' ); +@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. diff -Nru libpod-pom-perl-0.24/lib/Pod/POM/Node/Over.pm libpod-pom-perl-0.27/lib/Pod/POM/Node/Over.pm --- libpod-pom-perl-0.24/lib/Pod/POM/Node/Over.pm 1970-01-01 01:00:00.000000000 +0100 +++ libpod-pom-perl-0.27/lib/Pod/POM/Node/Over.pm 2010-04-01 21:51:59.000000000 +0100 @@ -0,0 +1,95 @@ +#============================================================= -*-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 76 2009-08-20 20:41:33Z ford $ +# +#======================================================================== + +package Pod::POM::Node::Over; + +use strict; + +use parent qw( Pod::POM::Node ); +use vars qw( %ATTRIBS @ACCEPT $EXPECT $ERROR ); + +%ATTRIBS = ( indent => 4 ); +@ACCEPT = qw( over item begin for text verbatim code ); +$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. diff -Nru libpod-pom-perl-0.24/lib/Pod/POM/Node/Pod.pm libpod-pom-perl-0.27/lib/Pod/POM/Node/Pod.pm --- libpod-pom-perl-0.24/lib/Pod/POM/Node/Pod.pm 1970-01-01 01:00:00.000000000 +0100 +++ libpod-pom-perl-0.27/lib/Pod/POM/Node/Pod.pm 2010-04-01 21:51:59.000000000 +0100 @@ -0,0 +1,65 @@ +#============================================================= -*-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 76 2009-08-20 20:41:33Z ford $ +# +#======================================================================== + +package Pod::POM::Node::Pod; + +use strict; + +use parent qw( Pod::POM::Node ); +use vars qw( @ACCEPT $ERROR ); + +@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. diff -Nru libpod-pom-perl-0.24/lib/Pod/POM/Node/Sequence.pm libpod-pom-perl-0.27/lib/Pod/POM/Node/Sequence.pm --- libpod-pom-perl-0.24/lib/Pod/POM/Node/Sequence.pm 1970-01-01 01:00:00.000000000 +0100 +++ libpod-pom-perl-0.27/lib/Pod/POM/Node/Sequence.pm 2010-04-01 21:51:59.000000000 +0100 @@ -0,0 +1,109 @@ +#============================================================= -*-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 76 2009-08-20 20:41:33Z ford $ +# +#======================================================================== + +package Pod::POM::Node::Sequence; + +use strict; + +use Pod::POM::Constants qw( :all ); +use parent qw( Pod::POM::Node ); +use vars qw( %NAME ); + +%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. diff -Nru libpod-pom-perl-0.24/lib/Pod/POM/Node/Text.pm libpod-pom-perl-0.27/lib/Pod/POM/Node/Text.pm --- libpod-pom-perl-0.24/lib/Pod/POM/Node/Text.pm 1970-01-01 01:00:00.000000000 +0100 +++ libpod-pom-perl-0.27/lib/Pod/POM/Node/Text.pm 2010-04-01 21:51:59.000000000 +0100 @@ -0,0 +1,91 @@ +#============================================================= -*-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 76 2009-08-20 20:41:33Z ford $ +# +#======================================================================== + +package Pod::POM::Node::Text; + +use strict; + +use Pod::POM::Constants qw( :all ); +use parent qw( Pod::POM::Node ); +use vars qw( %ATTRIBS $ERROR ); + +%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. diff -Nru libpod-pom-perl-0.24/lib/Pod/POM/Node/Verbatim.pm libpod-pom-perl-0.27/lib/Pod/POM/Node/Verbatim.pm --- libpod-pom-perl-0.24/lib/Pod/POM/Node/Verbatim.pm 1970-01-01 01:00:00.000000000 +0100 +++ libpod-pom-perl-0.27/lib/Pod/POM/Node/Verbatim.pm 2010-04-01 21:51:59.000000000 +0100 @@ -0,0 +1,71 @@ +#============================================================= -*-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 76 2009-08-20 20:41:33Z ford $ +# +#======================================================================== + +package Pod::POM::Node::Verbatim; + +use strict; + +use parent qw( Pod::POM::Node ); +use vars qw( %ATTRIBS $ERROR ); + +%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. diff -Nru libpod-pom-perl-0.24/lib/Pod/POM/Node.pm libpod-pom-perl-0.27/lib/Pod/POM/Node.pm --- libpod-pom-perl-0.24/lib/Pod/POM/Node.pm 2009-03-20 12:41:35.000000000 +0000 +++ libpod-pom-perl-0.27/lib/Pod/POM/Node.pm 2010-04-02 14:37:42.000000000 +0100 @@ -15,7 +15,7 @@ # modify it under the same terms as Perl itself. # # REVISION -# $Id: Node.pm 60 2009-03-20 12:41:35Z ford $ +# $Id: Node.pm 88 2010-04-02 13:37:41Z ford $ # #======================================================================== @@ -79,7 +79,7 @@ no strict qw( refs ); $attribs = \%{"$class\::ATTRIBS"} || [ ]; $accept = \@{"$class\::ACCEPT"} || [ ]; - unless (defined (%{"$class\::ACCEPT"})) { + unless (%{"$class\::ACCEPT"}) { %{"$class\::ACCEPT"} = ( map { ( $_ => $NODES->{ $_ } ) } @$accept, ); @@ -185,7 +185,12 @@ my $type = $self->{ type }; my $method = "view_$type"; DEBUG("presenting method $method to $view\n"); - return $view->$method($self, @args); + my $txt = $view->$method($self, @args); + if ($view->can("encode")){ + return $view->encode($txt); + } else { + return $txt; + } } diff -Nru libpod-pom-perl-0.24/lib/Pod/POM/Nodes.pm libpod-pom-perl-0.27/lib/Pod/POM/Nodes.pm --- libpod-pom-perl-0.24/lib/Pod/POM/Nodes.pm 2009-03-19 10:05:51.000000000 +0000 +++ libpod-pom-perl-0.27/lib/Pod/POM/Nodes.pm 2010-04-01 21:52:00.000000000 +0100 @@ -16,7 +16,7 @@ # modify it under the same terms as Perl itself. # # REVISION -# $Id: Nodes.pm 14 2009-03-13 08:19:40Z ford $ +# $Id: Nodes.pm 76 2009-08-20 20:41:33Z ford $ # #======================================================================== @@ -26,274 +26,57 @@ require Exporter; use strict; -use Pod::POM::Node; + +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 -#------------------------------------------------------------------------ -package Pod::POM::Node::Pod; -use base qw( Pod::POM::Node ); -use vars qw( @ACCEPT $ERROR ); - -@ACCEPT = qw( head1 head2 head3 head4 over begin for text verbatim code ); - - -#------------------------------------------------------------------------ -package Pod::POM::Node::Head1; -use base qw( Pod::POM::Node ); -use vars qw( %ATTRIBS @ACCEPT $ERROR ); - -%ATTRIBS = ( title => undef ); -@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; - $class->SUPER::new($pom, $title); -} - - -#------------------------------------------------------------------------ -package Pod::POM::Node::Head2; -use base qw( Pod::POM::Node ); -use vars qw( %ATTRIBS @ACCEPT $ERROR ); - -%ATTRIBS = ( title => undef ); -@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; - $class->SUPER::new($pom, $title); -} - - -#------------------------------------------------------------------------ -package Pod::POM::Node::Head3; -use base qw( Pod::POM::Node ); -use vars qw( %ATTRIBS @ACCEPT $ERROR ); - -%ATTRIBS = ( title => undef ); -@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; - $class->SUPER::new($pom, $title); -} - - -#------------------------------------------------------------------------ -package Pod::POM::Node::Head4; -use base qw( Pod::POM::Node ); -use vars qw( %ATTRIBS @ACCEPT $ERROR ); - -%ATTRIBS = ( title => undef ); -@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; - $class->SUPER::new($pom, $title); -} - - -#------------------------------------------------------------------------ -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 code ); -$EXPECT = 'back'; - - -#------------------------------------------------------------------------ -package Pod::POM::Node::Item; -use base qw( Pod::POM::Node ); -use vars qw( %ATTRIBS @ACCEPT $ERROR ); - -%ATTRIBS = ( title => '*' ); -@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; - $class->SUPER::new($pom, $title); -} - - -#------------------------------------------------------------------------ -package Pod::POM::Node::Begin; -use base qw( Pod::POM::Node ); -use vars qw( %ATTRIBS @ACCEPT $EXPECT $ERROR ); - -%ATTRIBS = ( format => undef ); -@ACCEPT = qw( text verbatim code ); -$EXPECT = 'end'; - - -#------------------------------------------------------------------------ -package Pod::POM::Node::For; -use base qw( Pod::POM::Node ); -use vars qw( %ATTRIBS $ERROR ); - -%ATTRIBS = ( format => undef, text => '' ); - -sub new { - my $class = shift; - my $pom = shift; - my $text = shift; - $class->SUPER::new($pom, split(/\s+/, $text, 2)); -} - - -#------------------------------------------------------------------------ -package Pod::POM::Node::Verbatim; -use base qw( Pod::POM::Node ); -use vars qw( %ATTRIBS $ERROR ); - -%ATTRIBS = ( text => '' ); - -sub present { - my ($self, $view) = @_; - $view ||= $Pod::POM::DEFAULT_VIEW; - $view->view_verbatim($self->{ text }); -} - - -#------------------------------------------------------------------------ -package Pod::POM::Node::Code; -use base qw( Pod::POM::Node ); -use vars qw( %ATTRIBS $ERROR ); - -%ATTRIBS = ( text => '' ); - -sub present { - my ($self, $view) = @_; - $view ||= $Pod::POM::DEFAULT_VIEW; - $view->view_code($self->{ text }); -} - - -#------------------------------------------------------------------------ -package Pod::POM::Node::Text; -use Pod::POM::Constants qw( :all ); -use base qw( Pod::POM::Node ); -use vars qw( %ATTRIBS $ERROR ); - -%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}; - $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; - - $view->view_textblock($text); -} - - -#------------------------------------------------------------------------ -package Pod::POM::Node::Sequence; - -use Pod::POM::Constants qw( :all ); -use base qw( Pod::POM::Node ); -use vars qw( %NAME ); - -%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 $" = '] ['; - 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; - } -} - - -#------------------------------------------------------------------------ -package Pod::POM::Node::Content; - -use Pod::POM::Constants qw( :all ); -use base qw( Pod::POM::Node ); - -sub new { - my $class = shift; - bless [ @_ ], $class; -} - -sub present { - my ($self, $view) = @_; - $view ||= $Pod::POM::DEFAULT_VIEW; - return join('', map { ref $_ ? $_->present($view) : $_ } @$self); -} +Pod::POM::Nodes - convenience class to load all node classes +=head1 SYNOPSIS -1; + 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. diff -Nru libpod-pom-perl-0.24/lib/Pod/POM/View/HTML.pm libpod-pom-perl-0.27/lib/Pod/POM/View/HTML.pm --- libpod-pom-perl-0.24/lib/Pod/POM/View/HTML.pm 2009-03-19 10:05:51.000000000 +0000 +++ libpod-pom-perl-0.27/lib/Pod/POM/View/HTML.pm 2010-04-01 21:52:00.000000000 +0100 @@ -15,7 +15,7 @@ # modify it under the same terms as Perl itself. # # REVISION -# $Id: HTML.pm 33 2009-03-17 21:10:42Z ford $ +# $Id: HTML.pm 84 2009-08-20 21:07:00Z ford $ # #======================================================================== @@ -25,7 +25,7 @@ use strict; use Pod::POM::View; -use base qw( Pod::POM::View ); +use parent qw( Pod::POM::View ); use vars qw( $VERSION $DEBUG $ERROR $AUTOLOAD ); use Text::Wrap; @@ -401,6 +401,11 @@ return $text; } +sub encode { + my($self,$text) = @_; + require Encode; + return Encode::encode("ascii",$text,Encode::FB_XMLCREF()); +} 1; diff -Nru libpod-pom-perl-0.24/lib/Pod/POM/View/Pod.pm libpod-pom-perl-0.27/lib/Pod/POM/View/Pod.pm --- libpod-pom-perl-0.24/lib/Pod/POM/View/Pod.pm 2009-03-20 12:42:40.000000000 +0000 +++ libpod-pom-perl-0.27/lib/Pod/POM/View/Pod.pm 2010-04-01 21:52:00.000000000 +0100 @@ -15,7 +15,7 @@ # modify it under the same terms as Perl itself. # # REVISION -# $Id: Pod.pm 61 2009-03-20 12:42:40Z ford $ +# $Id: Pod.pm 77 2009-08-20 20:44:14Z ford $ # #======================================================================== @@ -26,7 +26,7 @@ use strict; use Pod::POM::Nodes; use Pod::POM::View; -use base qw( 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+)/); diff -Nru libpod-pom-perl-0.24/lib/Pod/POM/View/Text.pm libpod-pom-perl-0.27/lib/Pod/POM/View/Text.pm --- libpod-pom-perl-0.24/lib/Pod/POM/View/Text.pm 2009-03-19 10:05:51.000000000 +0000 +++ libpod-pom-perl-0.27/lib/Pod/POM/View/Text.pm 2010-04-01 21:52:00.000000000 +0100 @@ -15,7 +15,7 @@ # modify it under the same terms as Perl itself. # # REVISION -# $Id: Text.pm 34 2009-03-17 21:11:05Z ford $ +# $Id: Text.pm 77 2009-08-20 20:44:14Z ford $ # #======================================================================== @@ -25,7 +25,7 @@ use strict; use Pod::POM::View; -use base qw( Pod::POM::View ); +use parent qw( Pod::POM::View ); use vars qw( $VERSION $DEBUG $ERROR $AUTOLOAD $INDENT ); use Text::Wrap; diff -Nru libpod-pom-perl-0.24/lib/Pod/POM.pm libpod-pom-perl-0.27/lib/Pod/POM.pm --- libpod-pom-perl-0.24/lib/Pod/POM.pm 2009-03-21 10:18:03.000000000 +0000 +++ libpod-pom-perl-0.27/lib/Pod/POM.pm 2010-04-02 14:37:42.000000000 +0100 @@ -13,12 +13,13 @@ # # 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 66 2009-03-21 10:18:03Z ford $ +# $Id: POM.pm 88 2010-04-02 13:37:41Z ford $ # #======================================================================== @@ -34,7 +35,7 @@ use vars qw( $VERSION $DEBUG $ERROR $ROOT $TEXTSEQ $DEFAULT_VIEW ); use base qw( Exporter ); -$VERSION = '0.24'; +$VERSION = '0.27'; $DEBUG = 0 unless defined $DEBUG; $ROOT = 'Pod::POM::Node::Pod'; # root node class $TEXTSEQ = 'Pod::POM::Node::Sequence'; # text sequence class @@ -174,6 +175,18 @@ $$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) { @@ -1592,7 +1605,7 @@ =head1 VERSION -This is version 0.24 of the Pod::POM module. +This is version 0.25 of the Pod::POM module. =head1 COPYRIGHT diff -Nru libpod-pom-perl-0.24/Makefile.PL libpod-pom-perl-0.27/Makefile.PL --- libpod-pom-perl-0.24/Makefile.PL 2009-03-19 14:56:19.000000000 +0000 +++ libpod-pom-perl-0.27/Makefile.PL 2010-04-01 21:52:01.000000000 +0100 @@ -1,37 +1,23 @@ -use 5.005; +use 5.006; use inc::Module::Install; -my %opts = ( - 'NAME' => 'Pod::POM', - 'VERSION_FROM' => 'lib/Pod/POM.pm', - 'EXE_FILES' => [ 'bin/pom2', 'bin/podlint', 'bin/pomdump' ], - 'PREREQ_PM' => { - 'Text::Wrap' => 0, - - # Required for testing - 'File::Slurp' => 0, - 'Test::More' => 0, - 'Test::Differences' => 0, - 'YAML::Any' => 0, - }, - 'dist' => { - 'COMPRESS' => 'gzip', - 'SUFFIX' => 'gz', - }, -); - -if ($ExtUtils::MakeMaker::VERSION >= 5.43) { - $opts{ AUTHOR } = 'Andy Wardley '; - $opts{ ABSTRACT } = 'POD Object Model', -} - -if ($ExtUtils::MakeMaker::VERSION >= 6.31) { - $opts{ LICENSE } = 'perl'; -} - -if ($ExtUtils::MakeMaker::VERSION >= 6.48) { - $opts{ MIN_PERL_VERSION } = '5.005'; -} +# Define metadata -WriteMakefile( %opts ); +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; diff -Nru libpod-pom-perl-0.24/MANIFEST libpod-pom-perl-0.27/MANIFEST --- libpod-pom-perl-0.24/MANIFEST 2009-03-20 12:53:05.000000000 +0000 +++ libpod-pom-perl-0.27/MANIFEST 2010-04-01 21:52:01.000000000 +0100 @@ -10,12 +10,30 @@ bin/pomdump inc/Module/Install.pm inc/Module/Install/Base.pm -inc/Module/Install/MakeMaker.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 @@ -28,6 +46,7 @@ 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 @@ -86,6 +105,13 @@ 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 diff -Nru libpod-pom-perl-0.24/META.yml libpod-pom-perl-0.27/META.yml --- libpod-pom-perl-0.24/META.yml 2009-03-21 10:18:24.000000000 +0000 +++ libpod-pom-perl-0.27/META.yml 2010-04-02 14:38:00.000000000 +0100 @@ -2,24 +2,28 @@ abstract: 'POD Object Model' author: - 'Andy Wardley ' +build_requires: + ExtUtils::MakeMaker: 6.42 + File::Slurp: 0 + Test::More: 0 configure_requires: - ExtUtils::MakeMaker: 6.48 + ExtUtils::MakeMaker: 6.42 distribution_type: module -generated_by: 'Module::Install version 0.79' -license: unknown +generated_by: 'Module::Install version 0.91' +license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 -module_name: Pod::POM name: Pod-POM no_index: directory: - inc - t requires: - File::Slurp: 0 - Test::Differences: 0 - Test::More: 0 - Text::Wrap: 0 - YAML::Any: 0 -version: 0.24 + Encode: 0 + Text::Wrap: 2001.0929 + parent: 0 + perl: 5.6.0 +resources: + license: http://dev.perl.org/licenses/ +version: 0.27 diff -Nru libpod-pom-perl-0.24/README libpod-pom-perl-0.27/README --- libpod-pom-perl-0.24/README 2009-03-19 10:05:52.000000000 +0000 +++ libpod-pom-perl-0.27/README 2010-04-01 22:56:07.000000000 +0100 @@ -1,12 +1,12 @@ Pod::POM - Version 0.19 + Version 0.26 - 17th March 2009 + 1st April 2010 Copyright (C) 2000-2002 Andy Wardley. All Rights Reserved - Copyright (C) 2009 Andrew Ford. 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. @@ -63,7 +63,7 @@ --------- Copyright (C) 2000-2002 Andy Wardley. All Rights Reserved. -Copyright (C) 2009 Andrew Ford. 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. diff -Nru libpod-pom-perl-0.24/t/PodPOMTestLib.pm libpod-pom-perl-0.27/t/PodPOMTestLib.pm --- libpod-pom-perl-0.24/t/PodPOMTestLib.pm 2009-03-19 14:55:50.000000000 +0000 +++ libpod-pom-perl-0.27/t/PodPOMTestLib.pm 2010-04-01 21:51:57.000000000 +0100 @@ -9,9 +9,8 @@ use Pod::POM; use Test::More; -use Test::Differences; use File::Slurp; -use YAML::Any; +use YAML::Tiny; # use Data::Dumper; # for debugging @@ -45,6 +44,15 @@ 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 { @@ -54,9 +62,10 @@ my $pom = $pod_parser->parse_text($test->input); my $result = $view ? $pom->present($view) : $pom->dump; - eq_or_diff $result, $test->expect, $test->title; + $eq->($result, $test->expect, $test->title); }; if ($@) { + diag($@); fail($test->title); } } @@ -85,6 +94,8 @@ 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 diff -Nru libpod-pom-perl-0.24/t/testcases/230-alternate-delimters.pod libpod-pom-perl-0.27/t/testcases/230-alternate-delimters.pod --- libpod-pom-perl-0.24/t/testcases/230-alternate-delimters.pod 1970-01-01 01:00:00.000000000 +0100 +++ libpod-pom-perl-0.27/t/testcases/230-alternate-delimters.pod 2010-04-01 21:51:55.000000000 +0100 @@ -0,0 +1,10 @@ +=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. + diff -Nru libpod-pom-perl-0.24/t/testcases/230-alternate-delimters.pom-dump libpod-pom-perl-0.27/t/testcases/230-alternate-delimters.pom-dump --- libpod-pom-perl-0.24/t/testcases/230-alternate-delimters.pom-dump 1970-01-01 01:00:00.000000000 +0100 +++ libpod-pom-perl-0.27/t/testcases/230-alternate-delimters.pom-dump 2010-04-01 21:51:55.000000000 +0100 @@ -0,0 +1,21 @@ +pod + 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." diff -Nru libpod-pom-perl-0.24/t/testcases/230-alternate-delimters.view-html libpod-pom-perl-0.27/t/testcases/230-alternate-delimters.view-html --- libpod-pom-perl-0.24/t/testcases/230-alternate-delimters.view-html 1970-01-01 01:00:00.000000000 +0100 +++ libpod-pom-perl-0.27/t/testcases/230-alternate-delimters.view-html 2010-04-01 21:51:55.000000000 +0100 @@ -0,0 +1,11 @@ + + +

NAME

+ +

230-alternate-delimiters

+

TESTCASES

+ +

Code containing a greater than symbol should be legal:

+

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

+ + diff -Nru libpod-pom-perl-0.24/t/testcases/230-alternate-delimters.view-pod libpod-pom-perl-0.27/t/testcases/230-alternate-delimters.view-pod --- libpod-pom-perl-0.24/t/testcases/230-alternate-delimters.view-pod 1970-01-01 01:00:00.000000000 +0100 +++ libpod-pom-perl-0.27/t/testcases/230-alternate-delimters.view-pod 2010-04-01 21:51:56.000000000 +0100 @@ -0,0 +1,10 @@ +=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. + diff -Nru libpod-pom-perl-0.24/t/testcases/230-alternate-delimters.view-text libpod-pom-perl-0.27/t/testcases/230-alternate-delimters.view-text --- libpod-pom-perl-0.24/t/testcases/230-alternate-delimters.view-text 1970-01-01 01:00:00.000000000 +0100 +++ libpod-pom-perl-0.27/t/testcases/230-alternate-delimters.view-text 2010-04-01 21:51:55.000000000 +0100 @@ -0,0 +1,8 @@ +NAME + 230-alternate-delimiters + +TESTCASES + Code containing a greater than symbol should be legal: + + '$obj->clone' makes a deep copy of the object. + diff -Nru libpod-pom-perl-0.24/t/testcases/240-encoding.pod libpod-pom-perl-0.27/t/testcases/240-encoding.pod --- libpod-pom-perl-0.24/t/testcases/240-encoding.pod 1970-01-01 01:00:00.000000000 +0100 +++ libpod-pom-perl-0.27/t/testcases/240-encoding.pod 2010-04-01 21:51:55.000000000 +0100 @@ -0,0 +1,7 @@ +=head1 NAME + +230-encoding + +=encoding iso-8859-2 + +This is latin-2 for a c with an accent: Slaven Reziæ diff -Nru libpod-pom-perl-0.24/t/testcases/240-encoding.view-html libpod-pom-perl-0.27/t/testcases/240-encoding.view-html --- libpod-pom-perl-0.24/t/testcases/240-encoding.view-html 1970-01-01 01:00:00.000000000 +0100 +++ libpod-pom-perl-0.27/t/testcases/240-encoding.view-html 2010-04-01 21:51:56.000000000 +0100 @@ -0,0 +1,8 @@ + + +

NAME

+ +

230-encoding

+

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

+ + diff -Nru libpod-pom-perl-0.24/t/YAML/Tiny.pm libpod-pom-perl-0.27/t/YAML/Tiny.pm --- libpod-pom-perl-0.24/t/YAML/Tiny.pm 1970-01-01 01:00:00.000000000 +0100 +++ libpod-pom-perl-0.27/t/YAML/Tiny.pm 2010-04-01 21:51:56.000000000 +0100 @@ -0,0 +1,1070 @@ +package 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 diff -Nru libpod-pom-perl-0.24/TODO libpod-pom-perl-0.27/TODO --- libpod-pom-perl-0.24/TODO 2009-03-19 10:05:52.000000000 +0000 +++ libpod-pom-perl-0.27/TODO 2010-04-01 21:52:01.000000000 +0100 @@ -4,6 +4,8 @@ * 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