Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP

Comparing changes

Choose two branches to see what's changed or to start a new pull request. If you need to, you can also compare across forks.

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also compare across forks.
  • 2 commits
  • 4 files changed
  • 0 commit comments
  • 1 contributor
View
8 Changes
@@ -6,12 +6,16 @@ date: 2011-
# minor maintenance release
fixed: xml_pp -i would blank all files after the first one
thanks to dvercande for spotting this
-added findvalues method (XML::Twig and XML::Twig::Elt)
+added: findvalues method (XML::Twig and XML::Twig::Elt)
same as findvalue except that it returns an array of value
-added the output_html_doctype option to XML::Twig::new, that
+added: the output_html_doctype option to XML::Twig::new, that
outputs the DOCTYPE declaration for HTML docs converted
by HTML::TreeBuilder (fixing it if necessary)
see RT #71009: https://rt.cpan.org/Ticket/Display.html?id=71009
+fixed: t/test_autoencoding_conversion.t failed with $PERL_UNICODE
+ set to SA* (which prevents autoconversion)
+ reported by Martin J Evans, RT #71084
+ https://rt.cpan.org/Ticket/Display.html?id=71084
version 3.38
date: 2011-02-27
View
18 Twig_pm.slow
@@ -7327,6 +7327,7 @@ sub mark
# only returns the elements created by matches in the split regexp
# otherwise all elements (new and untouched) are returned
+
{
sub _split
@@ -7335,8 +7336,9 @@ sub mark
my $regexp= shift;
my @tags;
- while( my $tag= shift())
- { if( ref $_[0])
+ while( @_)
+ { my $tag= shift();
+ if( ref $_[0])
{ push @tags, { tag => $tag, atts => shift }; }
else
{ push @tags, { tag => $tag }; }
@@ -7376,9 +7378,11 @@ sub mark
foreach my $match (@matches)
{ # create new element, text is the match
_utf8_ify( $match) if( $[ < 5.010);
- my $tag = $tags[$i]->{tag};
+ my $tag = _repl_match( $tags[$i]->{tag}, @matches) || '#PCDATA';
+ #use Data::Show; show $i, $tag, @matches, @tags;
my $atts = \%{$tags[$i]->{atts}} || {};
- $elt= $elt->insert_new_elt( after => $tag, $atts, $match);
+ my %atts= map { _repl_match( $_, @matches) => _repl_match( $atts->{$_}, @matches) } keys %$atts;
+ $elt= $elt->insert_new_elt( after => $tag, \%atts, $match);
push @result, $elt;
$i= ($i + 1) % @tags;
}
@@ -7401,6 +7405,12 @@ sub mark
return @result; # return all elements
}
+sub _repl_match
+ { my( $val, @matches)= @_;
+ $val=~ s{\$(\d+)}{$matches[$1-1]}g;
+ return $val;
+ }
+
# evil hack needed as sometimes
my $encode_is_loaded=0; # so we only load Encode once
sub _utf8_ify
View
17 t/test_3_39.t
@@ -12,12 +12,12 @@ my $DEBUG=0;
use XML::Twig;
-my $TMAX=6;
+my $TMAX=12;
print "1..$TMAX\n";
-=pod
{
my $doc='<d>foo bar fooo baz</d>';
+
my $t= XML::Twig->parse( $doc);
$t->root->split( '(fo+)', e => { att => '$1' } );
is( $t->sprint, '<d><e att="foo">foo</e> bar <e att="fooo">fooo</e> baz</d>', 'split, with $1 on attribute value');
@@ -30,15 +30,20 @@ $t= XML::Twig->parse( $doc);
$t->root->split( '(fo+)', '$1' );
is( $t->sprint, '<d><foo>foo</foo> bar <fooo>fooo</fooo> baz</d>', 'split, with $1 on tag name');
-$t= XML::Twig->parse( $doc);
-$t->root->split( '(fo+)(.*?)(ba)', x => { class => '$1' }, '', x => { class => '$3' });
-is( $t->sprint, '<d><x class="foo">foo</x> <a class="ba">ba</x>r <x class="fooo">fooo</x> <x class="ba">ba</x>z</d>', 'split, with $1 and $2 on att value');
$t= XML::Twig->parse( $doc);
$t->root->split( '(foo+)', '$1', '' );
is( $t->sprint, '<d><foo>foo</foo> bar <fooo>fooo</fooo> baz</d>', 'split, with $1 on tag name');
+
+$t= XML::Twig->parse( $doc);
+$t->root->split( '(fo+)(.*?)(a[rz])', x => { class => 'f' }, '', a => { class => 'x' });
+is( $t->sprint, '<d><x class="f">foo</x> b<a class="x">ar</a> <x class="f">fooo</x> b<a class="x">az</a></d>', 'split, checking that it works with non capturing grouping');
+
+$t= XML::Twig->parse( $doc);
+$t->root->split( '(fo+)(.*?)(a[rz])', x => { class => '$1' }, '', a => { class => '$3' });
+is( $t->sprint, '<d><x class="foo">foo</x> b<a class="ar">ar</a> <x class="fooo">fooo</x> b<a class="az">az</a></d>', 'split, with $1 and $3 on att value');
+
}
-=cut
{ my $t= XML::Twig->parse( '<d><e>e1</e><s><e>e2</e></s></d>');
is( join( '-', $t->findvalues( '//e')), 'e1-e2', 'findvalues');
View
2  t/test_autoencoding_conversion.t
@@ -10,6 +10,8 @@ print "1..2\n";
if( $] < 5.008)
{ skip( 2, "needs perl 5.8 or above to test auto conversion"); }
+elsif( $ENV{PERL_UNICODE} && $ENV{PERL_UNICODE}=~ m{SA})
+ { skip( 2, 'auto conversion does not happen when $PERL_UNICODE set to SA'); }
else
{ _use( 'Encode');

No commit comments for this range

Something went wrong with that request. Please try again.