Hello community, here is the log from the commit of package perl-XML-Twig for openSUSE:Factory checked in at 2013-06-06 15:06:28 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/perl-XML-Twig (Old) and /work/SRC/openSUSE:Factory/.perl-XML-Twig.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-XML-Twig" Changes: -------- --- /work/SRC/openSUSE:Factory/perl-XML-Twig/perl-XML-Twig.changes 2013-04-23 11:38:10.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.perl-XML-Twig.new/perl-XML-Twig.changes 2013-06-06 15:06:30.000000000 +0200 @@ -1,0 +2,22 @@ +Tue Jun 4 17:10:56 UTC 2013 - [email protected] + +- updated to 3.44 + # minor maintenance release + added: XML::Twig::Elt new method now acccepts literal content, eg + my $e= XML::Twig::Elt->new( '<div><p>foo</p><p>bar</p></div>'); + fixed: merge had some problems dealing with embedded comments + improved: more tests + + improved: docs for parse, see RT #78877 + https://rt.cpan.org/Ticket/Display.html?id=78877 + fixed: xml_pp -i now preserves the permissions of the + original file, see RT #81165 + https://rt.cpan.org/Ticket/Display.html?id=81165 + reported by Alberto Simoes + fixed: RT #80503 Newlines in attribute values + https://rt.cpan.org/Ticket/Display.html?id=80503 + reported (and explained) by Ambrus Zsban: \r, \n + and \n explicitely set in attribute values should + be escaped (with &#x<nb>;) when output + +------------------------------------------------------------------- Old: ---- XML-Twig-3.42.tar.gz New: ---- XML-Twig-3.44.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ perl-XML-Twig.spec ++++++ --- /var/tmp/diff_new_pack.X9mMgA/_old 2013-06-06 15:06:31.000000000 +0200 +++ /var/tmp/diff_new_pack.X9mMgA/_new 2013-06-06 15:06:31.000000000 +0200 @@ -17,13 +17,21 @@ Name: perl-XML-Twig -Version: 3.42 +Version: 3.44 Release: 0 -Summary: Tree interface to XML documents -License: GPL-1.0+ or Artistic-1.0 +%define cpan_name XML-Twig +Summary: A perl module for processing huge XML documents in tree mode. +License: Artistic-1.0 or GPL-1.0+ Group: Development/Libraries/Perl -Url: http://search.cpan.org/dist/XML::Twig -Source: http://search.cpan.org/CPAN/authors/id/M/MI/MIROD/XML-Twig-%{version}.tar.gz +Url: http://search.cpan.org/dist/XML-Twig/ +Source: http://www.cpan.org/authors/id/M/MI/MIROD/%{cpan_name}-%{version}.tar.gz +BuildArch: noarch +BuildRoot: %{_tmppath}/%{name}-%{version}-build +BuildRequires: perl +BuildRequires: perl-macros +BuildRequires: perl(XML::Parser) >= 2.23 +#BuildRequires: perl(xmlxpath_tools) +Requires: perl(XML::Parser) >= 2.23 BuildRequires: expat BuildRequires: perl-HTML-Tidy BuildRequires: perl-IO-CaptureOutput @@ -37,8 +45,6 @@ BuildRequires: perl-XML-Simple BuildRequires: perl-XML-XPath BuildRequires: perl-XML-XPathEngine -BuildRequires: perl-macros - Requires: expat Requires: perl-XML-Parser Requires: perl(Encode) @@ -49,53 +55,43 @@ Recommends: perl-XML-XPath Recommends: perl-XML-XPathEngine -BuildRoot: %{_tmppath}/%{name}-%{version}-build %{perl_requires} %description -XML::Twig is (yet another!) XML transformation module. +This module provides a way to process XML documents. It is build on top of +'XML::Parser'. + +The module offers a tree interface to the document, while allowing you to +output the parts of it that have been completely processed. -Its strong points: can be used to process huge documents while still -being in tree mode; not bound by DOM or SAX, so it is very perlish and -offers a very comprehensive set of methods; simple to use; DWIMs as -much as possible - -What it doesn't offer: full SAX support (it can export SAX, but only -reads XML), full XPath support (unless you use XML::Twig::XPath), nor -DOM support. - -Other drawbacks: it is a big module, and with over 500 methods -available it can be a bit overwhelming. A good starting point is the -tutorial at http://xmltwig.com/xmltwig/tutorial/index.html. In fact the -whole XML::Twig page at http://xmltwig.com/xmltwig/ has plenty of -information to get you started with XML::Twig +It allows minimal resource (CPU and memory) usage by building the tree only +for the parts of the documents that need actual processing, through the use +of the 'the twig_roots manpage ' and 'the twig_print_outside_roots manpage +' options. The 'the finish manpage ' and 'the finish_print manpage ' +methods also help to increase performances. + +XML::Twig tries to make simple things easy so it tries its best to takes +care of a lot of the (usually) annoying (but sometimes necessary) features +that come with XML and XML::Parser. %prep -%setup -q -n XML-Twig-%{version} +%setup -q -n %{cpan_name}-%{version} +find . -type f -print0 | xargs -0 chmod 644 %build -perl Makefile.PL -make +%{__perl} Makefile.PL INSTALLDIRS=vendor +%{__make} %{?_smp_mflags} %check -make test +%{__make} test %install %perl_make_install %perl_process_packlist +%perl_gen_filelist -%files -%defattr(-,root,root) -%doc Changes README -%dir %{perl_vendorlib}/XML -%{perl_vendorlib}/XML/Twig.pm -%{perl_vendorlib}/XML/Twig -%{_bindir}/xml_grep -%{_bindir}/xml_merge -%{_bindir}/xml_pp -%{_bindir}/xml_spellcheck -%{_bindir}/xml_split -%doc %{_mandir}/man1/xml_*.1%{ext_man} -%doc %{_mandir}/man3/XML::Twig.%{perl_man3ext}%{ext_man} +%files -f %{name}.files +%defattr(-,root,root,755) +%doc Changes check_optional_modules filter_for_5.005 README speedup Twig_pm.slow %changelog ++++++ XML-Twig-3.42.tar.gz -> XML-Twig-3.44.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/XML-Twig-3.42/Changes new/XML-Twig-3.44/Changes --- old/XML-Twig-3.42/Changes 2012-11-07 10:09:16.000000000 +0100 +++ new/XML-Twig-3.44/Changes 2013-01-12 18:23:26.000000000 +0100 @@ -1,5 +1,29 @@ CHANGES +version 3.44 +date +# minor maintenance release +added: XML::Twig::Elt new method now acccepts literal content, eg + my $e= XML::Twig::Elt->new( '<div><p>foo</p><p>bar</p></div>'); +fixed: merge had some problems dealing with embedded comments +improved: more tests + + +version 3.43 +date +# minor maintenance release +improved: docs for parse, see RT #78877 + https://rt.cpan.org/Ticket/Display.html?id=78877 +fixed: xml_pp -i now preserves the permissions of the + original file, see RT #81165 + https://rt.cpan.org/Ticket/Display.html?id=81165 + reported by Alberto Simoes +fixed: RT #80503 Newlines in attribute values + https://rt.cpan.org/Ticket/Display.html?id=80503 + reported (and explained) by Ambrus Zsban: \r, \n + and \n explicitely set in attribute values should + be escaped (with &#x<nb>;) when output + version 3.42 date: 2012-11-06 # minor maintenance release diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/XML-Twig-3.42/META.json new/XML-Twig-3.44/META.json --- old/XML-Twig-3.42/META.json 2012-11-08 13:23:39.000000000 +0100 +++ new/XML-Twig-3.44/META.json 2013-02-11 17:30:10.000000000 +0100 @@ -4,7 +4,7 @@ "Michel Rodriguez <[email protected]>" ], "dynamic_config" : 1, - "generated_by" : "ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120921", + "generated_by" : "ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.120921", "license" : [ "perl_5" ], @@ -42,5 +42,5 @@ "url" : "http://github.com/mirod/xmltwig"; } }, - "version" : "3.42" + "version" : "3.44" } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/XML-Twig-3.42/META.yml new/XML-Twig-3.44/META.yml --- old/XML-Twig-3.42/META.yml 2012-11-08 13:23:39.000000000 +0100 +++ new/XML-Twig-3.44/META.yml 2013-02-11 17:30:10.000000000 +0100 @@ -7,7 +7,7 @@ configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 -generated_by: 'ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120921' +generated_by: 'ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.120921' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html @@ -21,4 +21,4 @@ XML::Parser: 2.23 resources: repository: http://github.com/mirod/xmltwig -version: 3.42 +version: 3.44 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/XML-Twig-3.42/Twig.pm new/XML-Twig-3.44/Twig.pm --- old/XML-Twig-3.42/Twig.pm 2012-11-08 12:31:16.000000000 +0100 +++ new/XML-Twig-3.44/Twig.pm 2013-02-11 17:30:09.000000000 +0100 @@ -124,7 +124,7 @@ BEGIN { -$VERSION = '3.42'; +$VERSION = '3.44'; use XML::Parser; my $needVersion = '2.23'; @@ -186,6 +186,7 @@ $XML::Twig::SPECIAL_GI= @XML::Twig::index2gi; %XML::Twig::base_ent= ( '>' => '>', '<' => '<', '&' => '&', "'" => ''', '"' => '"',); +foreach my $c ( "\n", "\r", "\t") { $XML::Twig::base_ent{$c}= sprintf( "&#x%02x;", ord( $c)); } # now set some aliases *find_nodes = *get_xpath; # same as XML::XPath @@ -1960,25 +1961,18 @@ $t->{twig_right_after_root}=0; #XX my $current= $t->{twig_current} or return; # ugly hack, with ignore on, twig_current can disappear - if( $t->{twig_stored_spaces} || $t->{twig_preserve_space}) - { if( (exists $current->{'pcdata'})) - { $current->{pcdata}.= $t->{twig_stored_spaces}; } - else - { my $current_gi= $XML::Twig::index2gi[$current->{'gi'}]; + return unless length $t->{twig_stored_spaces}; + my $current_gi= $XML::Twig::index2gi[$current->{'gi'}]; - if( ! $t->{twig_discard_all_spaces}) - { if( ! defined( $t->{twig_space_policy}->{$current_gi})) - { $t->{twig_space_policy}->{$current_gi}= _space_policy( $t, $current_gi); } + if( ! $t->{twig_discard_all_spaces}) + { if( ! defined( $t->{twig_space_policy}->{$current_gi})) + { $t->{twig_space_policy}->{$current_gi}= _space_policy( $t, $current_gi); } + if( $t->{twig_space_policy}->{$current_gi} || ($t->{twig_stored_spaces}!~ m{\n}) || $t->{twig_preserve_space}) + { _insert_pcdata( $t, $t->{twig_stored_spaces} ); } + } - if( $t->{twig_space_policy}->{$current_gi} || ($t->{twig_stored_spaces}!~ m{\n}) - || $t->{twig_preserve_space} - ) - { _insert_pcdata( $t, $t->{twig_stored_spaces} ); } - } - $t->{twig_stored_spaces}=''; + $t->{twig_stored_spaces}=''; - } - } return; } @@ -3660,7 +3654,6 @@ sub do_not_escape_gt { my $t= shift; $t->{twig_escape_gt}= 0; return XML::Twig::Elt::do_not_escape_gt( @_); } -# WARNING: at the moment the id list is not updated reliably sub elt_id { return $_[0]->{twig_id_list}->{$_[1]}; } @@ -4883,6 +4876,8 @@ return $elt unless @_; + if( @_ == 1 && $_[0]=~ m{^\s*<}) { return $class->parse( @_); } + # if a gi is passed then use it my $gi= shift; $elt->{gi}=$XML::Twig::gi2index{$gi} or $elt->set_gi( $gi); @@ -5214,8 +5209,16 @@ sub _extra_data_in_pcdata { return $_[0]->{extra_data_in_pcdata}; } sub _set_extra_data_in_pcdata { $_[0]->{extra_data_in_pcdata}= $_[1]; return $_[0]; } sub _del_extra_data_in_pcdata { delete $_[0]->{extra_data_in_pcdata}; return $_[0]; } -sub _unshift_extra_data_in_pcdata { unshift @{shift()->{extra_data_in_pcdata}}, { text => shift(), offset => shift() }; } -sub _push_extra_data_in_pcdata { push @{shift()->{extra_data_in_pcdata}}, { text => shift(), offset => shift() }; } +sub _unshift_extra_data_in_pcdata + { my $e= shift; + $e->{extra_data_in_pcdata}||=[]; + unshift @{$e->{extra_data_in_pcdata}}, { text => shift(), offset => shift() }; + } +sub _push_extra_data_in_pcdata + { my $e= shift; + $e->{extra_data_in_pcdata}||=[]; + push @{$e->{extra_data_in_pcdata}}, { text => shift(), offset => shift() }; + } sub _extra_data_before_end_tag { return $_[0]->{extra_data_before_end_tag} || ''; } sub _set_extra_data_before_end_tag { $_[0]->{extra_data_before_end_tag}= $_[1]; return $_[0]} @@ -7608,6 +7611,9 @@ my $replacement_string; my $is_string= _is_string( $replace); + + my @parents; + foreach my $text_elt ($elt->descendants_or_self( $TEXT)) { if( $is_string) @@ -7629,28 +7635,19 @@ my $match_length = length( $match_string); my $post_match = $match->split_at( $match_length); $replace_sub->( $match, @var); - # merge previous text with current one - my $next_sibling; - if( ($next_sibling= $text_elt->{next_sibling}) - && ($XML::Twig::index2gi[$text_elt->{'gi'}] eq $XML::Twig::index2gi[$next_sibling->{'gi'}]) - ) - { $text_elt->merge_text( $next_sibling); } - - # if the match is at the beginning of the text an empty #PCDATA is left: remove it - if( !$text_elt->text) { $text_elt->delete; } - + # go to next $text_elt= $post_match; $text= $post_match->text; - # if the match is at the end of the text an empty #PCDATA is left: remove it - if( !$text_elt->text) { $text_elt->delete; } - + if( $found_hit) { push @parents, $text_elt->{parent} unless $parents[-1] && $parents[-1]== $text_elt->{parent}; } + } - if( $found_hit) { $text_elt->normalize; } # in case consecutive #PCDATA have been created - } } + + foreach my $parent (@parents) { $parent->normalize; } + return $elt; } @@ -7699,22 +7696,12 @@ croak "invalid merge: can only merge 2 text elements" unless( $e1->is_text && $e2->is_text && ($e1->gi eq $e2->gi)); - my $text1= $e1->text; if( ! defined $text1) { $text1= ''; } - my $text2= $e2->text; if( ! defined $text2) { $text2= ''; } + my $t1_length= length( $e1->text); - $e1->set_text( $text1 . $text2); + $e1->set_text( $e1->text . $e2->text); - my $extra_data= $e1->_extra_data_before_end_tag . $e2->extra_data; - if( $extra_data) - { $e1->_del_extra_data_before_end_tag; - $e1->_push_extra_data_in_pcdata( $extra_data, length( $text1)); - } - - if( $extra_data= $e2->_extra_data_in_pcdata) - { foreach my $data (@$extra_data) { $e1->_push_extra_data_in_pcdata( $data->{text}, $data->{offset} + length( $text1)); } } - - if( my $extra_data_before_end_tag= $e2->_extra_data_before_end_tag) - { $e1->_set_extra_data_before_end_tag( $extra_data_before_end_tag); } + if( my $extra_data_in_pcdata= $e2->_extra_data_in_pcdata) + { foreach my $data (@$extra_data_in_pcdata) { $e1->_push_extra_data_in_pcdata( $data->{text}, $data->{offset} + $t1_length); } } $e2->delete; @@ -7727,8 +7714,27 @@ if( $e1->_last_child && $e1->_last_child->is_pcdata && @e2_children && $e2_children[0]->is_pcdata ) - { $e1->_last_child->{pcdata} .= $e2_children[0]->{pcdata}; shift @e2_children; } + { my $t1_length= length( $e1->_last_child->{pcdata}); + my $child1= $e1->_last_child; + my $child2= shift @e2_children; + $child1->{pcdata} .= $child2->{pcdata}; + + my $extra_data= $e1->_extra_data_before_end_tag . $e2->extra_data; + + if( $extra_data) + { $e1->_del_extra_data_before_end_tag; + $child1->_push_extra_data_in_pcdata( $extra_data, $t1_length); + } + + if( my $extra_data_in_pcdata= $child2->_extra_data_in_pcdata) + { foreach my $data (@$extra_data_in_pcdata) { $child1->_push_extra_data_in_pcdata( $data->{text}, $data->{offset} + $t1_length); } } + + if( my $extra_data_before_end_tag= $e2->_extra_data_before_end_tag) + { $e1->_set_extra_data_before_end_tag( $extra_data_before_end_tag); } + } + foreach my $e (@e2_children) { $e->move( last_child => $e1); } + $e2->delete; return $e1; } @@ -8123,7 +8129,7 @@ : ' ' ; - my $replace_in_att_value= $replaced_ents . $quote; + my $replace_in_att_value= $replaced_ents . "$quote\t\r\n"; if( $option->{escape_gt} && $replaced_ents !~ m{>}) { $replace_in_att_value.= '>'; } my $tag; @@ -8150,8 +8156,8 @@ if( ($empty_tag_style eq $HTML) && !$elt->{first_child} && !$elt->{extra_data_before_end_tag} && $html_empty_elt{$gi}) { $elt->{empty}= 1; } my $empty= defined $elt->{empty} ? $elt->{empty} - : $elt->{first_child} ? 1 - : 0; + : $elt->{first_child} ? 0 + : 1; $tag .= (!$elt->{empty} || $elt->{extra_data_before_end_tag}) ? '>' # element has content : (($empty_tag_style eq $HTML) && $html_empty_elt{$gi}) ? ' />' # html empty element @@ -8533,7 +8539,7 @@ { if( ! $elt->{extra_data_in_pcdata}) { - $string=~ s/([$replaced_ents])/$XML::Twig::base_ent{$1}/g unless( $keep_encoding || $elt->{asis}); + $string=~ s/([$replaced_ents])/$XML::Twig::base_ent{$1}/g unless( !$replaced_ents || $keep_encoding || $elt->{asis}); $string=~ s{\Q]]>}{]]>}g; } else @@ -8598,7 +8604,7 @@ { my $elt= shift; my $att= shift; - my $replace= $replaced_ents . $quote; + my $replace= $replaced_ents . "$quote\n\r\t"; if($_[0] && $_[0]->{escape_gt} && ($replace!~ m{>}) ) { $replace .='>'; } if( defined (my $string= $elt->{att}->{$att})) @@ -8722,10 +8728,10 @@ { my( $elt)= @_; my @descendants= $elt->descendants( $PCDATA); while( my $desc= shift @descendants) - { while( @descendants && $desc->{next_sibling} && $desc->{next_sibling}== $descendants[0]) + { if( ! length $desc->{pcdata}) { $desc->delete; next; } + while( @descendants && $desc->{next_sibling} && $desc->{next_sibling}== $descendants[0]) { my $to_merge= shift @descendants; - $desc->{pcdata}.= $to_merge->{pcdata}; - $to_merge->delete; + $desc->merge_text( $to_merge); } } return $elt; @@ -9089,6 +9095,9 @@ if( $parent->{first_child} == $ref) { $parent->{first_child}= $elt; } if( $parent->{last_child} == $ref) { $parent->{empty}=0; $parent->{last_child}=$elt; if( $XML::Twig::weakrefs) { weaken( $parent->{last_child});} ; } } + elsif( $ref->twig && $ref == $ref->twig->root) + { $ref->twig->set_root( $elt); } + if( my $prev_sibling= $ref->{prev_sibling}) { $elt->{prev_sibling}=$prev_sibling; if( $XML::Twig::weakrefs) { weaken( $elt->{prev_sibling});} ; $prev_sibling->{next_sibling}= $elt; @@ -9140,7 +9149,8 @@ } else { my $new_elt= $elt->_new_pcdata( $prefix); - $new_elt->paste( $elt); + my $pos= (exists $elt->{'pcdata'}) ? 'before' : 'first_child'; + $new_elt->paste( $pos => $elt); if( $asis) { $new_elt->set_asis; } } return $elt; @@ -9161,7 +9171,8 @@ { $elt->{last_child}->set_pcdata( $elt->{last_child}->pcdata . $suffix); } else { my $new_elt= $elt->_new_pcdata( $suffix); - $new_elt->paste( 'last_child', $elt); + my $pos= (exists $elt->{'pcdata'}) ? 'after' : 'last_child'; + $new_elt->paste( $pos => $elt); if( $asis) { $new_elt->set_asis; } } return $elt; @@ -9514,7 +9525,7 @@ filter for example. -=encoding utf8 +=encoding utf8 # > perl 5.10.0 =head1 DESCRIPTION @@ -9948,7 +9959,7 @@ Note: you can set handlers (twig_handlers) using twig_roots Example: my $t= XML::Twig->new( twig_roots => - { title => sub { $_{1]->print;}, + { title => sub { $_[1]->print;}, subtitle => \&process_subtitle } ); @@ -9968,7 +9979,7 @@ sub number_title { my( $twig, $title); $nb++; - $title->prefix( "$nb "; } + $title->prefix( "$nb "); $title->print; } } @@ -9991,7 +10002,7 @@ sub number_title { my( $twig, $title); $nb++; - $title->prefix( "$nb "; } + $title->prefix( "$nb "); $title->print( $out); # you have to print to \*OUT here } } @@ -10610,14 +10621,14 @@ # using an array ref my $t= XML::Twig->new( index => [ 'div', 'table' ]) - ->parsefile( "foo.xml'); + ->parsefile( "foo.xml"); my $divs= $t->index( 'div'); my $first_div= $divs->[0]; my $last_table= $t->index( table => -1); # using a hashref to name the indexes - my $t= XML::Twig->new( index => { email => 'a[@href=~/^\s*mailto:/]') - ->parsefile( "foo.xml'); + my $t= XML::Twig->new( index => { email => 'a[@href=~/^ \s*mailto:/]'}) + ->parsefile( "foo.xml"); my $last_emails= $t->index( email => -1); Note that the index is not maintained after the parsing. If elements are @@ -10630,7 +10641,7 @@ my $t= XML::Twig->new( att_accessors => [ 'href', 'src']) ->parsefile( $file); - my $first href= $t->first_elt( 'img')->src; # same as ->att( 'src') + my $first_href= $t->first_elt( 'img')->src; # same as ->att( 'src') $t->first_elt( 'img')->src( 'new_logo.png') # changes the attribute value =item elt_accessors @@ -10645,7 +10656,7 @@ my $title_text= $t->root->head->field( 'title'); # same as $title_text= $t->root->first_child( 'head')->field( 'title'); - my $t= XML::Twig->new( elt_accessors => { warnings => 'p[@class="warning"]', d2 => 'div[2]', ) + my $t= XML::Twig->new( elt_accessors => { warnings => 'p[@class="warning"]', d2 => 'div[2]'}, ) ->parsefile( $file); my $body= $t->first_elt( 'body'); my @warnings= $body->warnings; # same as $body->children( 'p[@class="warning"]'); @@ -10698,6 +10709,14 @@ C<< XML::Twig->parse( pretty_print => 'indented', $some_xml_or_html) >>) and C<L<xparse>> is called on it. +Note that when parsing a filehandle, the handle should NOT be open with an +encoding (ie open with C<open( my $in, '<', $filename)>. The file will be +parsed by C<expat>, so specifying the encoding actually causes problems +for the parser (as in: it can crash it, see +https://rt.cpan.org/Ticket/Display.html?id=78877). For parsing a file it +is actually recommended to use C<parsefile> on the file name, instead of +<parse> on the open file. + =item parsestring This is just an alias for C<parse> for backwards compatibility. @@ -11747,7 +11766,7 @@ subtree then the method returns undef. You can then walk a sub-tree with: my $elt= $subtree_root; - while( $elt= $elt->next_elt( $subtree_root) + while( $elt= $elt->next_elt( $subtree_root)) { # insert processing code here } @@ -12321,8 +12340,8 @@ B<Bug>: in the C<$regexp>, you can only use C<\1>, C<\2>... if the replacement expression does not include elements or attributes. eg - t->subs_text( qr/((t[aiou])\2)/, '$2'); # ok, replaces toto, tata, titi, tutu by to, ta, ti, tu - t->subs_text( qr/((t[aiou])\2)/, '&elt(p => $1)' ); # NOK, does not find toto... + $t->subs_text( qr/((t[aiou])\2)/, '$2'); # ok, replaces toto, tata, titi, tutu by to, ta, ti, tu + $t->subs_text( qr/((t[aiou])\2)/, '&elt(p => $1)' ); # NOK, does not find toto... =item add_id ($optional_coderef) @@ -12564,7 +12583,7 @@ Optionally each tag can be followed by a hashref of attributes, that will be set on the wrapping element: - $elt->wrap_in( p => { class => "advisory" }, div => { class => "intro", id => "div_intro }); + $elt->wrap_in( p => { class => "advisory" }, div => { class => "intro", id => "div_intro" }); =item insert_new_elt ($opt_position, $tag, $opt_atts_hashref, @opt_content) @@ -13556,9 +13575,24 @@ =over 4 +=item segfault during parsing + +This happens when parsing huge documents, or lots of small ones, with a version +of Perl before 5.16. + +This is due to a bug in the way weak references are handled in Perl itself. + +The fix is either to upgrade to Perl 5.16 or later (C<perlbrew> is a great +tool to manage several installations of perl on the same machine). + +An other, NOT RECOMMENDED, way of fixing the problem, is to switch off weak +references by writing C<XML::Twig::_set_weakrefs( 0);> at the top of the code. +This is totally unsupported, and may lead to other problems though, + =item entity handling -Due to XML::Parser behaviour, non-base entities in attribute values disappear: +Due to XML::Parser behaviour, non-base entities in attribute values disappear if +they are not declared in the document: C<att="val&ent;"> will be turned into C<< att => val >>, unless you use the C<keep_encoding> argument to C<< XML::Twig->new >> @@ -13577,7 +13611,8 @@ =item memory leak -If you use a lot of twigs you might find that you leak quite a lot of memory +If you use a REALLY old Perl (5.005!) and +a lot of twigs you might find that you leak quite a lot of memory (about 2Ks per twig). You can use the C<L<dispose> > method to free that memory after you are done. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/XML-Twig-3.42/Twig_pm.slow new/XML-Twig-3.44/Twig_pm.slow --- old/XML-Twig-3.42/Twig_pm.slow 2012-11-07 09:23:28.000000000 +0100 +++ new/XML-Twig-3.44/Twig_pm.slow 2013-02-11 17:28:16.000000000 +0100 @@ -124,7 +124,7 @@ BEGIN { -$VERSION = '3.42'; +$VERSION = '3.44'; use XML::Parser; my $needVersion = '2.23'; @@ -186,6 +186,7 @@ $XML::Twig::SPECIAL_GI= @XML::Twig::index2gi; %XML::Twig::base_ent= ( '>' => '>', '<' => '<', '&' => '&', "'" => ''', '"' => '"',); +foreach my $c ( "\n", "\r", "\t") { $XML::Twig::base_ent{$c}= sprintf( "&#x%02x;", ord( $c)); } # now set some aliases *find_nodes = *get_xpath; # same as XML::XPath @@ -1960,25 +1961,18 @@ $t->{twig_right_after_root}=0; #XX my $current= $t->{twig_current} or return; # ugly hack, with ignore on, twig_current can disappear - if( $t->{twig_stored_spaces} || $t->{twig_preserve_space}) - { if( $current->is_pcdata) - { $current->append_pcdata($t->{twig_stored_spaces}); } - else - { my $current_gi= $current->gi; + return unless length $t->{twig_stored_spaces}; + my $current_gi= $current->gi; - if( ! $t->{twig_discard_all_spaces}) - { if( ! defined( $t->{twig_space_policy}->{$current_gi})) - { $t->{twig_space_policy}->{$current_gi}= _space_policy( $t, $current_gi); } + if( ! $t->{twig_discard_all_spaces}) + { if( ! defined( $t->{twig_space_policy}->{$current_gi})) + { $t->{twig_space_policy}->{$current_gi}= _space_policy( $t, $current_gi); } + if( $t->{twig_space_policy}->{$current_gi} || ($t->{twig_stored_spaces}!~ m{\n}) || $t->{twig_preserve_space}) + { _insert_pcdata( $t, $t->{twig_stored_spaces} ); } + } - if( $t->{twig_space_policy}->{$current_gi} || ($t->{twig_stored_spaces}!~ m{\n}) - || $t->{twig_preserve_space} - ) - { _insert_pcdata( $t, $t->{twig_stored_spaces} ); } - } - $t->{twig_stored_spaces}=''; + $t->{twig_stored_spaces}=''; - } - } return; } @@ -3661,7 +3655,6 @@ sub do_not_escape_gt { my $t= shift; $t->{twig_escape_gt}= 0; return XML::Twig::Elt::do_not_escape_gt( @_); } -# WARNING: at the moment the id list is not updated reliably sub elt_id { return $_[0]->{twig_id_list}->{$_[1]}; } @@ -4884,6 +4877,8 @@ return $elt unless @_; + if( @_ == 1 && $_[0]=~ m{^\s*<}) { return $class->parse( @_); } + # if a gi is passed then use it my $gi= shift; $elt->set_gi( $gi); @@ -5215,8 +5210,16 @@ sub _extra_data_in_pcdata { return $_[0]->{extra_data_in_pcdata}; } sub _set_extra_data_in_pcdata { $_[0]->{extra_data_in_pcdata}= $_[1]; return $_[0]; } sub _del_extra_data_in_pcdata { delete $_[0]->{extra_data_in_pcdata}; return $_[0]; } -sub _unshift_extra_data_in_pcdata { unshift @{shift()->{extra_data_in_pcdata}}, { text => shift(), offset => shift() }; } -sub _push_extra_data_in_pcdata { push @{shift()->{extra_data_in_pcdata}}, { text => shift(), offset => shift() }; } +sub _unshift_extra_data_in_pcdata + { my $e= shift; + $e->{extra_data_in_pcdata}||=[]; + unshift @{$e->{extra_data_in_pcdata}}, { text => shift(), offset => shift() }; + } +sub _push_extra_data_in_pcdata + { my $e= shift; + $e->{extra_data_in_pcdata}||=[]; + push @{$e->{extra_data_in_pcdata}}, { text => shift(), offset => shift() }; + } sub _extra_data_before_end_tag { return $_[0]->{extra_data_before_end_tag} || ''; } sub _set_extra_data_before_end_tag { $_[0]->{extra_data_before_end_tag}= $_[1]; return $_[0]} @@ -7609,6 +7612,9 @@ my $replacement_string; my $is_string= _is_string( $replace); + + my @parents; + foreach my $text_elt ($elt->descendants_or_self( $TEXT)) { if( $is_string) @@ -7630,28 +7636,19 @@ my $match_length = length( $match_string); my $post_match = $match->split_at( $match_length); $replace_sub->( $match, @var); - # merge previous text with current one - my $next_sibling; - if( ($next_sibling= $text_elt->_next_sibling) - && ($text_elt->gi eq $next_sibling->gi) - ) - { $text_elt->merge_text( $next_sibling); } - - # if the match is at the beginning of the text an empty #PCDATA is left: remove it - if( !$text_elt->text) { $text_elt->delete; } - + # go to next $text_elt= $post_match; $text= $post_match->text; - # if the match is at the end of the text an empty #PCDATA is left: remove it - if( !$text_elt->text) { $text_elt->delete; } - + if( $found_hit) { push @parents, $text_elt->parent unless $parents[-1] && $parents[-1]== $text_elt->parent; } + } - if( $found_hit) { $text_elt->normalize; } # in case consecutive #PCDATA have been created - } } + + foreach my $parent (@parents) { $parent->normalize; } + return $elt; } @@ -7700,22 +7697,12 @@ croak "invalid merge: can only merge 2 text elements" unless( $e1->is_text && $e2->is_text && ($e1->gi eq $e2->gi)); - my $text1= $e1->text; if( ! defined $text1) { $text1= ''; } - my $text2= $e2->text; if( ! defined $text2) { $text2= ''; } + my $t1_length= length( $e1->text); - $e1->set_text( $text1 . $text2); + $e1->set_text( $e1->text . $e2->text); - my $extra_data= $e1->_extra_data_before_end_tag . $e2->extra_data; - if( $extra_data) - { $e1->_del_extra_data_before_end_tag; - $e1->_push_extra_data_in_pcdata( $extra_data, length( $text1)); - } - - if( $extra_data= $e2->_extra_data_in_pcdata) - { foreach my $data (@$extra_data) { $e1->_push_extra_data_in_pcdata( $data->{text}, $data->{offset} + length( $text1)); } } - - if( my $extra_data_before_end_tag= $e2->_extra_data_before_end_tag) - { $e1->_set_extra_data_before_end_tag( $extra_data_before_end_tag); } + if( my $extra_data_in_pcdata= $e2->_extra_data_in_pcdata) + { foreach my $data (@$extra_data_in_pcdata) { $e1->_push_extra_data_in_pcdata( $data->{text}, $data->{offset} + $t1_length); } } $e2->delete; @@ -7728,8 +7715,27 @@ if( $e1->_last_child && $e1->_last_child->is_pcdata && @e2_children && $e2_children[0]->is_pcdata ) - { $e1->_last_child->{pcdata} .= $e2_children[0]->{pcdata}; shift @e2_children; } + { my $t1_length= length( $e1->_last_child->{pcdata}); + my $child1= $e1->_last_child; + my $child2= shift @e2_children; + $child1->{pcdata} .= $child2->{pcdata}; + + my $extra_data= $e1->_extra_data_before_end_tag . $e2->extra_data; + + if( $extra_data) + { $e1->_del_extra_data_before_end_tag; + $child1->_push_extra_data_in_pcdata( $extra_data, $t1_length); + } + + if( my $extra_data_in_pcdata= $child2->_extra_data_in_pcdata) + { foreach my $data (@$extra_data_in_pcdata) { $child1->_push_extra_data_in_pcdata( $data->{text}, $data->{offset} + $t1_length); } } + + if( my $extra_data_before_end_tag= $e2->_extra_data_before_end_tag) + { $e1->_set_extra_data_before_end_tag( $extra_data_before_end_tag); } + } + foreach my $e (@e2_children) { $e->move( last_child => $e1); } + $e2->delete; return $e1; } @@ -8124,7 +8130,7 @@ : ' ' ; - my $replace_in_att_value= $replaced_ents . $quote; + my $replace_in_att_value= $replaced_ents . "$quote\t\r\n"; if( $option->{escape_gt} && $replaced_ents !~ m{>}) { $replace_in_att_value.= '>'; } my $tag; @@ -8151,8 +8157,8 @@ if( ($empty_tag_style eq $HTML) && !$elt->_first_child && !$elt->_extra_data_before_end_tag && $html_empty_elt{$gi}) { $elt->{empty}= 1; } my $empty= defined $elt->{empty} ? $elt->{empty} - : $elt->_first_child ? 1 - : 0; + : $elt->_first_child ? 0 + : 1; $tag .= (!$elt->{empty} || $elt->_extra_data_before_end_tag) ? '>' # element has content : (($empty_tag_style eq $HTML) && $html_empty_elt{$gi}) ? ' />' # html empty element @@ -8535,7 +8541,7 @@ { if( ! $elt->_extra_data_in_pcdata) { - $string=~ s/([$replaced_ents])/$XML::Twig::base_ent{$1}/g unless( $keep_encoding || $elt->{asis}); + $string=~ s/([$replaced_ents])/$XML::Twig::base_ent{$1}/g unless( !$replaced_ents || $keep_encoding || $elt->{asis}); $string=~ s{\Q]]>}{]]>}g; } else @@ -8600,7 +8606,7 @@ { my $elt= shift; my $att= shift; - my $replace= $replaced_ents . $quote; + my $replace= $replaced_ents . "$quote\n\r\t"; if($_[0] && $_[0]->{escape_gt} && ($replace!~ m{>}) ) { $replace .='>'; } if( defined (my $string= $elt->{att}->{$att})) @@ -8724,10 +8730,10 @@ { my( $elt)= @_; my @descendants= $elt->descendants( $PCDATA); while( my $desc= shift @descendants) - { while( @descendants && $desc->_next_sibling && $desc->_next_sibling== $descendants[0]) + { if( ! length $desc->{pcdata}) { $desc->delete; next; } + while( @descendants && $desc->_next_sibling && $desc->_next_sibling== $descendants[0]) { my $to_merge= shift @descendants; - $desc->{pcdata}.= $to_merge->{pcdata}; - $to_merge->delete; + $desc->merge_text( $to_merge); } } return $elt; @@ -9091,6 +9097,9 @@ if( $parent->_first_child == $ref) { $parent->set_first_child( $elt); } if( $parent->_last_child == $ref) { $parent->set_last_child( $elt) ; } } + elsif( $ref->twig && $ref == $ref->twig->root) + { $ref->twig->set_root( $elt); } + if( my $prev_sibling= $ref->_prev_sibling) { $elt->set_prev_sibling( $prev_sibling); $prev_sibling->set_next_sibling( $elt); @@ -9142,7 +9151,8 @@ } else { my $new_elt= $elt->_new_pcdata( $prefix); - $new_elt->paste( $elt); + my $pos= $elt->is_pcdata ? 'before' : 'first_child'; + $new_elt->paste( $pos => $elt); if( $asis) { $new_elt->set_asis; } } return $elt; @@ -9163,7 +9173,8 @@ { $elt->_last_child->set_pcdata( $elt->_last_child->pcdata . $suffix); } else { my $new_elt= $elt->_new_pcdata( $suffix); - $new_elt->paste( 'last_child', $elt); + my $pos= $elt->is_pcdata ? 'after' : 'last_child'; + $new_elt->paste( $pos => $elt); if( $asis) { $new_elt->set_asis; } } return $elt; @@ -9516,7 +9527,7 @@ filter for example. -=encoding utf8 +=encoding utf8 # > perl 5.10.0 =head1 DESCRIPTION @@ -9950,7 +9961,7 @@ Note: you can set handlers (twig_handlers) using twig_roots Example: my $t= XML::Twig->new( twig_roots => - { title => sub { $_{1]->print;}, + { title => sub { $_[1]->print;}, subtitle => \&process_subtitle } ); @@ -9970,7 +9981,7 @@ sub number_title { my( $twig, $title); $nb++; - $title->prefix( "$nb "; } + $title->prefix( "$nb "); $title->print; } } @@ -9993,7 +10004,7 @@ sub number_title { my( $twig, $title); $nb++; - $title->prefix( "$nb "; } + $title->prefix( "$nb "); $title->print( $out); # you have to print to \*OUT here } } @@ -10612,14 +10623,14 @@ # using an array ref my $t= XML::Twig->new( index => [ 'div', 'table' ]) - ->parsefile( "foo.xml'); + ->parsefile( "foo.xml"); my $divs= $t->index( 'div'); my $first_div= $divs->[0]; my $last_table= $t->index( table => -1); # using a hashref to name the indexes - my $t= XML::Twig->new( index => { email => 'a[@href=~/^\s*mailto:/]') - ->parsefile( "foo.xml'); + my $t= XML::Twig->new( index => { email => 'a[@href=~/^ \s*mailto:/]'}) + ->parsefile( "foo.xml"); my $last_emails= $t->index( email => -1); Note that the index is not maintained after the parsing. If elements are @@ -10632,7 +10643,7 @@ my $t= XML::Twig->new( att_accessors => [ 'href', 'src']) ->parsefile( $file); - my $first href= $t->first_elt( 'img')->src; # same as ->att( 'src') + my $first_href= $t->first_elt( 'img')->src; # same as ->att( 'src') $t->first_elt( 'img')->src( 'new_logo.png') # changes the attribute value =item elt_accessors @@ -10647,7 +10658,7 @@ my $title_text= $t->root->head->field( 'title'); # same as $title_text= $t->root->first_child( 'head')->field( 'title'); - my $t= XML::Twig->new( elt_accessors => { warnings => 'p[@class="warning"]', d2 => 'div[2]', ) + my $t= XML::Twig->new( elt_accessors => { warnings => 'p[@class="warning"]', d2 => 'div[2]'}, ) ->parsefile( $file); my $body= $t->first_elt( 'body'); my @warnings= $body->warnings; # same as $body->children( 'p[@class="warning"]'); @@ -10700,6 +10711,14 @@ C<< XML::Twig->parse( pretty_print => 'indented', $some_xml_or_html) >>) and C<L<xparse>> is called on it. +Note that when parsing a filehandle, the handle should NOT be open with an +encoding (ie open with C<open( my $in, '<', $filename)>. The file will be +parsed by C<expat>, so specifying the encoding actually causes problems +for the parser (as in: it can crash it, see +https://rt.cpan.org/Ticket/Display.html?id=78877). For parsing a file it +is actually recommended to use C<parsefile> on the file name, instead of +<parse> on the open file. + =item parsestring This is just an alias for C<parse> for backwards compatibility. @@ -11749,7 +11768,7 @@ subtree then the method returns undef. You can then walk a sub-tree with: my $elt= $subtree_root; - while( $elt= $elt->next_elt( $subtree_root) + while( $elt= $elt->next_elt( $subtree_root)) { # insert processing code here } @@ -12323,8 +12342,8 @@ B<Bug>: in the C<$regexp>, you can only use C<\1>, C<\2>... if the replacement expression does not include elements or attributes. eg - t->subs_text( qr/((t[aiou])\2)/, '$2'); # ok, replaces toto, tata, titi, tutu by to, ta, ti, tu - t->subs_text( qr/((t[aiou])\2)/, '&elt(p => $1)' ); # NOK, does not find toto... + $t->subs_text( qr/((t[aiou])\2)/, '$2'); # ok, replaces toto, tata, titi, tutu by to, ta, ti, tu + $t->subs_text( qr/((t[aiou])\2)/, '&elt(p => $1)' ); # NOK, does not find toto... =item add_id ($optional_coderef) @@ -12566,7 +12585,7 @@ Optionally each tag can be followed by a hashref of attributes, that will be set on the wrapping element: - $elt->wrap_in( p => { class => "advisory" }, div => { class => "intro", id => "div_intro }); + $elt->wrap_in( p => { class => "advisory" }, div => { class => "intro", id => "div_intro" }); =item insert_new_elt ($opt_position, $tag, $opt_atts_hashref, @opt_content) @@ -13558,9 +13577,24 @@ =over 4 +=item segfault during parsing + +This happens when parsing huge documents, or lots of small ones, with a version +of Perl before 5.16. + +This is due to a bug in the way weak references are handled in Perl itself. + +The fix is either to upgrade to Perl 5.16 or later (C<perlbrew> is a great +tool to manage several installations of perl on the same machine). + +An other, NOT RECOMMENDED, way of fixing the problem, is to switch off weak +references by writing C<XML::Twig::_set_weakrefs( 0);> at the top of the code. +This is totally unsupported, and may lead to other problems though, + =item entity handling -Due to XML::Parser behaviour, non-base entities in attribute values disappear: +Due to XML::Parser behaviour, non-base entities in attribute values disappear if +they are not declared in the document: C<att="val&ent;"> will be turned into C<< att => val >>, unless you use the C<keep_encoding> argument to C<< XML::Twig->new >> @@ -13579,7 +13613,8 @@ =item memory leak -If you use a lot of twigs you might find that you leak quite a lot of memory +If you use a REALLY old Perl (5.005!) and +a lot of twigs you might find that you leak quite a lot of memory (about 2Ks per twig). You can use the C<L<dispose> > method to free that memory after you are done. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/XML-Twig-3.42/t/test4.t new/XML-Twig-3.44/t/test4.t --- old/XML-Twig-3.42/t/test4.t 2012-05-17 12:24:59.000000000 +0200 +++ new/XML-Twig-3.44/t/test4.t 2013-01-25 11:03:16.000000000 +0100 @@ -189,22 +189,27 @@ #$doc= $t->sprint; #stest( $doc, $s, "PI"); +if( $] > 5.008) + { my (@called); + my $t= XML::Twig->new( + twig_handlers => + { a => sub { push @called, 'a'; 1; }, + 'b/a' => sub { push @called, 'b/a'; 1; }, + '/b/a' => sub { push @called, '/b/a'; 1; }, + '/a' => sub { push @called, '/a'; 1; }, + }, + ); -my (@called); -$t= XML::Twig->new( - twig_handlers => - { a => sub { push @called, 'a'; 1; }, - 'b/a' => sub { push @called, 'b/a'; 1; }, - '/b/a' => sub { push @called, '/b/a'; 1; }, - '/a' => sub { push @called, '/a'; 1; }, - }, - ); - -$t->parse( '<b><a/></b>'); -my $calls= join( ':', @called); -my $expected= "/b/a:b/a:a"; -if( $calls eq $expected) { print "ok 19\n"; } -else { print "not ok 19\n"; warn "\n[$calls] instead of [$expected]\n"; } + $t->parse( '<b><a/></b>'); + my $calls= join( ':', @called); + my $expected= "/b/a:b/a:a"; + if( $calls eq $expected) { print "ok 19\n"; } + else { print "not ok 19\n"; warn "\n[$calls] instead of [$expected]\n"; } + + + } +else + { warn "skipped for perl < 5.8\n"; print "ok 19\n"; } exit 0; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/XML-Twig-3.42/t/test_3_27.t new/XML-Twig-3.44/t/test_3_27.t --- old/XML-Twig-3.42/t/test_3_27.t 2012-05-17 12:24:59.000000000 +0200 +++ new/XML-Twig-3.44/t/test_3_27.t 2013-01-25 11:14:46.000000000 +0100 @@ -146,6 +146,7 @@ is( $e->text, 'foobar', "merge"); } +if( $] > 5.008) { # testing ignore on the current element my $calls; my $h= sub { $calls.= $_[1]->tag; }; @@ -175,6 +176,7 @@ is( $calls, 'cfcfha', 'ignore on a grand-parent element'); is( $t3->sprint, '<a><f></f><f></f><h/></a>', 'tree build with ignore on the grand parent of an element'); + $calls=''; # ignore from a regular handler my $t4= XML::Twig->new( twig_handlers => { _default_ => sub { $calls.= $_[1]->tag; }, @@ -211,9 +213,9 @@ }; matches( $@, '^element to be ignored must be ancestor of current element', 'error ignore-ing an element ( descendant)'); } +else + { skip( 12, "not tested under perl < 5.8"); } - - { my $doc='<l0><l1><l2></l2></l1><l1><l2></l2><l2></l2></l1></l0>'; (my $indented_doc= $doc)=~ s{(</?l(\d)>)}{" " x $2 . $1}eg; $indented_doc=~ s{>}{>\n}g; @@ -342,14 +344,17 @@ is( $t->elt_id( "e1")->xml_text( 'no_recurse'), 'tutu <&ent; tata', "xml_text no_recurse wih ent"); } +if( $] > 5.008) { my $r; XML::Twig->parse( twig_handlers => { '/a/b//c' => sub { $r++; } }, q{<a><b><b><c>foo</c></b></b></a>} ); ok( $r, "handler condition with // and nested elts (/a//b/c)"); } +else + { skip( 1, "not tested under perl < 5.8"); } - +if( $] > 5.008) { my @r; XML::Twig->parse( twig_handlers => { 's[@#a="1"]' => sub { push @r, $_->id}, 's/e[@x="1"]' => sub { $_->parent->set_att( '#a' => 1); }, @@ -358,8 +363,10 @@ ); is( join( ':', @r), 's2:s3', 'inner handler changing parent attribute value'); } +else + { skip( 1, "not tested under perl < 5.8"); } - +if( $] > 5.008) { my @r; XML::Twig->parse( twig_roots => { '/d/s[@a="1"]/e[@a="1"]' => => sub { push @r, $_->id}, }, q{<d><s><e a="1" id="e1"/><e id="e2"/></s> @@ -370,5 +377,7 @@ ); is( join( ':', @r), 'e3:e8', 'complex condition with twig_roots'); } +else + { skip( 1, "not tested under perl < 5.8"); } -exit; # or you get a weird error under 5.6.2 +exit 0; # or you get a weird error under 5.6.2 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/XML-Twig-3.42/t/test_3_40.t new/XML-Twig-3.44/t/test_3_40.t --- old/XML-Twig-3.42/t/test_3_40.t 2012-05-17 12:24:59.000000000 +0200 +++ new/XML-Twig-3.44/t/test_3_40.t 2013-01-25 11:17:42.000000000 +0100 @@ -76,9 +76,12 @@ is( $got, 'i1i3', 'bare attribute in handler condition'); } +if( $] > 5.008) { my $doc= q{<!DOCTYPE doc [ <!ELEMENT doc (#PCDATA)><!ENTITY ext SYSTEM "not_there.txt">]><doc>&ext;</doc>}; ok( XML::Twig->parse( expand_external_ents => -1, $doc), 'failsafe expand_external_ents'); } +else +{ skip( 1, 'not tested under perl < 5.8'); } { my $t=XML::Twig->parse( q{<doc><e><e1>e11</e1><e2>e21</e2></e><e><e1>e12</e1></e></doc>}); is( join( ':', $t->findvalues( [$t->root->children], "./e1")), 'e11:e12', 'findvalues on array'); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/XML-Twig-3.42/t/test_class_selector.t new/XML-Twig-3.44/t/test_class_selector.t --- old/XML-Twig-3.42/t/test_class_selector.t 2012-05-17 12:24:59.000000000 +0200 +++ new/XML-Twig-3.44/t/test_class_selector.t 2013-01-25 11:21:48.000000000 +0100 @@ -27,7 +27,8 @@ is( $got, $expected, "navigation: $cond" ); } - +if( $] > 5.008) +{ foreach my $test (@DATA) { my( $cond, $expected)= @$test; my $got=''; @@ -46,6 +47,10 @@ ->parse( $doc_dot); is( $got, $expected, "handlers (css_sel NOT enabled): $cond" ); } +} +else +{ skip( 12, 'not tested under perl < 5.8'); } + diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/XML-Twig-3.42/t/test_comment_handler.t new/XML-Twig-3.44/t/test_comment_handler.t --- old/XML-Twig-3.42/t/test_comment_handler.t 2012-05-17 12:24:59.000000000 +0200 +++ new/XML-Twig-3.44/t/test_comment_handler.t 2013-01-25 11:27:14.000000000 +0100 @@ -6,9 +6,13 @@ use XML::Twig; +if( $] < 5.008) + { warn "skipped, not tested under perl < 5.8\n"; print "1..1\nok 1\n"; exit 0; } + my $nb_tests=4; print "1..$nb_tests\n"; +{ my $result; my $t= XML::Twig->new( comments => 'process', twig_handlers => { '#COMMENT' => sub { $result .=$_->text; } }, @@ -21,44 +25,51 @@ { print "not ok 1\n"; warn "expected: $expected\nfound : $result\n"; } +} -$result=''; -$t= XML::Twig->new( comments => 'process', +{ +my $result=''; +my $t= XML::Twig->new( comments => 'process', twig_handlers => { '#COMMENT' => sub { $result .=$_->text; } }, ); $t->parse( q{<!-- comment in doc --><doc id="doc"></doc>}); -$expected= ' comment in doc '; +my $expected= ' comment in doc '; if( $result eq $expected) { print "ok 2\n"; } else { print "not ok 2\n"; warn "expected: $expected\nfound : $result\n"; } +} -$result=''; -$t= XML::Twig->new( twig_handlers => { 'doc' => sub { $result= $_->{extra_data}; } },); +{ +my $result=''; +my $t= XML::Twig->new( twig_handlers => { 'doc' => sub { $result= $_->{extra_data}; } },); $t->parse( q{<!-- comment in doc --><doc id="doc"></doc>}); -$expected= '<!-- comment in doc -->'; +my $expected= '<!-- comment in doc -->'; if( $result eq $expected) { print "ok 3\n"; } else { print "not ok 3\n"; warn "expected: $expected\nfound : $result\n"; } +} - -$result=''; -$t= XML::Twig->new( comments => 'process', - twig_roots => { '/#COMMENT' => sub { $result= $_->{extra_data}; }, - elt => sub { }, - }); +{ +my $result=''; +my $t= XML::Twig->new( comments => 'process', + twig_roots => { '/#COMMENT' => sub { $result= $_->{extra_data}; }, + elt => sub { }, + }); $t->parse( q{<!-- comment in doc --><doc id="doc"><elt/></doc>}); -$expected= ''; # This is a bug! +my $expected= ''; # This is a bug! if( $result eq $expected) { print "ok 4\n"; } else { print "not ok 4\n"; warn "expected: $expected\nfound : $result\n"; } +} + exit 0; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/XML-Twig-3.42/t/test_pi_handler.t new/XML-Twig-3.44/t/test_pi_handler.t --- old/XML-Twig-3.42/t/test_pi_handler.t 2012-05-17 12:24:59.000000000 +0200 +++ new/XML-Twig-3.44/t/test_pi_handler.t 2013-01-25 11:28:59.000000000 +0100 @@ -8,6 +8,9 @@ use XML::Twig; +if( $] < 5.008) + { warn "skipped, not tested under perl < 5.8\n"; print "1..1\nok 1\n"; exit 0; } + my $nb_tests=4; print "1..$nb_tests\n"; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/XML-Twig-3.42/tools/xml_pp/xml_pp new/XML-Twig-3.44/tools/xml_pp/xml_pp --- old/XML-Twig-3.42/tools/xml_pp/xml_pp 2012-05-17 12:24:59.000000000 +0200 +++ new/XML-Twig-3.44/tools/xml_pp/xml_pp 2012-11-14 17:16:35.000000000 +0100 @@ -57,11 +57,13 @@ if( $opt{in_place}) { close PP_OUTPUT; + my $mode= mode( $file); if( $opt{backup}) { my $backup= backup( $file, $opt{backup}); rename( $file, $backup) or die "cannot create backup file $backup: $!"; } rename( $tempfile, $file) or die "cannot overwrite file $file: $!"; + if( $mode ne mode( $file)) { chmod $mode, $file or die "cannot set $file mode to $mode: $!"; } } } @@ -78,7 +80,12 @@ if( $opt{load}) { $t->print; } } - + +sub mode + { my( $file)= @_; + return (stat($file))[2]; + } + sub process_options { my %opt; while( @ARGV && ($ARGV[0]=~ m{^-}) ) -- To unsubscribe, e-mail: [email protected] For additional commands, e-mail: [email protected]
