r70511 - in /branches/upstream/libxml-treebuilder-perl/current: ./ lib/XML/ t/
ansgar at users.alioth.debian.org
ansgar at users.alioth.debian.org
Sat Mar 5 19:05:50 UTC 2011
Author: ansgar
Date: Sat Mar 5 19:05:26 2011
New Revision: 70511
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=70511
Log:
[svn-upgrade] new version libxml-treebuilder-perl (4.0)
Added:
branches/upstream/libxml-treebuilder-perl/current/Build.PL
branches/upstream/libxml-treebuilder-perl/current/t/parse_test.xml
branches/upstream/libxml-treebuilder-perl/current/t/zz_perlcritic.t
branches/upstream/libxml-treebuilder-perl/current/t/zz_pod-coverage.t
branches/upstream/libxml-treebuilder-perl/current/t/zz_pod.t
Removed:
branches/upstream/libxml-treebuilder-perl/current/MANIFEST.SKIP
Modified:
branches/upstream/libxml-treebuilder-perl/current/Changes
branches/upstream/libxml-treebuilder-perl/current/MANIFEST
branches/upstream/libxml-treebuilder-perl/current/META.yml
branches/upstream/libxml-treebuilder-perl/current/Makefile.PL
branches/upstream/libxml-treebuilder-perl/current/README
branches/upstream/libxml-treebuilder-perl/current/lib/XML/Element.pm
branches/upstream/libxml-treebuilder-perl/current/lib/XML/TreeBuilder.pm
branches/upstream/libxml-treebuilder-perl/current/t/00about.t
branches/upstream/libxml-treebuilder-perl/current/t/10main.t
Added: branches/upstream/libxml-treebuilder-perl/current/Build.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libxml-treebuilder-perl/current/Build.PL?rev=70511&op=file
==============================================================================
--- branches/upstream/libxml-treebuilder-perl/current/Build.PL (added)
+++ branches/upstream/libxml-treebuilder-perl/current/Build.PL Sat Mar 5 19:05:26 2011
@@ -1,0 +1,40 @@
+use strict;
+use warnings;
+use Module::Build;
+use 5.004;
+
+my $class = Module::Build->subclass(
+ class => 'My::Builder',
+ code => q{
+ }
+);
+
+my $builder = $class->new(
+ module_name => 'XML::TreeBuilder',
+ license => 'perl',
+ dist_author => 'Jeff Fearn <Jeff.Fearn at gmail.com>',
+ dist_version_from => 'lib/XML/Element.pm',
+ create_makefile_pl => 'traditional',
+ build_requires => {
+ 'Devel::Cover' => 0,
+ 'Module::Build' => 0,
+ 'Test::Exception' => 0,
+ 'Test::More' => 0,
+ 'Test::Pod::Coverage' => 0,
+ 'Test::Perl::Critic' => 0,
+ 'XML::Parser' => 0,
+ 'HTML::Element' => 4.1,
+ 'HTML::Tagset' => 3.02,
+ },
+ requires => {
+ 'XML::Parser' => 0,
+ 'HTML::Element' => 4.1,
+ 'HTML::Tagset' => 3.02,
+ 'perl' => '5.4.0',
+ },
+ add_to_cleanup =>
+ [ 'XML-TreeBuilder-*', 'tmp', 'blib', 'MANIFEST.bak', 'META.yml' ],
+ script_files => [],
+);
+
+$builder->create_build_script();
Modified: branches/upstream/libxml-treebuilder-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libxml-treebuilder-perl/current/Changes?rev=70511&op=diff
==============================================================================
--- branches/upstream/libxml-treebuilder-perl/current/Changes (original)
+++ branches/upstream/libxml-treebuilder-perl/current/Changes Sat Mar 5 19:05:26 2011
@@ -1,4 +1,17 @@
-# Time-stamp: "2004-06-10 20:28:41 ADT"
+Nov 24 2010 Jeff Fearn <Jeff.Fearn at gmail.com>
+
+ Release 4.0
+
+ Added NoExpand option to allow entities to be left untouched in xml.
+ Added ErrorContext option to allow better reporting of error locations.
+ Expanded tests to test these options.
+ Added EncodeAmp option to encode unencoded ampersans on parsing.
+ Switched to Module::Build
+ Added Perl::Critic tests
+ Fixed Perl::Critic complaints
+ Switched t/10main.t to Test::More
+ Added create_makefile_pl to Build.pl
+ Bumped HTML::Element req to 4.1 for proper entity handling
2004-06-10 Sean M. Burke <sburke at cpan.org>
Modified: branches/upstream/libxml-treebuilder-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libxml-treebuilder-perl/current/MANIFEST?rev=70511&op=diff
==============================================================================
--- branches/upstream/libxml-treebuilder-perl/current/MANIFEST (original)
+++ branches/upstream/libxml-treebuilder-perl/current/MANIFEST Sat Mar 5 19:05:26 2011
@@ -1,10 +1,14 @@
+Build.PL
Changes
lib/XML/Element.pm
lib/XML/TreeBuilder.pm
-Makefile.PL
MANIFEST
-MANIFEST.SKIP
+META.yml Module meta-data (added by MakeMaker)
README
t/00about.t
t/10main.t
-META.yml Module meta-data (added by MakeMaker)
+t/parse_test.xml
+t/zz_perlcritic.t
+t/zz_pod-coverage.t
+t/zz_pod.t
+Makefile.PL
Modified: branches/upstream/libxml-treebuilder-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libxml-treebuilder-perl/current/META.yml?rev=70511&op=diff
==============================================================================
--- branches/upstream/libxml-treebuilder-perl/current/META.yml (original)
+++ branches/upstream/libxml-treebuilder-perl/current/META.yml Sat Mar 5 19:05:26 2011
@@ -1,13 +1,37 @@
-# http://module-build.sourceforge.net/META-spec.html
-#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
-name: XML-TreeBuilder
-version: 3.09
-version_from: lib/XML/TreeBuilder.pm
-installdirs: site
+---
+abstract: 'XML elements with the same interface as HTML::Element'
+author:
+ - 'Jeff Fearn <Jeff.Fearn at gmail.com>'
+build_requires:
+ Devel::Cover: 0
+ HTML::Element: 4.1
+ HTML::Tagset: 3.02
+ Module::Build: 0
+ Test::Exception: 0
+ Test::More: 0
+ Test::Perl::Critic: 0
+ Test::Pod::Coverage: 0
+ XML::Parser: 0
+configure_requires:
+ Module::Build: 0.36
+generated_by: 'Module::Build version 0.3603'
+license: perl
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
+name: XML-TreeBuilder
+provides:
+ XML::Element:
+ file: lib/XML/Element.pm
+ version: 4.0
+ XML::TreeBuilder:
+ file: lib/XML/TreeBuilder.pm
+ version: 0
requires:
- HTML::Element: 3.08
- HTML::Tagset: 3.02
- XML::Parser: 0
-
-distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.17
+ HTML::Element: 4.1
+ HTML::Tagset: 3.02
+ XML::Parser: 0
+ perl: v5.4.0
+resources:
+ license: http://dev.perl.org/licenses/
+version: 4.0
Modified: branches/upstream/libxml-treebuilder-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libxml-treebuilder-perl/current/Makefile.PL?rev=70511&op=diff
==============================================================================
--- branches/upstream/libxml-treebuilder-perl/current/Makefile.PL (original)
+++ branches/upstream/libxml-treebuilder-perl/current/Makefile.PL Sat Mar 5 19:05:26 2011
@@ -1,33 +1,23 @@
-# This -*- perl -*- script writes the Makefile for XML::TreeBuilder
-#
-# Time-stamp: "2004-06-10 19:57:41 ADT"
-#
-# See lib/ExtUtils/MakeMaker.pm for details of how to influence
-# the contents of the Makefile that is written.
-#
-
-require 5.004;
-use strict;
+# Note: this file was auto-generated by Module::Build::Compat version 0.3603
+require 5.004000;
use ExtUtils::MakeMaker;
-
-WriteMakefile(
- 'NAME' => 'XML-TreeBuilder',
- 'VERSION_FROM' => 'lib/XML/TreeBuilder.pm',
- 'ABSTRACT_FROM' => 'lib/XML/TreeBuilder.pm',
-
- 'PREREQ_PM' => {
- 'HTML::Element' => 3.08, # at LEAST!
- 'HTML::Tagset' => 3.02,
- 'XML::Parser' => 0,
- },
- dist => { COMPRESS => 'gzip -6f', SUFFIX => 'gz', },
-);
-
-package MY;
-
-sub libscan
-{ # Determine things that should *not* be installed
- my($self, $path) = @_;
- return '' if $path =~ m/~/;
- $path;
-}
+WriteMakefile
+(
+ 'PL_FILES' => {},
+ 'INSTALLDIRS' => 'site',
+ 'NAME' => 'XML::TreeBuilder',
+ 'EXE_FILES' => [],
+ 'VERSION_FROM' => 'lib/XML/Element.pm',
+ 'PREREQ_PM' => {
+ 'Test::Pod::Coverage' => 0,
+ 'Test::Exception' => 0,
+ 'HTML::Element' => '4.1',
+ 'Test::Perl::Critic' => 0,
+ 'Test::More' => 0,
+ 'HTML::Tagset' => '3.02',
+ 'Module::Build' => 0,
+ 'XML::Parser' => 0,
+ 'Devel::Cover' => 0
+ }
+ )
+;
Modified: branches/upstream/libxml-treebuilder-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libxml-treebuilder-perl/current/README?rev=70511&op=diff
==============================================================================
--- branches/upstream/libxml-treebuilder-perl/current/README (original)
+++ branches/upstream/libxml-treebuilder-perl/current/README Sat Mar 5 19:05:26 2011
@@ -24,16 +24,16 @@
Just follow the usual procedure:
- perl Makefile.PL
- make
- make test
- make install
+ perl Build.PL
+ ./Build
+ ./Build test
+ ./Build install
If you want to install a private copy of this module-suite in your home
directory, then you should try to produce the initial Makefile with
something like this command:
- perl Makefile.PL PREFIX=~/perl
+ perl Build.PL PREFIX=~/perl
See perldoc perlmodinstall for more information on installing modules.
Modified: branches/upstream/libxml-treebuilder-perl/current/lib/XML/Element.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libxml-treebuilder-perl/current/lib/XML/Element.pm?rev=70511&op=diff
==============================================================================
--- branches/upstream/libxml-treebuilder-perl/current/lib/XML/Element.pm (original)
+++ branches/upstream/libxml-treebuilder-perl/current/lib/XML/Element.pm Sat Mar 5 19:05:26 2011
@@ -1,17 +1,20 @@
+require 5;
-require 5;
package XML::Element;
-#Time-stamp: "2004-06-10 20:00:02 ADT"
+use warnings;
+use strict;
use HTML::Tagset ();
-use HTML::Element 3.08 ();
-$VERSION = '3.09';
- at ISA = ('HTML::Element');
+use HTML::Element 4.1 ();
+
+use vars qw(@ISA $VERSION);
+$VERSION = '4.0';
+ at ISA = ('HTML::Element');
# Init:
-%emptyElement = ();
+my %emptyElement = ();
foreach my $e (%HTML::Tagset::emptyElement) {
- $emptyElement{$e} = 1
- if substr($e,0,1) eq '~' and $HTML::Tagset::emptyElement{$e};
+ $emptyElement{$e} = 1
+ if substr( $e, 0, 1 ) eq '~' and $HTML::Tagset::emptyElement{$e};
}
#--------------------------------------------------------------------------
@@ -19,9 +22,10 @@
sub _empty_element_map { \%emptyElement }
-*_fold_case = \&HTML::Element::_fold_case_NOT;
-*starttag = \&HTML::Element::starttag_XML;
-*endtag = \&HTML::Element::endtag_XML;
+*_fold_case = \&HTML::Element::_fold_case_NOT;
+*starttag = \&HTML::Element::starttag_XML;
+*endtag = \&HTML::Element::endtag_XML;
+*encoded_content = \$HTML::Element::encoded_content;
# TODO: override id with something that looks for xml:id too/instead?
@@ -30,37 +34,35 @@
#TODO: test and document this:
# with no tagname set, assumes ALL all-whitespace nodes are ignorable!
-use strict;
+sub delete_ignorable_whitespace {
+ my $under_hash = $_[1];
+ my (@to_do) = ( $_[0] );
-sub delete_ignorable_whitespace {
- my $under_hash = $_[1];
- my(@to_do) = ($_[0]);
-
- if($under_hash and ref($under_hash) eq 'ARRAY') {
- $under_hash = { map {; $_ => 1 } @$under_hash };
- }
-
- my $all = !$under_hash;
- my($i,$this,$children);
- while(@to_do) {
- $this = shift @to_do;
- $children = $this->content || next;
- if(
- ($all or $under_hash->{$this->tag})
- and @$children
- ) {
- for($i = $#$children; $i >= 0; --$i) {
- # work backwards thru the list
- next if ref $children->[$i];
- if($children->[$i] =~ m<^\s*$>s) { # all WS
- splice @$children, $i, 1; # delete it.
+ if ( $under_hash and ref($under_hash) eq 'ARRAY' ) {
+ $under_hash = { map { ; $_ => 1 } @$under_hash };
+ }
+
+ my $all = !$under_hash;
+ my ( $i, $this, $children );
+ while (@to_do) {
+ $this = shift @to_do;
+ $children = $this->content || next;
+ if ( ( $all or $under_hash->{ $this->tag } )
+ and @$children )
+ {
+ for ( $i = $#$children; $i >= 0; --$i ) {
+
+ # work backwards thru the list
+ next if ref $children->[$i];
+ if ( $children->[$i] =~ m<^\s*$>s ) { # all WS
+ splice @$children, $i, 1; # delete it.
+ }
+ }
}
- }
+ unshift @to_do, grep ref($_), @$children; # recurse
}
- unshift @to_do, grep ref($_), @$children; # recurse
- }
-
- return;
+
+ return;
}
#--------------------------------------------------------------------------
@@ -76,6 +78,21 @@
=head1 SYNOPSIS
[See HTML::Element]
+
+=head1 METHODS AND ATTRIBUTES
+
+=head2 delete_ignorable_whitespace
+
+TODO: test and document this:
+with no tagname set, assumes ALL all-whitespace nodes are ignorable!
+
+=head2 endtag
+
+Redirects to HTML::Element::endtag_XML
+
+=head2 starttag
+
+Redirects to HTML::Element::starttag_XML
=head1 DESCRIPTION
Modified: branches/upstream/libxml-treebuilder-perl/current/lib/XML/TreeBuilder.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libxml-treebuilder-perl/current/lib/XML/TreeBuilder.pm?rev=70511&op=diff
==============================================================================
--- branches/upstream/libxml-treebuilder-perl/current/lib/XML/TreeBuilder.pm (original)
+++ branches/upstream/libxml-treebuilder-perl/current/lib/XML/TreeBuilder.pm Sat Mar 5 19:05:26 2011
@@ -1,139 +1,199 @@
-
require 5;
+
package XML::TreeBuilder;
-#Time-stamp: "2004-06-10 19:59:14 ADT"
+
+use warnings;
use strict;
use XML::Element ();
-use XML::Parser ();
+use XML::Parser ();
+use Carp;
use vars qw(@ISA $VERSION);
-$VERSION = '3.09';
- at ISA = ('XML::Element');
+$VERSION = $XML::Element::VERSION;
+ at ISA = ('XML::Element');
#==========================================================================
sub new {
- my $class = ref($_[0]) || $_[0];
- # that's the only parameter it knows
-
- my $self = XML::Element->new('NIL');
- bless $self, $class; # and rebless
- $self->{'_element_class'} = 'XML::Element';
- $self->{'_store_comments'} = 0;
- $self->{'_store_pis'} = 0;
- $self->{'_store_declarations'} = 0;
-
- my @stack;
- # Compare the simplicity of this to the sheer nastiness of HTML::TreeBuilder!
-
- $self->{'_xml_parser'} = XML::Parser->new( 'Handlers' => {
- 'Start' => sub {
- shift;
- if(@stack) {
- push @stack, $self->{'_element_class'}->new(@_);
- $stack[-2]->push_content( $stack[-1] );
- } else {
- $self->tag(shift);
- while(@_) { $self->attr(splice(@_,0,2)) };
- push @stack, $self;
- }
- },
-
- 'End' => sub { pop @stack; return },
-
- 'Char' => sub { $stack[-1]->push_content($_[1]) },
-
- 'Comment' => sub {
- return unless $self->{'_store_comments'};
- (
- @stack ? $stack[-1] : $self
- )->push_content(
- $self->{'_element_class'}->new('~comment', 'text' => $_[1])
- );
- return;
- },
-
- 'Proc' => sub {
- return unless $self->{'_store_pis'};
- (
- @stack ? $stack[-1] : $self
- )->push_content(
- $self->{'_element_class'}->new('~pi', 'text' => "$_[1] $_[2]")
- );
- return;
- },
-
- # And now, declarations:
-
- 'Attlist' => sub {
- return unless $self->{'_store_declarations'};
- shift;
- (
- @stack ? $stack[-1] : $self
- )->push_content(
- $self->{'_element_class'}->new('~declaration',
- 'text' => join ' ', 'ATTLIST', @_
- )
- );
- return;
- },
-
- 'Element' => sub {
- return unless $self->{'_store_declarations'};
- shift;
- (
- @stack ? $stack[-1] : $self
- )->push_content(
- $self->{'_element_class'}->new('~declaration',
- 'text' => join ' ', 'ELEMENT', @_
- )
- );
- return;
- },
-
- 'Doctype' => sub {
- return unless $self->{'_store_declarations'};
- shift;
- (
- @stack ? $stack[-1] : $self
- )->push_content(
- $self->{'_element_class'}->new('~declaration',
- 'text' => join ' ', 'DOCTYPE', @_
- )
- );
- return;
- },
-
- });
-
- return $self;
-}
+ my ( $this, $arg ) = @_;
+ my $class = ref($this) || $this;
+
+ my $NoExpand = ( delete $arg->{'NoExpand'} || undef );
+ my $ErrorContext = ( delete $arg->{'ErrorContext'} || undef );
+
+ if ( %{$arg} ) {
+ croak "unknown args: " . join( ", ", keys %{$arg} );
+ }
+
+ my $self = XML::Element->new('NIL');
+ bless $self, $class; # and rebless
+ $self->{'_element_class'} = 'XML::Element';
+ $self->{'_store_comments'} = 0;
+ $self->{'_store_pis'} = 0;
+ $self->{'_store_declarations'} = 0;
+ $self->{'NoExpand'} = $NoExpand if ($NoExpand);
+ $self->{'ErrorContext'} = $ErrorContext if ($ErrorContext);
+
+ # have to let HTML::Element know there are encoded entities
+ $XML::Element::encoded_content = $NoExpand if ($NoExpand);
+
+ my @stack;
+
+ # Compare the simplicity of this to the sheer nastiness of HTML::TreeBuilder!
+
+ $self->{'_xml_parser'} = XML::Parser->new(
+ 'Handlers' => {
+ 'Default' => sub {
+
+ # Stuff unexpanded entities back on to the stack as is.
+ if ( ( $self->{'NoExpand'} ) && ( $_[1] =~ /&[^\;]+\;/ ) ) {
+ $stack[-1]->push_content( $_[1] );
+ }
+ return;
+ },
+ 'Start' => sub {
+ shift;
+ if (@stack) {
+ push @stack, $self->{'_element_class'}->new(@_);
+ $stack[-2]->push_content( $stack[-1] );
+ }
+ else {
+ $self->tag(shift);
+ while (@_) { $self->attr( splice( @_, 0, 2 ) ) }
+ push @stack, $self;
+ }
+ },
+
+ 'End' => sub { pop @stack; return },
+
+ 'Char' => sub {
+
+ # have to escape '&' if we have entities to catch things like &foo;
+ if ( $_[1] eq '&' and $self->{'NoExpand'} ) {
+ $stack[-1]->push_content('&');
+ }
+ else {
+ $stack[-1]->push_content( $_[1] );
+ }
+ },
+
+ 'Comment' => sub {
+ return unless $self->{'_store_comments'};
+ ( @stack ? $stack[-1] : $self )
+ ->push_content( $self->{'_element_class'}
+ ->new( '~comment', 'text' => $_[1] ) );
+ return;
+ },
+
+ 'Proc' => sub {
+ return unless $self->{'_store_pis'};
+ ( @stack ? $stack[-1] : $self )
+ ->push_content( $self->{'_element_class'}
+ ->new( '~pi', 'text' => "$_[1] $_[2]" ) );
+ return;
+ },
+
+ 'Final' => sub {
+
+ # clean up the internal attributes
+ $self->root()->traverse(
+ sub {
+ my ( $node, $start ) = @_;
+ if ( ref $node ) { # it's an element
+ $node->attr( 'NoExpand', undef );
+ $node->attr( 'ErrorContext', undef );
+ }
+ }
+ );
+ },
+
+ # And now, declarations:
+
+ 'Attlist' => sub {
+ return unless $self->{'_store_declarations'};
+ shift;
+ ( @stack ? $stack[-1] : $self )->push_content(
+ $self->{'_element_class'}->new(
+ '~declaration',
+ 'text' => join ' ',
+ 'ATTLIST', @_
+ )
+ );
+ return;
+ },
+
+ 'Element' => sub {
+ return unless $self->{'_store_declarations'};
+ shift;
+ ( @stack ? $stack[-1] : $self )->push_content(
+ $self->{'_element_class'}->new(
+ '~declaration',
+ 'text' => join ' ',
+ 'ELEMENT', @_
+ )
+ );
+ return;
+ },
+
+ 'Doctype' => sub {
+ return unless $self->{'_store_declarations'};
+ shift;
+ ( @stack ? $stack[-1] : $self )->push_content(
+ $self->{'_element_class'}->new(
+ '~declaration',
+ 'text' => join ' ',
+ 'DOCTYPE', @_
+ )
+ );
+ return;
+ },
+
+ 'Entity' => sub {
+ return unless $self->{'_store_declarations'};
+ shift;
+ ( @stack ? $stack[-1] : $self )->push_content(
+ $self->{'_element_class'}->new(
+ '~declaration',
+ 'text' => join ' ',
+ 'ENTITY', @_
+ )
+ );
+ return;
+ },
+ },
+ 'NoExpand' => $self->{'NoExpand'},
+ 'ErrorContext' => $self->{'ErrorContext'},
+ );
+
+ return $self;
+}
+
#==========================================================================
-sub _elem # universal accessor...
+sub _elem # universal accessor...
{
- my($self, $elem, $val) = @_;
- my $old = $self->{$elem};
- $self->{$elem} = $val if defined $val;
- return $old;
-}
-
-sub store_comments { shift->_elem('_store_comments', @_); }
-sub store_declarations { shift->_elem('_store_declarations', @_); }
-sub store_pis { shift->_elem('_store_pis', @_); }
+ my ( $self, $elem, $val ) = @_;
+ my $old = $self->{$elem};
+ $self->{$elem} = $val if defined $val;
+ return $old;
+}
+
+sub store_comments { shift->_elem( '_store_comments', @_ ); }
+sub store_declarations { shift->_elem( '_store_declarations', @_ ); }
+sub store_pis { shift->_elem( '_store_pis', @_ ); }
#==========================================================================
sub parse {
- shift->{'_xml_parser'}->parse(@_);
-}
-
-sub parse_file { shift->parsefile(@_) } # alias
+ shift->{'_xml_parser'}->parse(@_);
+}
+
+sub parse_file { shift->parsefile(@_) } # alias
sub parsefile {
- shift->{'_xml_parser'}->parsefile(@_);
+ shift->{'_xml_parser'}->parsefile(@_);
}
sub eof {
- delete shift->{'_xml_parser'}; # sure, why not?
+ delete shift->{'_xml_parser'}; # sure, why not?
}
#==========================================================================
@@ -149,7 +209,7 @@
=head1 SYNOPSIS
foreach my $file_name (@ARGV) {
- my $tree = XML::TreeBuilder->new; # empty tree
+ my $tree = XML::TreeBuilder->new({ 'NoExpand' => 0, 'ErrorContext' => 0 }); # empty tree
$tree->parse_file($file_name);
print "Hey, here's a dump of the parse tree of $file_name:\n";
$tree->dump; # a method we inherit from XML::Element
@@ -205,6 +265,26 @@
Construct a new XML::TreeBuilder object.
+Parameters:
+
+=over
+
+=item NoExpand
+
+ Passed to XML::Parser. Do not Expand external entities.
+ Deafult: undef
+
+=item ErrorContext
+
+ Passed to XML::Parser. Number of context lines to generate on errors.
+ Deafult: undef
+
+=back
+
+=item $root->eof
+
+Deletes parser object.
+
=item $root->parse(...options...)
Uses XML::Parser's C<parse> method to parse XML from the source(s?)
Modified: branches/upstream/libxml-treebuilder-perl/current/t/00about.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libxml-treebuilder-perl/current/t/00about.t?rev=70511&op=diff
==============================================================================
--- branches/upstream/libxml-treebuilder-perl/current/t/00about.t (original)
+++ branches/upstream/libxml-treebuilder-perl/current/t/00about.t Sat Mar 5 19:05:26 2011
@@ -1,104 +1,116 @@
+#!/usr/bin/perl -T
-require 5;
-# Time-stamp: "2004-06-10 20:02:08 ADT"
+use warnings;
+use strict;
# Summary of, well, things.
-use strict;
use Test;
my @modules;
+
BEGIN {
- @modules = qw(
+ @modules = qw(
-XML::TreeBuilder
+ XML::TreeBuilder
- );
- plan tests => 2 + @modules;
-};
+ );
+ plan tests => 2 + @modules;
+}
ok 1;
#chdir "t" if -e "t";
foreach my $m (@modules) {
- print "# Loading $m ...\n";
- eval "require $m;";
- unless($@) { ok 1; next }
- my $e = $@;
- $e =~ s/\s+$//s;
- $e =~ s/[\n\r]+/\n# > /;
- print "# Error while trying to load $m --\n# > $e\n";
- ok 0;
+ print "# Loading $m ...\n";
+ eval "require $m;";
+ unless ($@) { ok 1; next }
+ my $e = $@;
+ $e =~ s/\s+$//s;
+ $e =~ s/[\n\r]+/\n# > /;
+ print "# Error while trying to load $m --\n# > $e\n";
+ ok 0;
}
{
- my @out;
- push @out,
- "\n\nPerl v",
- defined($^V) ? sprintf('%vd', $^V) : $],
- " under $^O ",
- (defined(&Win32::BuildNumber) and defined &Win32::BuildNumber())
- ? ("(Win32::BuildNumber ", &Win32::BuildNumber(), ")") : (),
- (defined $MacPerl::Version)
- ? ("(MacPerl version $MacPerl::Version)") : (),
- "\n"
- ;
+ my @out;
+ push @out,
+ "\n\nPerl v",
+ defined($^V) ? sprintf( '%vd', $^V ) : $],
+ " under $^O ",
+ ( defined(&Win32::BuildNumber) and defined &Win32::BuildNumber() )
+ ? ( "(Win32::BuildNumber ", &Win32::BuildNumber(), ")" )
+ : (),
+ ( defined $MacPerl::Version )
+ ? ("(MacPerl version $MacPerl::Version)")
+ : (),
+ "\n";
- # Ugly code to walk the symbol tables:
- my %v;
- my @stack = (''); # start out in %::
- my $this;
- my $count = 0;
- my $pref;
- while(@stack) {
- $this = shift @stack;
- die "Too many packages?" if ++$count > 1000;
- next if exists $v{$this};
- next if $this eq 'main'; # %main:: is %::
+ # Ugly code to walk the symbol tables:
+ my %v;
+ my @stack = (''); # start out in %::
+ my $this;
+ my $count = 0;
+ my $pref;
+ while (@stack) {
+ $this = shift @stack;
+ die "Too many packages?" if ++$count > 1000;
+ next if exists $v{$this};
+ next if $this eq 'main'; # %main:: is %::
- #print "Peeking at $this => ${$this . '::VERSION'}\n";
- no strict 'refs';
- if( defined ${$this . '::VERSION'} ) {
- $v{$this} = ${$this . '::VERSION'}
- } elsif(
- defined *{$this . '::ISA'} or defined &{$this . '::import'}
- or ($this ne '' and grep defined *{$_}{'CODE'}, values %{$this . "::"})
- # If it has an ISA, an import, or any subs...
- ) {
- # It's a class/module with no version.
- $v{$this} = undef;
- } else {
- # It's probably an unpopulated package.
- ## $v{$this} = '...';
+ #print "Peeking at $this => ${$this . '::VERSION'}\n";
+ no strict 'refs';
+ if ( defined ${ $this . '::VERSION' } ) {
+ $v{$this} = ${ $this . '::VERSION' };
+ }
+ elsif (
+ defined *{ $this . '::ISA' }
+ or defined &{ $this . '::import' }
+ or ( $this ne '' and grep defined *{$_}{'CODE'},
+ values %{ $this . "::" } )
+
+ # If it has an ISA, an import, or any subs...
+ )
+ {
+
+ # It's a class/module with no version.
+ $v{$this} = undef;
+ }
+ else {
+
+ # It's probably an unpopulated package.
+ ## $v{$this} = '...';
+ }
+
+ $pref = length($this) ? "$this\::" : '';
+ push @stack, map m/^(.+)::$/ ? "$pref$1" : (),
+ do { no strict 'refs'; keys %{ $this . '::' } };
+
+ #print "Stack: @stack\n";
}
-
- $pref = length($this) ? "$this\::" : '';
- push @stack, map m/^(.+)::$/ ? "$pref$1" : (),
- do { no strict 'refs'; keys %{$this . '::'} };
- #print "Stack: @stack\n";
- }
- push @out, " Modules in memory:\n";
- delete @v{'', '[none]'};
- foreach my $p (sort {lc($a) cmp lc($b)} keys %v) {
- my $indent = ' ' x (2 + ($p =~ tr/:/:/));
- push @out, ' ', $indent, $p, defined($v{$p}) ? " v$v{$p};\n" : ";\n";
- }
- push @out, sprintf "[at %s (local) / %s (GMT)]\n",
- scalar(gmtime), scalar(localtime);
- my $x = join '', @out;
- $x =~ s/^/#/mg;
- print $x;
+ push @out, " Modules in memory:\n";
+ delete @v{ '', '[none]' };
+ foreach my $p ( sort { lc($a) cmp lc($b) } keys %v ) {
+ my $indent = ' ' x ( 2 + ( $p =~ tr/:/:/ ) );
+ push @out, ' ', $indent, $p,
+ defined( $v{$p} ) ? " v$v{$p};\n" : ";\n";
+ }
+ push @out, sprintf "[at %s (local) / %s (GMT)]\n",
+ scalar(gmtime), scalar(localtime);
+ my $x = join '', @out;
+ $x =~ s/^/#/mg;
+ print $x;
}
print "# Running",
- (chr(65) eq 'A') ? " in an ASCII world.\n" : " in a non-ASCII world.\n",
- "#\n",
-;
+ ( chr(65) eq 'A' ) ? " in an ASCII world.\n" : " in a non-ASCII world.\n",
+ "#\n",
+ ;
-print "# \@INC:\n", map("# [$_]\n", @INC), "#\n#\n";
+print "# \@INC:\n", map( "# [$_]\n", @INC ), "#\n#\n";
print "# \%INC:\n";
-foreach my $x (sort {lc($a) cmp lc($b)} keys %INC) {
- print "# [$x] = [", $INC{$x} || '', "]\n";
+foreach my $x ( sort { lc($a) cmp lc($b) } keys %INC ) {
+ print "# [$x] = [", $INC{$x} || '', "]\n";
}
ok 1;
Modified: branches/upstream/libxml-treebuilder-perl/current/t/10main.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libxml-treebuilder-perl/current/t/10main.t?rev=70511&op=diff
==============================================================================
--- branches/upstream/libxml-treebuilder-perl/current/t/10main.t (original)
+++ branches/upstream/libxml-treebuilder-perl/current/t/10main.t Sat Mar 5 19:05:26 2011
@@ -1,43 +1,36 @@
+#!/usr/bin/perl -T
-# Time-stamp: "2004-06-10 20:22:53 ADT"
+use warnings;
+use strict;
+use Test::More tests => 4;
-use Test;
-BEGIN { plan tests => 3 }
+BEGIN {
+ use_ok('XML::TreeBuilder');
+}
-use XML::TreeBuilder;
-
-print "# Hi, I'm ", __FILE__ , " running XML::TreeBuilder v$XML::TreeBuilder::VERSION\n";
-ok 1;
-
-use strict;
my $x = XML::TreeBuilder->new;
$x->store_comments(1);
$x->store_pis(1);
$x->store_declarations(1);
-$x->parse(
- qq{<!-- myorp --><Gee><foo Id="me" xml:foo="lal">Hello World</foo>} .
- qq{<lor/><!-- foo --></Gee><!-- glarg -->}
+$x->parse(qq{<!-- myorp --><Gee><foo Id="me" xml:foo="lal">Hello World</foo>}
+ . qq{<lor/><!-- foo --></Gee><!-- glarg -->} );
+
+my $y = XML::Element->new_from_lol(
+ [ 'Gee',
+ [ '~comment', { 'text' => ' myorp ' } ],
+ [ 'foo', { 'Id' => 'me', 'xml:foo' => 'lal' }, 'Hello World' ],
+ ['lor'],
+ [ '~comment', { 'text' => ' foo ' } ],
+ [ '~comment', { 'text' => ' glarg ' } ],
+ ]
);
-my $y = XML::Element->new_from_lol(
- ['Gee',
- ['~comment', {'text' => ' myorp '}],
- ['foo', {'Id'=> 'me', 'xml:foo' => 'lal'}, 'Hello World'],
- ['lor'],
- ['~comment', {'text' => ' foo '}],
- ['~comment', {'text' => ' glarg '}],
- ]
-);
+ok( $x->same_as($y) );
-
-ok $x->same_as($y);
-
-unless( $ENV{'HARNESS_ACTIVE'} ) {
- $x->dump;
- $y->dump;
+unless ( $ENV{'HARNESS_ACTIVE'} ) {
+ $x->dump;
+ $y->dump;
}
-
-
#print "\n", $x->as_Lisp_form, "\n";
#print "\n", $x->as_XML, "\n\n";
@@ -45,7 +38,27 @@
$x->delete;
$y->delete;
-ok 1;
-print "# Bye from ", __FILE__, "\n";
+$x = XML::TreeBuilder->new( { NoExpand => 1, ErrorContext => 2 } );
+$x->store_comments(1);
+$x->store_pis(1);
+$x->store_declarations(1);
+$x->parse(qq{<!-- myorp --><Gee><foo Id="me" xml:foo="lal">Hello World</foo>}
+ . qq{<lor/><!-- foo --></Gee><!-- glarg -->} );
+
+$y = XML::Element->new_from_lol(
+ [ 'Gee',
+ [ '~comment', { 'text' => ' myorp ' } ],
+ [ 'foo', { 'Id' => 'me', 'xml:foo' => 'lal' }, 'Hello World' ],
+ ['lor'],
+ [ '~comment', { 'text' => ' foo ' } ],
+ [ '~comment', { 'text' => ' glarg ' } ],
+ ]
+);
+
+ok( $x->same_as($y) );
+
+my $z = XML::TreeBuilder->new( { NoExpand => 1, ErrorContext => 2 } );
+$z->parsefile("t/parse_test.xml");
+like( $z->as_XML(), qr{<p>Here &foo; There</p>}, 'Decoded ampersand' );
__END__
Added: branches/upstream/libxml-treebuilder-perl/current/t/parse_test.xml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libxml-treebuilder-perl/current/t/parse_test.xml?rev=70511&op=file
==============================================================================
--- branches/upstream/libxml-treebuilder-perl/current/t/parse_test.xml (added)
+++ branches/upstream/libxml-treebuilder-perl/current/t/parse_test.xml Sat Mar 5 19:05:26 2011
@@ -1,0 +1,8 @@
+<?xml version='1.0' encoding='utf-8' ?>
+<!DOCTYPE p PUBLIC "-//OASIS//DTD DocBook XML V4.5//EN" "http://www.oasis-open.org/docbook/xml/4.5/docbookx.dtd" [
+
+<!ENTITY % BOOK_ENTITIES SYSTEM "Users_Guide.ent">
+%BOOK_ENTITIES;
+]>
+<p>Here &foo; There</p>
+
Added: branches/upstream/libxml-treebuilder-perl/current/t/zz_perlcritic.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libxml-treebuilder-perl/current/t/zz_perlcritic.t?rev=70511&op=file
==============================================================================
--- branches/upstream/libxml-treebuilder-perl/current/t/zz_perlcritic.t (added)
+++ branches/upstream/libxml-treebuilder-perl/current/t/zz_perlcritic.t Sat Mar 5 19:05:26 2011
@@ -1,0 +1,22 @@
+#!perl -T
+
+use Test::More;
+
+eval "use Test::Perl::Critic";
+
+if ($@) {
+ Test::More::plan( skip_all =>
+ "Test::Perl::Critic required for testing PBP compliance" );
+}
+else {
+ Test::Perl::Critic->import(
+ -verbose => 8,
+ -severity => 5,
+## This check fails to detect a package is modifying
+## objects of it's own class when passing objects in an array
+ -exclude => ['ProhibitAccessOfPrivateData']
+ );
+}
+
+all_critic_ok();
+
Added: branches/upstream/libxml-treebuilder-perl/current/t/zz_pod-coverage.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libxml-treebuilder-perl/current/t/zz_pod-coverage.t?rev=70511&op=file
==============================================================================
--- branches/upstream/libxml-treebuilder-perl/current/t/zz_pod-coverage.t (added)
+++ branches/upstream/libxml-treebuilder-perl/current/t/zz_pod-coverage.t Sat Mar 5 19:05:26 2011
@@ -1,0 +1,7 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage"
+ if $@;
+all_pod_coverage_ok();
Added: branches/upstream/libxml-treebuilder-perl/current/t/zz_pod.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libxml-treebuilder-perl/current/t/zz_pod.t?rev=70511&op=file
==============================================================================
--- branches/upstream/libxml-treebuilder-perl/current/t/zz_pod.t (added)
+++ branches/upstream/libxml-treebuilder-perl/current/t/zz_pod.t Sat Mar 5 19:05:26 2011
@@ -1,0 +1,6 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod 1.14";
+plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
+all_pod_files_ok();
More information about the Pkg-perl-cvs-commits
mailing list