XML-TreeBuilder-5.4000755001750001750 012341476724 14135 5ustar00jfearnjfearn000000000000XML-TreeBuilder-5.4/MANIFEST000444001750001750 41612341476724 15404 0ustar00jfearnjfearn000000000000Build.PL Changes lib/XML/Element.pm lib/XML/TreeBuilder.pm Makefile.PL MANIFEST META.yml Module meta-data (added by MakeMaker) README t/00about.t t/10main.t t/parse_test.xml t/test.ent xt/author/zz_perlcritic.t xt/author/zz_pod-coverage.t xt/author/zz_pod.t META.json XML-TreeBuilder-5.4/META.yml000444001750001750 157312341476724 15551 0ustar00jfearnjfearn000000000000--- abstract: 'XML elements with the same interface as HTML::Element' author: - 'Jeff Fearn ' build_requires: File::Basename: 0 HTML::Element: 4.1 HTML::Tagset: 3.02 IO::File: 0 Module::Build: 0 Test::More: 0 XML::Catalog: 1.02 XML::Parser: 0 configure_requires: Module::Build: 0 dynamic_config: 1 generated_by: 'Module::Build version 0.4004, CPAN::Meta::Converter version 2.120921' 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: 5.4 XML::TreeBuilder: file: lib/XML/TreeBuilder.pm version: 5.4 requires: File::Basename: 0 HTML::Element: 4.1 HTML::Tagset: 3.02 IO::File: 0 XML::Catalog: 1.02 XML::Parser: 0 perl: v5.4.0 resources: license: http://dev.perl.org/licenses/ version: 5.4 XML-TreeBuilder-5.4/Makefile.PL000444001750001750 121212341476724 16240 0ustar00jfearnjfearn000000000000# Note: this file was auto-generated by Module::Build::Compat version 0.4004 require 5.004000; use ExtUtils::MakeMaker; WriteMakefile ( 'PL_FILES' => {}, 'INSTALLDIRS' => 'site', 'NAME' => 'XML::TreeBuilder', 'EXE_FILES' => [], 'VERSION_FROM' => 'lib/XML/Element.pm', 'PREREQ_PM' => { 'XML::Catalog' => '1.02', 'IO::File' => 0, 'HTML::Element' => '4.1', 'Test::More' => 0, 'HTML::Tagset' => '3.02', 'Module::Build' => 0, 'File::Basename' => 0, 'XML::Parser' => 0 } ) ; XML-TreeBuilder-5.4/README000444001750001750 274312341476724 15160 0ustar00jfearnjfearn000000000000XML::TreeBuilder ---------------- This module uses XML::Parser to make XML document trees constructed of XML::Element objects (and XML::Element is a subclass of HTML::Element adapted for XML). XML::TreeBuilder is meant particularly for people who are used to the HTML::TreeBuilder / HTML::Element interface to document trees, and who don't want to learn some other document interface like XML::Twig or XML::DOM. PREREQUISITES In order to install and use this package you will need Perl version 5.004 or better. You will also need to have the XML-Parser and HTML-Tree distributions installed. All of these should be available from CPAN. INSTALLATION Just follow the usual procedure: 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 Build.PL PREFIX=~/perl See perldoc perlmodinstall for more information on installing modules. SUPPORT Questions, bug reports, useful code bits, and suggestions for this module should just be sent to JFEARN@cpan.org or open a ticket in the CPAN RT https://rt.cpan.org//Dist/Display.html?Queue=XML-TreeBuilder AVAILABILITY The latest version of this module is available from the Comprehensive Perl Archive Network (CPAN). Visit to find a CPAN site near you. The source is available on github XML-TreeBuilder-5.4/META.json000444001750001750 305212341476724 15713 0ustar00jfearnjfearn000000000000{ "abstract" : "XML elements with the same interface as HTML::Element", "author" : [ "Jeff Fearn " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4004, CPAN::Meta::Converter version 2.120921", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "XML-TreeBuilder", "prereqs" : { "build" : { "requires" : { "File::Basename" : "0", "HTML::Element" : "4.1", "HTML::Tagset" : "3.02", "IO::File" : "0", "Module::Build" : "0", "Test::More" : "0", "XML::Catalog" : "1.02", "XML::Parser" : "0" } }, "configure" : { "requires" : { "Module::Build" : "0" } }, "runtime" : { "requires" : { "File::Basename" : "0", "HTML::Element" : "4.1", "HTML::Tagset" : "3.02", "IO::File" : "0", "XML::Catalog" : "1.02", "XML::Parser" : "0", "perl" : "v5.4.0" } } }, "provides" : { "XML::Element" : { "file" : "lib/XML/Element.pm", "version" : "5.4" }, "XML::TreeBuilder" : { "file" : "lib/XML/TreeBuilder.pm", "version" : "5.4" } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ] }, "version" : "5.4" } XML-TreeBuilder-5.4/Build.PL000444001750001750 327012341476724 15570 0ustar00jfearnjfearn000000000000use strict; use warnings; use Module::Build; use 5.004; my $class = Module::Build->subclass( class => 'My::Builder', code => q{ sub ACTION_authortest { my ($self) = @_; $self->depends_on('build'); $self->depends_on('manifest'); $self->depends_on('distmeta'); $self->test_files( qw< t xt/author > ); $self->recursive_test_files(1); $self->depends_on('test'); return; } sub ACTION_distdir { my ($self) = @_; $self->depends_on('authortest'); return $self->SUPER::ACTION_distdir(); } } ); my $builder = $class->new( module_name => 'XML::TreeBuilder', license => 'perl', dist_author => 'Jeff Fearn ', dist_version_from => 'lib/XML/Element.pm', create_makefile_pl => 'traditional', configure_requires => { 'Module::Build' => 0 }, build_requires => { 'Module::Build' => 0, 'Test::More' => 0, 'XML::Parser' => 0, 'HTML::Element' => 4.1, 'HTML::Tagset' => 3.02, 'XML::Catalog' => '1.02', 'File::Basename' => 0, 'IO::File' => 0, }, requires => { 'XML::Parser' => 0, 'HTML::Element' => 4.1, 'HTML::Tagset' => 3.02, 'perl' => '5.4.0', 'XML::Catalog' => '1.02', 'File::Basename' => 0, 'IO::File' => 0, }, add_to_cleanup => [ 'XML-TreeBuilder-*', 'tmp', 'blib', 'MANIFEST.bak', 'META.yml' ], script_files => [], ); $builder->create_build_script(); XML-TreeBuilder-5.4/Changes000444001750001750 443012341476724 15566 0ustar00jfearnjfearn000000000000Thu May 29 2014 Jeff Fearn Release 5.4 Do not escape CDATA content. Tue May 27 2014 Jeff Fearn Release 5.3 Fix CDATA not being printed properly by as_XML. RT #95970 Fix Devel::Cover declared as build_requires but not used RT #93155 Fix XML::Catalog version number mismatch. RT #93154 Mon Dec 9 2013 Jeff Fearn Release 5.2 Fix local path resolution. RT #90464 Mon Oct 28 2013 Jeff Fearn Release 5.1 Fix entities in attributes only working for root node. RT #89402 Thu Oct 03 2013 Jeff Fearn Release 5.0 Add support for using XML Catalogs. (related to RT #87010) Add support for expanding entities. perl tidy FTW Remove xt/ deps from Build.PL. RT #78039 Doc typo fixes. RT #66404 Error out if args to new are not in a hash. RT #70654 Add logic to keep entities in attributes when NoExpand is set. RT #88973 Jul 17 2013 Jeff Fearn Release 4.3 Hard code VERSION in TreeBuilder.pm for PAUSE. RT #86964 Jul 15 2013 Jeff Fearn Release 4.2 Added store_cdata to handle CDATA. More test coverage. Mar 13 2011 Jeff Fearn Release 4.1 Doc typo fixes. (Ansgar Burchardt) RT #66404 Use same version in all packages for CPAN indexing. RT #66111 Moved perlcritic tests to xt/author Fix Authors in all PM files Nov 24 2010 Jeff Fearn 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 Release 3.09 -- maintenance release. Just making the dist and the docs a bit tidier -- no actual code changes. Also modernized the tests just a bit. 2000-11-03 Sean M. Burke Release 3.08 First release version. XML-TreeBuilder-5.4/t000755001750001750 012341476724 14400 5ustar00jfearnjfearn000000000000XML-TreeBuilder-5.4/t/10main.t000555001750001750 555012341476724 16017 0ustar00jfearnjfearn000000000000#!/usr/bin/perl -T use warnings; use strict; use Test::More tests => 8; BEGIN { use_ok('XML::TreeBuilder'); } my $x = XML::TreeBuilder->new; $x->store_comments(1); $x->store_pis(1); $x->store_declarations(1); $x->parse(qq{Hello World} . qq{} ); 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), "same as" ); unless ( $ENV{'HARNESS_ACTIVE'} ) { $x->dump; $y->dump; } #print "\n", $x->as_Lisp_form, "\n"; #print "\n", $x->as_XML, "\n\n"; #print "\n", $y->as_XML, "\n\n"; $x->delete; $y->delete; $x = XML::TreeBuilder->new( { NoExpand => 1, ErrorContext => 2 } ); $x->store_comments(1); $x->store_pis(1); $x->store_declarations(1); $x->parse(qq{Hello World} . qq{} ); $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), "same as" ); my $z = XML::TreeBuilder->new( { NoExpand => 1, ErrorContext => 2 } ); $z->store_cdata(1); $z->parsefile("t/parse_test.xml"); is( $z->as_XML(), q{

Here &foo; There &foo;

}, 'Decoded ampersand and cdata' ); $z->delete_ignorable_whitespace(); my $za = XML::TreeBuilder->new( { NoExpand => 1, ErrorContext => 2 } ); $za->store_declarations(1); $za->store_pis(1); $za->store_declarations(1); $za->parse( qq{ ]> Here &foo; There } ); ## BUGBUG isn't this backwards and the DOCTYPE should be before the 'para' tag? like( $za->as_XML(), qr{Here &foo; There}, 'Entities' ); eval { my $xf = XML::TreeBuilder->new( NoExpand => 1 ); }; like( $@, qr/new expects an anonymous hash.* for it's parameters, not a/, 'new expects a hash' ); ok( $x->same_as($y), "same as" ); my $zb = XML::TreeBuilder->new( { NoExpand => 0, ErrorContext => 2 } ); $zb->parse_file("t/parse_test.xml"); like( $zb->as_XML(), qr{

Here &foo; There\n\n&foo;\n\nThis is FOO\n

}, 'Expand entity' ); __END__ XML-TreeBuilder-5.4/t/parse_test.xml000444001750001750 26412341476724 17412 0ustar00jfearnjfearn000000000000 %MY_ENTITIES; ]>

Here &foo; There &foo;

XML-TreeBuilder-5.4/t/00about.t000444001750001750 546612341476724 16207 0ustar00jfearnjfearn000000000000#!/usr/bin/perl -T use warnings; use strict; # Summary of, well, things. use Test; my @modules; BEGIN { @modules = qw( XML::TreeBuilder ); 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; } { my @out; push @out, "\n\nPerl v", defined($^V) ? sprintf( '%vd', $^V ) : $], " under $^O ", ( defined(&Win32::BuildNumber) and defined &Win32::BuildNumber() ) ? ( "(Win32::BuildNumber ", &Win32::BuildNumber(), ")" ) : (), ( defined $MacPerl::Version ) ? ("(MacPerl version $MacPerl::Version)") : (), "\n"; # Ugly code to walk the symbol tables: my %v; my @stack = (''); # start out in %:: my $this; my $count = 0; my $pref; while (@stack) { $this = shift @stack; die "Too many packages?" if ++$count > 1000; next if exists $v{$this}; next if $this eq 'main'; # %main:: is %:: #print "Peeking at $this => ${$this . '::VERSION'}\n"; no strict 'refs'; if ( defined ${ $this . '::VERSION' } ) { $v{$this} = ${ $this . '::VERSION' }; } elsif ( defined *{ $this . '::ISA' } or defined &{ $this . '::import' } or ( $this ne '' and grep defined *{$_}{'CODE'}, values %{ $this . "::" } ) # If it has an ISA, an import, or any subs... ) { # It's a class/module with no version. $v{$this} = undef; } else { # It's probably an unpopulated package. ## $v{$this} = '...'; } $pref = length($this) ? "$this\::" : ''; push @stack, map m/^(.+)::$/ ? "$pref$1" : (), do { no strict 'refs'; keys %{ $this . '::' } }; #print "Stack: @stack\n"; } push @out, " Modules in memory:\n"; delete @v{ '', '[none]' }; foreach my $p ( sort { lc($a) cmp lc($b) } keys %v ) { my $indent = ' ' x ( 2 + ( $p =~ tr/:/:/ ) ); push @out, ' ', $indent, $p, defined( $v{$p} ) ? " v$v{$p};\n" : ";\n"; } push @out, sprintf "[at %s (local) / %s (GMT)]\n", scalar(gmtime), scalar(localtime); my $x = join '', @out; $x =~ s/^/#/mg; print $x; } print "# Running", ( chr(65) eq 'A' ) ? " in an ASCII world.\n" : " in a non-ASCII world.\n", "#\n", ; print "# \@INC:\n", map( "# [$_]\n", @INC ), "#\n#\n"; print "# \%INC:\n"; foreach my $x ( sort { lc($a) cmp lc($b) } keys %INC ) { print "# [$x] = [", $INC{$x} || '', "]\n"; } ok 1; XML-TreeBuilder-5.4/t/test.ent000444001750001750 7112341476724 16162 0ustar00jfearnjfearn000000000000 XML-TreeBuilder-5.4/lib000755001750001750 012341476724 14703 5ustar00jfearnjfearn000000000000XML-TreeBuilder-5.4/lib/XML000755001750001750 012341476724 15343 5ustar00jfearnjfearn000000000000XML-TreeBuilder-5.4/lib/XML/Element.pm000444001750001750 1607512341476724 17460 0ustar00jfearnjfearn000000000000require 5; package XML::Element; use warnings; use strict; use HTML::Tagset (); use HTML::Element 4.1 (); use Carp; use vars qw(@ISA $VERSION); $VERSION = '5.4'; @ISA = ('HTML::Element'); # Init: my %emptyElement = (); foreach my $e (%HTML::Tagset::emptyElement) { $emptyElement{$e} = 1 if substr( $e, 0, 1 ) eq '~' and $HTML::Tagset::emptyElement{$e}; } my $in_cdata = 0; my $nillio = []; #-------------------------------------------------------------------------- #Some basic overrides: sub _empty_element_map { \%emptyElement } *_fold_case = \&HTML::Element::_fold_case_NOT; *starttag = \&starttag_XML; *endtag = \&endtag_XML; *encoded_content = \$HTML::Element::encoded_content; *_xml_escape = \&HTML::Element::_xml_escape; # TODO: override id with something that looks for xml:id too/instead? #-------------------------------------------------------------------------- #TODO: test and document this: # with no tagname set, assumes ALL all-whitespace nodes are ignorable! 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. } } } unshift @to_do, grep ref($_), @$children; # recurse } return; } ## copied from HTML::Element to support CDATDA sub starttag_XML { my ($self) = @_; # and a third parameter to signal emptiness? my $name = $self->{'_tag'}; return $self->{'text'} if $name eq '~literal'; return '{'text'} . '>' if $name eq '~declaration'; return "{'text'} . "?>" if $name eq '~pi'; if ( $name eq '~comment' ) { if ( ref( $self->{'text'} || '' ) eq 'ARRAY' ) { # Does this ever get used? And is this right? $name = join( ' ', @{ $self->{'text'} } ); } else { $name = $self->{'text'}; } $name =~ s/--/--/g; # can't have double --'s in XML comments return ""; } if ( $name eq '~cdata' ) { $in_cdata = 1; return "{$_} ); # or ref $val; _xml_escape($val); $tag .= qq{ $_="$val"}; } @_ == 3 ? "$tag />" : "$tag>"; } ## copied from HTML::Element to support CDATDA sub endtag_XML { my ($self) = @_; # and a third parameter to signal emptiness? my $name = $self->{'_tag'}; if ( $name eq '~cdata' ) { $in_cdata = 0; return "]]>"; } "{'_tag'}>"; } ## copied from HTML::Element to support CDATDA sub as_XML { my ($self) = @_; #my $indent_on = defined($indent) && length($indent); my @xml = (); my $empty_element_map = $self->_empty_element_map; my ( $tag, $node, $start ); # per-iteration scratch $self->traverse( sub { ( $node, $start ) = @_; if ( ref $node ) { # it's an element $tag = $node->{'_tag'}; if ($start) { # on the way in foreach my $attr ( $node->all_attr_names() ) { croak("$tag has an invalid attribute name '$attr'") unless ( $attr eq '/' || $self->_valid_name($attr) ); } if ( $empty_element_map->{$tag} and !@{ $node->{'_content'} || $nillio } ) { push( @xml, $node->starttag_XML( undef, 1 ) ); } else { push( @xml, $node->starttag_XML(undef) ); } } else { # on the way out unless ( $empty_element_map->{$tag} and !@{ $node->{'_content'} || $nillio } ) { push( @xml, $node->endtag_XML() ); } # otherwise it will have been an <... /> tag. } } else { # it's just text _xml_escape($node) unless ($in_cdata); push( @xml, $node ); } 1; # keep traversing } ); join( '', @xml, "\n" ); } #-------------------------------------------------------------------------- 1; __END__ =head1 NAME XML::Element - XML elements with the same interface as HTML::Element =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 endtag_XML =head2 starttag Redirects to starttag_XML =head2 as_XML $s = $doc->as_XML() Returns a string representing in XML the element and its descendants. =head2 starttag_XML $start = $doc->starttag_XML(); Returns a string representing the complete start tag for the element. Except for CDATA. =head2 endtag_XML $end = $doc->endtag_XML(); Returns a string representing the complete end tag for this element. I.e., "". Except for CDATA. =head1 DESCRIPTION This is just a subclass of HTML::Element. It works basically the same as HTML::Element, except that tagnames and attribute names aren't forced to lowercase, as they are in HTML::Element. L describes everything you can do with this class. =head1 CAVEATS Has currently no handling of namespaces. =head1 SEE ALSO L for a class that actually builds XML::Element structures. L for all documentation. L and L for other XML document tree interfaces. L for more fun. =head1 COPYRIGHT AND DISCLAIMERS Copyright (c) 2000,2004 Sean M. Burke. All rights reserved. Copyright (c) 2010,2011,2013 Jeff Fearn. All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. This program is distributed in the hope that it will be useful, but without any warranty; without even the implied warranty of merchantability or fitness for a particular purpose. =head1 AUTHOR Current Author: Jeff Fearn Ejfearn@cpan.orgE. Former Authors: Sean M. Burke, Esburke@cpan.orgE =cut XML-TreeBuilder-5.4/lib/XML/TreeBuilder.pm000444001750001750 3514312341476724 20272 0ustar00jfearnjfearn000000000000require 5; package XML::TreeBuilder; use warnings; use strict; use XML::Element (); use XML::Parser (); use Carp; use IO::File; use XML::Catalog 1.02; use File::Basename; use File::Spec; use vars qw(@ISA $VERSION); $VERSION = '5.4'; @ISA = ('XML::Element'); #========================================================================== sub new { my ( $this, $arg ) = @_; my $class = ref($this) || $this; if ( $arg && ( ref($arg) ne 'HASH' ) ) { croak( q|new expects an anonymous hash, $t->new( { NoExpand => 1, ErrorContext => 2 } ), for it's parameters, not a | . ref($arg) ); } my $NoExpand = ( delete $arg->{NoExpand} || undef ); my $ErrorContext = ( delete $arg->{ErrorContext} || undef ); my $catalog = ( delete $arg->{catalog} || $ENV{XML_CATALOG_FILES} || '/etc/xml/catalog' ); my $debug = ( delete $arg->{debug} || 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->{_store_cdata} = 0; # 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 ( ($NoExpand) && ( $_[1] =~ /&[^\;]+\;/ ) ) { $stack[-1]->push_content( $_[1] ); } return; }, Start => sub { my $xp = shift; my $str = $xp->original_string(); if (@stack) { my @args; my $tag = shift(@_); while (@_) { my ( $attr, $val ) = splice( @_, 0, 2 ); ## BUGBUG This dirty hack is because the $val from XML::Parser isn't correct when $NoExpand is set ... can we fix it? ## any entity in an attribute is lost ## given $val is "this--attr" not "this-&FOO;-attr" if ( $NoExpand && $str =~ /\s$attr="([^"]*\&[^"]*)"/ ) { $val = $1; } push( @args, $attr, $val ); } unshift( @args, $tag ); push @stack, $self->{_element_class}->new(@args); $stack[-2]->push_content( $stack[-1] ); } else { $self->tag(shift); while (@_) { my ( $attr, $val ) = splice( @_, 0, 2 ); ## BUGBUG This dirty hack is because the $val from XML::Parser isn't correct when $NoExpand is set ... can we fix it? ## any entity in an attribute is lost ## given $val is "this--attr" not "this-&FOO;-attr" if ( $NoExpand && $str =~ /\s$attr="([^"]*\&[^"]*)"/ ) { $val = $1; } $self->attr( $attr, $val ); } 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 $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; }, # 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; ## Need this because different types set different array entries. no warnings 'uninitialized'; ( @stack ? $stack[-1] : $self )->push_content( $self->{_element_class}->new( '~declaration', 'text' => join( ' ', ( 'DOCTYPE', @_ ) ), type => 'DOCTYPE', mytag => $_[0], uri => $_[1], pid => $_[2], ) ); return; }, Entity => sub { return unless $self->{_store_declarations}; shift; ## Need this because different entity types set different array entries. no warnings 'uninitialized'; ( @stack ? $stack[-1] : $self )->push_content( $self->{_element_class}->new( '~declaration', 'text' => join( ' ', ( 'ENTITY', @_ ) ), type => 'ENTITY', name => $_[0], value => $_[1], ) ); return; }, CdataStart => sub { return unless $self->{_store_cdata}; shift; push @stack, $self->{_element_class}->new( '~cdata', 'text' => $_[1] ); $stack[-2]->push_content( $stack[-1] ); return; }, CdataEnd => sub { return unless $self->{_store_cdata}; pop @stack; return; }, ExternEnt => sub { return if ($NoExpand); my $xp = shift; my ( $base, $sysid, $pubid ) = @_; my $file = "$sysid"; if ( $sysid =~ /^http:/ ) { ## BUGBUG need to catch when there is no local file my $cat = XML::Catalog->new($catalog); $file = $cat->resolve_public($pubid); croak("Can't resolve '$pubid'") if ( !defined($file) || $file eq '' ); $file =~ s/^file:\/\///; my ( $filename, $directories, $suffix ) = fileparse($file); $base = $directories; } else { $sysid =~ s/^file:\/\/// if ( $sysid =~ /^file:/ ); if ( File::Spec->file_name_is_absolute($sysid) ) { my ( $filename, $directories, $suffix ) = fileparse($sysid); $base = $directories; } else { my ( $filename, $directories, $suffix ) = fileparse($base); $file = File::Spec->rel2abs( $sysid, $directories ); } } my $fh = new IO::File( $file, "r" ); croak "$!" unless $fh; $xp->{_BaseStack} ||= []; $xp->{_FhStack} ||= []; push( @{ $xp->{_BaseStack} }, $base ); push( @{ $xp->{_FhStack} }, $fh ); $xp->base($base); return ($fh); }, ExternEntFin => sub { return if ($NoExpand); my ($xp) = shift; my $fh = pop( @{ $xp->{_FhStack} } ); $fh->close if ($fh); my $base = pop( @{ $xp->{_BaseStack} } ); $xp->base($base) if ($base); return; }, }, NoExpand => $NoExpand, ErrorContext => $ErrorContext, ParseParamEnt => !$NoExpand, NoLWP => 0, ); return $self; } #========================================================================== 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', @_ ); } sub store_cdata { shift->_elem( '_store_cdata', @_ ); } #========================================================================== sub parse { shift->{_xml_parser}->parse(@_); } sub parse_file { shift->parsefile(@_) } # alias sub parsefile { shift->{_xml_parser}->parsefile(@_); } sub eof { delete shift->{_xml_parser}; # sure, why not? } #========================================================================== 1; __END__ =head1 NAME XML::TreeBuilder - Parser that builds a tree of XML::Element objects =head1 SYNOPSIS foreach my $file_name (@ARGV) { 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 print "And here it is, bizarrely rerendered as XML:\n", $tree->as_XML, "\n"; # Now that we're done with it, we must destroy it. $tree = $tree->delete; } =head1 DESCRIPTION This module uses XML::Parser to make XML document trees constructed of XML::Element objects (and XML::Element is a subclass of HTML::Element adapted for XML). XML::TreeBuilder is meant particularly for people who are used to the HTML::TreeBuilder / HTML::Element interface to document trees, and who don't want to learn some other document interface like XML::Twig or XML::DOM. The way to use this class is to: 1. start a new (empty) XML::TreeBuilder object. 2. set any of the "store" options you want. 3. then parse the document from a source by calling C<$x-Eparsefile(...)> or C<$x-Eparse(...)> (See L docs for the options that these two methods take) 4. do whatever you need to do with the syntax tree, presumably involving traversing it looking for some bit of information in it, 5. and finally, when you're done with the tree, call $tree->delete to erase the contents of the tree from memory. This kind of thing usually isn't necessary with most Perl objects, but it's necessary for TreeBuilder objects. See L for a more verbose explanation of why this is the case. =head1 METHODS AND ATTRIBUTES XML::TreeBuilder is a subclass of XML::Element, which in turn is a subclass of HTML:Element. You should read and understand the documentation for those two modules. An XML::TreeBuilder object is just a special XML::Element object that allows you to call these additional methods: =over =item $root = XML::TreeBuilder->new() Construct a new XML::TreeBuilder object. Parameters: =over =item NoExpand Passed to XML::Parser. Do not Expand external entities. Default: undef =item ErrorContext Passed to XML::Parser. Number of context lines to generate on errors. Default: undef =item catalog Path to an Oasis XML catalog. Passed to XML::Catalog to resolve entities if NoExpand is not set. Default: $ENV{XML_CATALOG_FILES} || '/etc/xml/catalog' =back =item $root->eof Deletes parser object. =item $root->parse(...options...) Uses XML::Parser's C method to parse XML from the source(s?) specified by the options. See L =item $root->parsefile(...options...) Uses XML::Parser's C method to parse XML from the source(s?) specified by the options. See L =item $root->parse_file(...options...) Simply an alias for C. =item $root->store_comments(value) This determines whether TreeBuilder will normally store comments found while parsing content into C<$root>. Currently, this is off by default. =item $root->store_declarations(value) This determines whether TreeBuilder will normally store markup declarations found while parsing content into C<$root>. Currently, this is off by default. =item $root->store_pis(value) This determines whether TreeBuilder will normally store processing instructions found while parsing content into C<$root>. Currently, this is off (false) by default. =item $root->store_cdata(value) This determines whether TreeBuilder will normally store CDATA sectitons found while parsing content into C<$root>. Adds a ~cdata node. Currently, this is off (false) by default. =back =head1 SEE ALSO L, L, L, L. And for alternate XML document interfaces, L and L. =head1 COPYRIGHT AND DISCLAIMERS Copyright (c) 2000,2004 Sean M. Burke. All rights reserved. Copyright (c) 2010,2011,2013 Jeff Fearn. All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. This program is distributed in the hope that it will be useful, but without any warranty; without even the implied warranty of merchantability or fitness for a particular purpose. =head1 AUTHOR Current Author: Jeff Fearn Ejfearn@cpan.orgE. Former Authors: Sean M. Burke, Esburke@cpan.orgE =cut XML-TreeBuilder-5.4/xt000755001750001750 012341476724 14570 5ustar00jfearnjfearn000000000000XML-TreeBuilder-5.4/xt/author000755001750001750 012341476724 16072 5ustar00jfearnjfearn000000000000XML-TreeBuilder-5.4/xt/author/zz_pod-coverage.t000444001750001750 26012341476724 21470 0ustar00jfearnjfearn000000000000#!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(); XML-TreeBuilder-5.4/xt/author/zz_pod.t000444001750001750 21412341476724 17676 0ustar00jfearnjfearn000000000000#!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(); XML-TreeBuilder-5.4/xt/author/zz_perlcritic.t000444001750001750 71412341476724 21261 0ustar00jfearnjfearn000000000000#!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();