r75184 - in /trunk/libxml-parser-lite-tree-perl: META.yml debian/changelog lib/XML/Parser/Lite/Tree.pm lib/XML/Parser/LiteCopy.pm t/00_xmlparserlite.t

gregoa at users.alioth.debian.org gregoa at users.alioth.debian.org
Sun Jun 5 15:30:50 UTC 2011


Author: gregoa
Date: Sun Jun  5 15:30:43 2011
New Revision: 75184

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=75184
Log:
* New upstream release (closes: #629295).

Modified:
    trunk/libxml-parser-lite-tree-perl/META.yml
    trunk/libxml-parser-lite-tree-perl/debian/changelog
    trunk/libxml-parser-lite-tree-perl/lib/XML/Parser/Lite/Tree.pm
    trunk/libxml-parser-lite-tree-perl/lib/XML/Parser/LiteCopy.pm
    trunk/libxml-parser-lite-tree-perl/t/00_xmlparserlite.t

Modified: trunk/libxml-parser-lite-tree-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libxml-parser-lite-tree-perl/META.yml?rev=75184&op=diff
==============================================================================
--- trunk/libxml-parser-lite-tree-perl/META.yml (original)
+++ trunk/libxml-parser-lite-tree-perl/META.yml Sun Jun  5 15:30:43 2011
@@ -1,11 +1,21 @@
-# http://module-build.sourceforge.net/META-spec.html
-#XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
-name:         XML-Parser-Lite-Tree
-version:      0.12
-version_from: lib/XML/Parser/Lite/Tree.pm
-installdirs:  site
+--- #YAML:1.0
+name:               XML-Parser-Lite-Tree
+version:            0.14
+abstract:           ~
+author:  []
+license:            unknown
+distribution_type:  module
+configure_requires:
+    ExtUtils::MakeMaker:  0
+build_requires:
+    ExtUtils::MakeMaker:  0
 requires:
-    Test::More:                    0
-
-distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.30
+    Test::More:  0
+no_index:
+    directory:
+        - t
+        - inc
+generated_by:       ExtUtils::MakeMaker version 6.56
+meta-spec:
+    url:      http://module-build.sourceforge.net/META-spec-v1.4.html
+    version:  1.4

Modified: trunk/libxml-parser-lite-tree-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libxml-parser-lite-tree-perl/debian/changelog?rev=75184&op=diff
==============================================================================
--- trunk/libxml-parser-lite-tree-perl/debian/changelog (original)
+++ trunk/libxml-parser-lite-tree-perl/debian/changelog Sun Jun  5 15:30:43 2011
@@ -1,8 +1,12 @@
-libxml-parser-lite-tree-perl (0.12-2) UNRELEASED; urgency=low
+libxml-parser-lite-tree-perl (0.14-1) UNRELEASED; urgency=low
 
-  * Update my email address.
+  [ Salvatore Bonaccorso ]
+  * Email change: Salvatore Bonaccorso -> carnil at debian.org
 
- -- Salvatore Bonaccorso <carnil at debian.org>  Sun, 10 Oct 2010 15:03:50 +0200
+  [ gregor herrmann ]
+  * New upstream release (closes: #629295).
+
+ -- gregor herrmann <gregoa at debian.org>  Sun, 05 Jun 2011 17:29:32 +0200
 
 libxml-parser-lite-tree-perl (0.12-1) unstable; urgency=low
 

Modified: trunk/libxml-parser-lite-tree-perl/lib/XML/Parser/Lite/Tree.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libxml-parser-lite-tree-perl/lib/XML/Parser/Lite/Tree.pm?rev=75184&op=diff
==============================================================================
--- trunk/libxml-parser-lite-tree-perl/lib/XML/Parser/Lite/Tree.pm (original)
+++ trunk/libxml-parser-lite-tree-perl/lib/XML/Parser/Lite/Tree.pm Sun Jun  5 15:30:43 2011
@@ -5,7 +5,7 @@
 use warnings;
 use XML::Parser::LiteCopy;
 
-our $VERSION = '0.12';
+our $VERSION = '0.14';
 
 use vars qw( $parser );
 

Modified: trunk/libxml-parser-lite-tree-perl/lib/XML/Parser/LiteCopy.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libxml-parser-lite-tree-perl/lib/XML/Parser/LiteCopy.pm?rev=75184&op=diff
==============================================================================
--- trunk/libxml-parser-lite-tree-perl/lib/XML/Parser/LiteCopy.pm (original)
+++ trunk/libxml-parser-lite-tree-perl/lib/XML/Parser/LiteCopy.pm Sun Jun  5 15:30:43 2011
@@ -6,7 +6,7 @@
 #
 # Copyright (C) 2000-2007 Paul Kulchenko (paulclinger at yahoo.com)
 # Copyright (C) 2008 Martin Kutter (martin.kutter at fen-net.de)
-# Copyright (C) 2009 Cal Henderson (cal at iamcal.com)
+# Copyright (C) 2009-2011 Cal Henderson (cal at iamcal.com)
 #
 # SOAP::Lite is free software; you can redistribute it
 # and/or modify it under the same terms as Perl itself.
@@ -18,6 +18,8 @@
 use vars qw($VERSION);
 $VERSION = '0.720.00';
 
+my $ReturnErrors = 0;
+
 sub new {
     my $class = shift;
 
@@ -27,6 +29,8 @@
     my %parameters = @_;
     $self->setHandlers(); # clear first
     $self->setHandlers(%{$parameters{Handlers} || {}});
+
+    $ReturnErrors = $parameters{ReturnErrors} || 0;
 
     return $self;
 }
@@ -38,7 +42,7 @@
     no strict 'refs'; local $^W;
     # clear all handlers if called without parameters
     if (not @_) {
-        for (qw(Start End Char Final Init CData Comment Doctype PI)) {
+        for (qw(Start End Char Final Init CData Comment Doctype PI Error)) {
             *$_ = sub {}
         }
     }
@@ -100,17 +104,17 @@
 
     my $DeclCE = "--(?:$CommentCE)?|\\[CDATA\\[(?:$CDATA_CE)?|DOCTYPE(?:$DocTypeCE)?";
 
-    my $PI_CE = "($Name(?:$PI_Tail))>(?{${package}::_pi(\$5)})";
+    my $PI_CE = "($Name(?:$PI_Tail))>(?{${package}::_pi(\$5); undef})";
 
     # these expressions were modified for backtracking and events
 
-    my $EndTagCE = "($Name)(?{${package}::_end(\$6)})(?:$S)?>";
+    my $EndTagCE = "($Name)(?{${package}::_end(\$6); undef})(?:$S)?>";
     my $AttValSE = "\"([^<\"]*)\"|'([^<']*)'";
 
     my $ElemTagCE = "($Name)"
         . "(?:$S($Name)(?:$S)?=(?:$S)?(?:$AttValSE)"
         . "(?{[\@{\$^R||[]},\$8=>defined\$9?\$9:\$10]}))*(?:$S)?(/)?>"
-        . "(?{${package}::_start(\$7,\@{\$^R||[]}),\$^R=[]})(?{\$11 and ${package}::_end(\$7)})";
+        . "(?{${package}::_start(\$7,\@{\$^R||[]}),\$^R=[]})(?{\$11 and ${package}::_end(\$7); undef})";
 
     my $MarkupSPE = "<(?:!(?:$DeclCE)?|\\?(?:$PI_CE)?|/(?:$EndTagCE)?|(?:$ElemTagCE)?)";
 
@@ -165,13 +169,13 @@
 }
 
 sub _final {
-    die "not properly closed tag '$stack[-1]'\n" if @stack;
-    die "no element found\n" unless $level;
+    return _error("not properly closed tag '$stack[-1]'") if @stack;
+    return _error("no element found") unless $level;
     Final(__PACKAGE__, @_)
 }
 
 sub _start {
-    die "multiple roots, wrong element '$_[0]'\n" if $level++ && !@stack;
+    return _error("multiple roots, wrong element '$_[0]'") if $level++ && !@stack;
     push(@stack, $_[0]);
     Start(__PACKAGE__, @_);
 }
@@ -184,13 +188,14 @@
     # will iterate with loop, but we'll do it no more than two times, so
     # it shouldn't affect performance
     for (my $i=0; $i < length $_[0]; $i++) {
-        die "junk '$_[0]' @{[$level ? 'after' : 'before']} XML element\n"
+        return _error("junk '$_[0]' @{[$level ? 'after' : 'before']} XML element")
         if index("\n\r\t ", substr($_[0],$i,1)) < 0; # or should '< $[' be there
     }
 }
 
 sub _end {
-    pop(@stack) eq $_[0] or die "mismatched tag '$_[0]'\n";
+    return _error("unexpected closing tag '$_[0]'") if !@stack;
+    pop(@stack) eq $_[0] or return _error("mismatched tag '$_[0]'");
     End(__PACKAGE__, $_[0]);
 }
 
@@ -199,12 +204,12 @@
 }
 
 sub end {
-     pop(@stack) eq $_[0] or die "mismatched tag '$_[0]'\n";
+     pop(@stack) eq $_[0] or return _error("mismatched tag '$_[0]'");
      End(__PACKAGE__, $_[0]);
 }
 
 sub cdata {
-    die "CDATA outside of tag stack" unless @stack;
+    return _error("CDATA outside of tag stack") unless @stack;
     CData(__PACKAGE__, substr $_[0], 0, -2);
 }
 
@@ -214,6 +219,14 @@
 
 sub _pi {
     PI(__PACKAGE__, substr $_[0], 0, -1);
+}
+
+sub _error {
+    if ($ReturnErrors){
+      Error(__PACKAGE__, $_[0]);
+      return;
+    }
+    die "$_[0]\n";
 }
 
 # ======================================================================

Modified: trunk/libxml-parser-lite-tree-perl/t/00_xmlparserlite.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libxml-parser-lite-tree-perl/t/00_xmlparserlite.t?rev=75184&op=diff
==============================================================================
--- trunk/libxml-parser-lite-tree-perl/t/00_xmlparserlite.t (original)
+++ trunk/libxml-parser-lite-tree-perl/t/00_xmlparserlite.t Sun Jun  5 15:30:43 2011
@@ -1,4 +1,4 @@
-use Test::More tests => 67;
+use Test::More tests => 81;
 
 use XML::Parser::LiteCopy;
 use Data::Dumper;
@@ -37,6 +37,7 @@
     End => sub { $e++; },
   }
 ;
+
 $p2->parse('<foo id="me" root="0" empty="">Hello <bar>cruel</bar> <foobar/> World!</foo>');
 is($s, 3);
 is($c, 4);
@@ -145,31 +146,36 @@
 # error conditions
 #
 
-$p2->setHandlers;
+sub test_error {
+  my @errors;
+  my $p = new XML::Parser::LiteCopy
+    Handlers => {
+      Error => sub { push @errors, $_[1]; },
+    },
+    ReturnErrors => 1
+  ;
+  my $in = shift;
+  $p->parse($in);
 
-# check for junk before
-eval { $p2->parse('foo<foo id="me">Hello World!</foo>') };
-ok($@ =~ /^junk .+ before/);
+  # first test method gets a list of errors from the Error() event handler
+  is(scalar @errors, scalar @_);
+  for my $i(0..scalar @_-1){
+    like($errors[$i], $_[$i]);
+  }
 
-# check for junk after
-eval { $p2->parse('<foo id="me">Hello World!</foo>bar') };
-ok($@ =~ /^junk .+ after/);
+  # and then we check it dies correctly
+  my $p2 = new XML::Parser::LiteCopy;
+  eval { $p2->parse($in); };
 
-# check for non-closed tag
-eval { $p2->parse('<foo id="me">Hello World!') };
-ok($@ =~ /^not properly closed tag 'foo'/);
+  like($@, $_[0]);
+}
 
-# check for non properly closed tag
-eval { $p2->parse('<foo id="me">Hello World!<bar></foo></bar>') };
-ok($@ =~ /^mismatched tag 'foo'/);
-
-# check for unwanted tag
-eval { $p2->parse('<foo id="me">Hello World!</foo><bar></bar>') };
-ok($@ =~ /^multiple roots, wrong element 'bar'/);
-
-# check for string without elements
-eval { $p2->parse('  ') };
-ok($@ =~ /^no element found/);
+&test_error('foo<foo id="me">Hello World!</foo>', qr/^junk .+ before/);
+&test_error('<foo id="me">Hello World!</foo>bar', qr/^junk .+ after/);
+&test_error('<foo id="me">Hello World!', qr/^not properly closed tag 'foo'/);
+&test_error('<foo id="me">Hello World!<bar></foo></bar>', qr/^mismatched tag 'foo'/, qr/^mismatched tag 'bar'/);
+&test_error('<foo id="me">Hello World!</foo><bar></bar>', qr/^multiple roots, wrong element 'bar'/, qr/^unexpected closing tag 'bar'/);
+&test_error('  ', qr/^no element found/);
 
 # TODO tests
 # check for unclosed PI: $p2->parse('<?pi<foo></foo>');




More information about the Pkg-perl-cvs-commits mailing list