XML-Parser-Lite-0.719/ 000755 000766 000024 00000000000 12247143354 015464 5 ustar 00fredmoyer staff 000000 000000 XML-Parser-Lite-0.719/Changes 000644 000766 000024 00000000447 12247143333 016761 0 ustar 00fredmoyer staff 000000 000000 Revision history for Perl extension XML::Parser::Lite.
0.719 Mon Dec 2 2013
- RT 90873 - restore test suite
0.718 Tue Nov 26 2013
- add skips for some dependencies
- https://rt.cpan.org/Ticket/Display.html?id=87604
0.717 Thu May 16 01:18:25 2013
- forked from SOAP::Lite 0.716
XML-Parser-Lite-0.719/lib/ 000755 000766 000024 00000000000 12247143354 016232 5 ustar 00fredmoyer staff 000000 000000 XML-Parser-Lite-0.719/Makefile.PL 000644 000766 000024 00000000724 12245165345 017443 0 ustar 00fredmoyer staff 000000 000000 #!/usr/bin/perl
use strict;
use warnings;
use ExtUtils::MakeMaker;
WriteMakefile(
NAME => 'XML::Parser::Lite',
VERSION_FROM => 'lib/XML/Parser/Lite.pm',
PREREQ_PM => {},
ABSTRACT_FROM => 'lib/XML/Parser/Lite.pm',
AUTHOR => 'Byrne Reese (byrne@majordojo.com)',
META_MERGE => {
resources => {
repository =>
'https://github.com/redhotpenguin/perl-XML-Parser-Lite',
},
},
);
XML-Parser-Lite-0.719/MANIFEST 000644 000766 000024 00000000502 12247143354 016612 0 ustar 00fredmoyer staff 000000 000000 Changes
Makefile.PL
MANIFEST
README
lib/XML/Parser/Lite.pm
t/07-xmlrpc_payload.t
t/26-xmlrpc.t
t/27-xmlparserlite.t
t/37-mod_xmlrpc.t
t/adam.xml
t/Lite.t
META.yml Module YAML meta-data (added by MakeMaker)
META.json Module JSON meta-data (added by MakeMaker)
XML-Parser-Lite-0.719/META.json 000644 000766 000024 00000001723 12247143354 017110 0 ustar 00fredmoyer staff 000000 000000 {
"abstract" : "Lightweight regexp-based XML parser",
"author" : [
"Byrne Reese (byrne@majordojo.com)"
],
"dynamic_config" : 1,
"generated_by" : "ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120921",
"license" : [
"unknown"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : "2"
},
"name" : "XML-Parser-Lite",
"no_index" : {
"directory" : [
"t",
"inc"
]
},
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"runtime" : {
"requires" : {}
}
},
"release_status" : "stable",
"resources" : {
"repository" : {
"url" : "https://github.com/redhotpenguin/perl-XML-Parser-Lite"
}
},
"version" : "0.719"
}
XML-Parser-Lite-0.719/META.yml 000644 000766 000024 00000001073 12247143354 016736 0 ustar 00fredmoyer staff 000000 000000 ---
abstract: 'Lightweight regexp-based XML parser'
author:
- 'Byrne Reese (byrne@majordojo.com)'
build_requires:
ExtUtils::MakeMaker: 0
configure_requires:
ExtUtils::MakeMaker: 0
dynamic_config: 1
generated_by: 'ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120921'
license: unknown
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
name: XML-Parser-Lite
no_index:
directory:
- t
- inc
requires: {}
resources:
repository: https://github.com/redhotpenguin/perl-XML-Parser-Lite
version: 0.719
XML-Parser-Lite-0.719/README 000644 000766 000024 00000002207 12245165250 016342 0 ustar 00fredmoyer staff 000000 000000 Xpl version 0.01
================
The README is used to introduce the module and provide instructions on
how to install the module, any machine dependencies it may have (for
example C compilers and installed libraries) and any other information
that should be provided before the module is installed.
A README file is required for CPAN modules since CPAN extracts the
README file from a module distribution so that people browsing the
archive can use it get an idea of the modules uses. It is usually a
good idea to provide version information here so that people can
decide whether fixes for the module are worth downloading.
INSTALLATION
To install this module type the following:
perl Makefile.PL
make
make test
make install
DEPENDENCIES
This module requires these other modules and libraries:
blah blah blah
COPYRIGHT AND LICENCE
Put the correct copyright and licence information here.
Copyright (C) 2013 by Fred Moyer
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.16.1 or,
at your option, any later version of Perl 5 you may have available.
XML-Parser-Lite-0.719/t/ 000755 000766 000024 00000000000 12247143354 015727 5 ustar 00fredmoyer staff 000000 000000 XML-Parser-Lite-0.719/t/07-xmlrpc_payload.t 000644 000766 000024 00000003771 12245207157 021366 0 ustar 00fredmoyer staff 000000 000000 #!/usr/bin/perl
use strict;
use warnings;
use Test::More;
BEGIN { plan tests => 8 }
eval { require XMLRPC::Lite };
SKIP: {
skip 'need XMLRPC::Lite', 8 if $@;
my ( $a, $s, $r, $serialized, $deserialized );
print "XML-RPC deserialization test(s)...\n";
$deserialized = XMLRPC::Deserializer->deserialize(
'
SOAP.Lite.Bug.Report
ThisWorks
'
)->root;
ok( $deserialized->{params}->[0]->{This} eq 'Works' );
$serialized = XMLRPC::Serializer->serialize(
{ param1 => 'value1', param2 => undef, param3 => 0 } );
ok( $serialized =~ m!param2! );
ok( $serialized =~
m!param30! );
$deserialized = XMLRPC::Deserializer->deserialize($serialized)->root;
ok( $deserialized->{param2} eq '' );
ok( $deserialized->{param3} == 0 );
$serialized =
XMLRPC::Serializer->method(
a => { param1 => 'value1', param2 => undef, param3 => 'value3' } );
ok( $serialized =~
m!a(param1value1|param2|param3value3){3}!
);
$serialized = XMLRPC::Serializer->method( a => { param1 => 'value1' } );
ok( $serialized eq
'aparam1value1'
);
eval { XMLRPC::Serializer->serialize( XMLRPC::Data->type( base63 => 1 ) ) };
ok( $@ =~ /unsupported datatype/ );
}
XML-Parser-Lite-0.719/t/26-xmlrpc.t 000644 000766 000024 00000004322 12245206727 017651 0 ustar 00fredmoyer staff 000000 000000 #!/bin/perl
use strict;
use warnings;
use Test::More;
BEGIN { plan tests => 6 }
eval { require XMLRPC::Lite; require SOAP::Test; };
SKIP: {
skip 'need XMLRPC::Lite and SOAP::Test', 6 if $@;
my ( $a, $s, $r );
my $proxy = 'http://betty.userland.com/RPC2';
# ------------------------------------------------------
$s = XMLRPC::Lite->proxy($proxy)->on_fault( sub { } );
eval {
$s->transport->timeout( $SOAP::Test::TIMEOUT = $SOAP::Test::TIMEOUT );
};
$r = $s->test_connection;
unless ( defined $r && defined $r->envelope ) {
skip 'need XMLRPC::Lite', 8 if $@;
print "1..0 # Skip: ", $s->transport->status, "\n";
exit;
}
# ------------------------------------------------------
ok(
(
XMLRPC::Lite->proxy($proxy)
->call( 'examples.getStateStruct',
{ state1 => 12, state2 => 28 } )->result
or ''
) eq 'Idaho,Nevada'
);
ok(
(
XMLRPC::Lite->proxy($proxy)->call( 'examples.getStateName', 21 )
->result
or ''
) eq 'Massachusetts'
);
ok(
(
XMLRPC::Lite->proxy($proxy)
->call( 'examples.getStateNames', 21, 22, 23, 24 )->result
or ''
) =~ /Massachusetts\s+Michigan\s+Minnesota\s+Mississippi/
);
$s =
XMLRPC::Lite->proxy($proxy)->call( 'examples.getStateList', [ 21, 22 ] );
ok( ( $s->result or '' ) eq 'Massachusetts,Michigan' );
ok( !defined $s->fault );
ok( !defined $s->faultcode );
print "XMLRPC autodispatch and fault check test(s)...\n";
eval "use XMLRPC::Lite +autodispatch =>
proxy => '$proxy',
; 1" or die;
$r = XMLRPC->getStateName(21);
# Looks like this test requires saving away the result of the
# last call - which introduces a memory leak (removed in 0.70_01)
# Looks like we'll have to introduce different Fault handling...
#
#
print "#TODO: fix fault handling ...\n";
last;
$r = XMLRPC::Lite->self->call;
ok( ref $r->fault eq 'HASH' );
ok( $r->fault->{faultString} =~ /Can't evaluate/ );
ok( $r->faultstring =~ /Can't evaluate/ );
ok( $r->faultcode == 7 );
}
XML-Parser-Lite-0.719/t/27-xmlparserlite.t 000644 000766 000024 00000003613 12245165250 021235 0 ustar 00fredmoyer staff 000000 000000 #!/bin/env perl
BEGIN {
unless(grep /blib/, @INC) {
chdir 't' if -d 't';
unshift @INC, '../lib' if -d '../lib';
}
}
use strict;
use diagnostics;
use Test;
unless (eval { require XML::Parser::Lite }) {
print "1..0 # Skip: ", $@, "\n";
exit;
}
plan tests => 17;
my($s, $c, $e, $a);
($s, $c, $e) = (0) x 3;
my $p1 = XML::Parser::Lite->new();
ok(1 => 1);
$p1->setHandlers(
Start => sub { shift; $s++; print "start: @_\n" },
Char => sub { shift; $c++; print "char: @_\n" },
End => sub { shift; $e++; print "end: @_\n" },
);
$p1->parse('Hello World!');
ok($s == 1);
ok($c == 1);
ok($e == 1);
($s, $c, $e) = (0) x 3;
my %foo;
my $p2 = new XML::Parser::Lite
Handlers => {
Start => sub { shift; $s++; %foo = @_[1..$#_] if $_[0] eq 'foo'; print "start: @_\n" },
Char => sub { shift; $c++; print "char: @_\n" },
End => sub { shift; $e++; print "end: @_\n" },
}
;
$p2->parse('Hello cruel World!');
ok(1 => 1);
ok($s == 3);
ok($c == 4);
ok($e == 3);
ok($foo{id} eq 'me');
ok(defined $foo{root} && $foo{root} eq '0');
ok(defined $foo{empty} && $foo{empty} eq '');
$p2->setHandlers;
# check for junk before
eval { $p2->parse('fooHello World!') };
ok($@ =~ /^junk .+ before/);
# check for junk after
eval { $p2->parse('Hello World!bar') };
ok($@ =~ /^junk .+ after/);
# check for non-closed tag
eval { $p2->parse('Hello World!') };
ok($@ =~ /^not properly closed tag 'foo'/);
# check for non properly closed tag
eval { $p2->parse('Hello World!') };
ok($@ =~ /^mismatched tag 'foo'/);
# check for unwanted tag
eval { $p2->parse('Hello World!') };
ok($@ =~ /^multiple roots, wrong element 'bar'/);
# check for string without elements
eval { $p2->parse(' ') };
ok($@ =~ /^no element found/);
XML-Parser-Lite-0.719/t/37-mod_xmlrpc.t 000644 000766 000024 00000000375 12245207201 020502 0 ustar 00fredmoyer staff 000000 000000 #!/usr/bin/perl
use strict;
use warnings;
use Test::More;
BEGIN { plan tests => 17 }
eval { require XMLRPC::Lite };
SKIP: {
skip 'need XMLRPC::Lite', 17 if $@;
XMLRPC::Test::Server::run_for( shift || 'http://localhost/mod_xmlrpc' );
}
XML-Parser-Lite-0.719/t/adam.xml 000644 000766 000024 00000010655 12245165250 017357 0 ustar 00fredmoyer staff 000000 000000
640
480
640,480,32
0x78F84839
0xC07B38CB
0xB408F7BE
0x78F84839
0xC07B38CB
0xB408F7BE
0xB408F7BE
1
BEACHBALL
x8d24
0x096A3BCC
0x962F2E42
0x962F2E42
0x096A3BCC
0x962F2E42
0x962F2E42
0x962F2E42
1
CHECKERBOARD
x8d24
0x25D49060
0x25D49060
0x25D49060
0x25D49060
0x25D49060
0x25D49060
0x25D49060
0
rocks.bmp
dogs.bmp
0x7D9BDFFA
0x7D9BDFFA
0x7D9BDFFA
0x7D9BDFFA
0x7D9BDFFA
0x7D9BDFFA
0x7D9BDFFA
1
rocks.bmp
dogs.bmp
0x58CCFA12
0x58CCFA12
0x58CCFA12
0x58CCFA12
0x58CCFA12
0x58CCFA12
0x58CCFA12
XML-Parser-Lite-0.719/t/Lite.t 000644 000766 000024 00000005406 12245165250 017013 0 ustar 00fredmoyer staff 000000 000000 use strict;
use Test::More tests => 38;
use_ok qw(XML::Parser::Lite);
my $parser;
ok $parser = XML::Parser::Lite->new(), 'Create parser';
is $parser, $parser->new();
isa_ok $parser, 'XML::Parser::Lite';
my @start_from = ();
my @text_from = ();
my @end_from = ();
my @final_from = ();
sub _reset {
@final_from = ();
@text_from = ();
@start_from = ();
@end_from = ();
}
my %handler_of = (
Final => sub { push @final_from, 1; },
Char => sub { push @text_from, $_[1]; },
Start => sub { push @start_from, $_[1]; },
End => sub { push @end_from, $_[1]; },
);
$parser->setHandlers( Final => undef, );
$parser->setHandlers( %handler_of );
test_parse($parser);
ok $parser = XML::Parser::Lite->new( Handlers => { %handler_of }), 'Create parser';
test_parse($parser);
$parser->setHandlers( Char => undef );
eval { $parser->parse('barbar') };
like $@ , qr{ multiple \s roots, \s wrong \s element}x, 'detect multiple roots';
ok $parser->parse('
'
), 'parse xml with whitespaces/newlines before XML';
eval { $parser->parse('Foobarbarbar') };
like $@ , qr{ junk \s 'Foobar' \s before \s XML \s element}x, 'detect junk before XML';
eval { $parser->parse('barFoobarbar') };
like $@ , qr{ junk \s 'Foobar' \s after \s XML \s element}x, 'detect junk after XML';
SKIP: {
skip 'need File::Basename for resolveing filename', 1
if ( ! eval "require File::Basename");
my $dir = File::Basename::dirname( __FILE__ );
$parser = XML::Parser::Lite->new();
open my $fh, '<', "$dir/adam.xml";
my $xml = join ("\n", <$fh>);
close $fh;
$parser->parse($xml);
pass 'parse XML with doctype and processing instructions';
};
sub test_parse {
_reset();
my $parser = shift;
$parser->parse('bar');
is $text_from[0], 'bar', 'char callback';
is $start_from[0], 'foo', 'start callback';
is $final_from[0], 1, 'final callback';
_reset();
$parser->parse('barbar');
is $text_from[1], 'bar', 'char callback';
is $start_from[0], 'baz', 'start callback';
is $start_from[1], 'foo', 'start callback';
is $start_from[2], 'foo', 'start callback';
is $end_from[2], 'baz', 'start callback';
is $end_from[1], 'foo', 'start callback';
is $end_from[0], 'foo', 'start callback';
is $final_from[0], 1, 'final callback';
eval { $parser->parse('baz'); };
like $@, qr{ not \s properly \s closed \s }x, 'detect unclosed tag';
eval { $parser->parse(''); };
like $@, qr{ no \s element \s found \s }x, 'detect no element';
eval { $parser->parse('baz'); };
like $@, qr{ mismatched \s tag\s }x, 'detect mismatched tag';
}
XML-Parser-Lite-0.719/lib/XML/ 000755 000766 000024 00000000000 12247143354 016672 5 ustar 00fredmoyer staff 000000 000000 XML-Parser-Lite-0.719/lib/XML/Parser/ 000755 000766 000024 00000000000 12247143354 020126 5 ustar 00fredmoyer staff 000000 000000 XML-Parser-Lite-0.719/lib/XML/Parser/Lite.pm 000644 000766 000024 00000025012 12247143343 021357 0 ustar 00fredmoyer staff 000000 000000 # ======================================================================
#
# Copyright (C) 2000-2007 Paul Kulchenko (paulclinger@yahoo.com)
# Copyright (C) 2008 Martin Kutter (martin.kutter@fen-net.de)
# SOAP::Lite is free software; you can redistribute it
# and/or modify it under the same terms as Perl itself.
#
# ======================================================================
package XML::Parser::Lite;
use strict;
use warnings;
our $VERSION = 0.719;
sub new {
my $class = shift;
return $class if ref $class;
my $self = bless {} => $class;
my %parameters = @_;
$self->setHandlers(); # clear first
$self->setHandlers(%{$parameters{Handlers} || {}});
return $self;
}
sub setHandlers {
my $self = shift;
# allow symbolic refs, avoid "subroutine redefined" warnings
no strict 'refs';
no warnings qw(redefine);
# clear all handlers if called without parameters
if (not @_) {
for (qw(Start End Char Final Init Comment Doctype XMLDecl)) {
*$_ = sub {}
}
}
# we could use each here, too...
while (@_) {
my($name, $func) = splice(@_, 0, 2);
*$name = defined $func
? $func
: sub {}
}
return $self;
}
sub _regexp {
my $patch = shift || '';
my $package = __PACKAGE__;
# This parser is based on "shallow parser" http://www.cs.sfu.ca/~cameron/REX.html
# Robert D. Cameron "REX: XML Shallow Parsing with Regular Expressions",
# Technical Report TR 1998-17, School of Computing Science, Simon Fraser University, November, 1998.
# Copyright (c) 1998, Robert D. Cameron.
# The following code may be freely used and distributed provided that
# this copyright and citation notice remains intact and that modifications
# or additions are clearly identified.
# Modifications may be tracked on SOAP::Lite's SVN at
# https://soaplite.svn.sourceforge.net/svnroot/soaplite/
#
use re 'eval';
my $TextSE = "[^<]+";
my $UntilHyphen = "[^-]*-";
my $Until2Hyphens = "([^-]*)-(?:[^-]$[^-]*-)*-";
#my $CommentCE = "$Until2Hyphens(?{${package}::comment(\$2)})>?";
my $CommentCE = "(.+)--(?{${package}::comment(\$2)})>?";
# my $Until2Hyphens = "$UntilHyphen(?:[^-]$UntilHyphen)*-";
# my $CommentCE = "$Until2Hyphens>?";
my $UntilRSBs = "[^\\]]*](?:[^\\]]+])*]+";
my $CDATA_CE = "$UntilRSBs(?:[^\\]>]$UntilRSBs)*>";
my $S = "[ \\n\\t\\r]+";
my $NameStrt = "[A-Za-z_:]|[^\\x00-\\x7F]";
my $NameChar = "[A-Za-z0-9_:.-]|[^\\x00-\\x7F]";
my $Name = "(?:$NameStrt)(?:$NameChar)*";
my $QuoteSE = "\"[^\"]*\"|'[^']*'";
my $DT_IdentSE = "$Name(?:$S(?:$Name|$QuoteSE))*";
# my $DT_IdentSE = "$S$Name(?:$S(?:$Name|$QuoteSE))*";
my $MarkupDeclCE = "(?:[^\\]\"'><]+|$QuoteSE)*>";
my $S1 = "[\\n\\r\\t ]";
my $UntilQMs = "[^?]*\\?";
my $PI_Tail = "\\?>|$S1$UntilQMs(?:[^>?]$UntilQMs)*";
my $DT_ItemSE = "<(?:!(?:--$Until2Hyphens>|[^-]$MarkupDeclCE)|\\?$Name(?:$PI_Tail>))|%$Name;|$S";
my $DocTypeCE = "$S($DT_IdentSE(?:$S)?(?:\\[(?:$DT_ItemSE)*](?:$S)?)?)>(?{${package}::_doctype(\$3)})";
# my $PI_Tail = "\\?>|$S1$UntilQMs(?:[^>?]$UntilQMs)*>";
# my $DT_ItemSE = "<(?:!(?:--$Until2Hyphens>|[^-]$MarkupDeclCE)|\\?$Name(?:$PI_Tail))|%$Name;|$S";
# my $DocTypeCE = "$DT_IdentSE(?:$S)?(?:\\[(?:$DT_ItemSE)*](?:$S)?)?>?";
my $DeclCE = "--(?:$CommentCE)?|\\[CDATA\\[(?:$CDATA_CE)?|DOCTYPE(?:$DocTypeCE)?";
# my $PI_CE = "$Name(?:$PI_Tail)?";
my $PI_CE = "($Name(?:$PI_Tail))>(?{${package}::_xmldecl(\$5)})";
# these expressions were modified for backtracking and events
# my $EndTagCE = "($Name)(?{${package}::_end(\$2)})(?:$S)?>";
my $EndTagCE = "($Name)(?{${package}::_end(\$6)})(?:$S)?>";
my $AttValSE = "\"([^<\"]*)\"|'([^<']*)'";
# my $ElemTagCE = "($Name)(?:$S($Name)(?:$S)?=(?:$S)?(?:$AttValSE)(?{[\@{\$^R||[]},\$4=>defined\$5?\$5:\$6]}))*(?:$S)?(/)?>(?{${package}::_start( \$3,\@{\$^R||[]})})(?{\${7} and ${package}::_end(\$3)})";
my $ElemTagCE = "($Name)"
. "(?:$S($Name)(?:$S)?=(?:$S)?(?:$AttValSE)"
. "(?{[\@{\$^R||[]},\$8=>defined\$9?\$9:\$10]}))*(?:$S)?(/)?>"
. "(?{${package}::_start(\$7,\@{\$^R||[]})})(?{\$11 and ${package}::_end(\$7)})";
my $MarkupSPE = "<(?:!(?:$DeclCE)?|\\?(?:$PI_CE)?|/(?:$EndTagCE)?|(?:$ElemTagCE)?)";
# Next expression is under "black magic".
# Ideally it should be '($TextSE)(?{${package}::char(\$1)})|$MarkupSPE',
# but it doesn't work under Perl 5.005 and only magic with
# (?:....)?? solved the problem.
# I would appreciate if someone let me know what is the right thing to do
# and what's the reason for all this magic.
# Seems like a problem related to (?:....)? rather than to ?{} feature.
# Tests are in t/31-xmlparserlite.t if you decide to play with it.
#"(?{[]})(?:($TextSE)(?{${package}::_char(\$1)}))$patch|$MarkupSPE";
"(?:($TextSE)(?{${package}::_char(\$1)}))$patch|$MarkupSPE";
}
setHandlers();
# Try 5.6 and 5.10 regex first
my $REGEXP = _regexp('??');
sub _parse_re {
use re "eval";
undef $^R;
no strict 'refs';
1 while $_[0] =~ m{$REGEXP}go
};
# fixup regex if it does not work...
{
if (not eval { _parse_re('bar'); 1; } ) {
$REGEXP = _regexp();
local $^W;
*_parse_re = sub {
use re "eval";
undef $^R;
1 while $_[0] =~ m{$REGEXP}go
};
}
}
sub parse {
_init();
_parse_re($_[1]);
_final();
}
my(@stack, $level);
sub _init {
@stack = ();
$level = 0;
Init(__PACKAGE__, @_);
}
sub _final {
die "not properly closed tag '$stack[-1]'\n" if @stack;
die "no element found\n" unless $level;
Final(__PACKAGE__, @_)
}
sub _start {
die "multiple roots, wrong element '$_[0]'\n" if $level++ && !@stack;
push(@stack, $_[0]);
my $r=Start(__PACKAGE__, @_);
return ref($r) eq 'ARRAY' ? $r : undef;
}
sub _char {
Char(__PACKAGE__, $_[0]), return if @stack;
# check for junk before or after element
# can't use split or regexp due to limitations in ?{} implementation,
# 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"
if index("\n\r\t ", substr($_[0],$i,1)) < 0; # or should '< $[' be there
}
}
sub _end {
no warnings qw(uninitialized);
pop(@stack) eq $_[0] or die "mismatched tag '$_[0]'\n";
my $r=End(__PACKAGE__, $_[0]);
return ref($r) eq 'ARRAY' ? $r : undef;
}
sub comment {
my $r=Comment(__PACKAGE__, $_[0]);
return ref($r) eq 'ARRAY' ? $r : undef;
}
sub end {
pop(@stack) eq $_[0] or die "mismatched tag '$_[0]'\n";
my $r=End(__PACKAGE__, $_[0]);
return ref($r) eq 'ARRAY' ? $r : undef;
}
sub _doctype {
my $r=Doctype(__PACKAGE__, $_[0]);
return ref($r) eq 'ARRAY' ? $r : undef;
}
sub _xmldecl {
XMLDecl(__PACKAGE__, $_[0]);
}
# ======================================================================
1;
__END__
=head1 NAME
XML::Parser::Lite - Lightweight regexp-based XML parser
=head1 SYNOPSIS
use XML::Parser::Lite;
$p1 = new XML::Parser::Lite;
$p1->setHandlers(
Start => sub { shift; print "start: @_\n" },
Char => sub { shift; print "char: @_\n" },
End => sub { shift; print "end: @_\n" },
);
$p1->parse('Hello World!');
$p2 = new XML::Parser::Lite
Handlers => {
Start => sub { shift; print "start: @_\n" },
Char => sub { shift; print "char: @_\n" },
End => sub { shift; print "end: @_\n" },
}
;
$p2->parse('Hello cruel World!');
=head1 DESCRIPTION
This Perl implements an XML parser with a interface similar to
XML::Parser. Though not all callbacks are supported, you should be able to
use it in the same way you use XML::Parser. Due to using experimental regexp
features it'll work only on Perl 5.6 and above and may behave differently on
different platforms.
Note that you cannot use regular expressions or split in callbacks. This is
due to a limitation of perl's regular expression implementation (which is
not re-entrant).
=head1 SUBROUTINES/METHODS
=head2 new
Constructor.
As (almost) all SOAP::Lite constructors, new() returns the object called on
when called as object method. This means that the following effectively is
a no-op if $obj is a object:
$obj = $obj->new();
New accepts a single named parameter, C with a hash ref as value:
my $parser = XML::Parser::Lite->new(
Handlers => {
Start => sub { shift; print "start: @_\n" },
Char => sub { shift; print "char: @_\n" },
End => sub { shift; print "end: @_\n" },
}
);
The handlers given will be passed to setHandlers.
=head2 setHandlers
Sets (or resets) the parsing handlers. Accepts a hash with the handler names
and handler code references as parameters. Passing C instead of a
code reference replaces the handler by a no-op.
The following handlers can be set:
Init
Start
Char
End
Final
All other handlers are ignored.
Calling setHandlers without parameters resets all handlers to no-ops.
=head2 parse
Parses the XML given. In contrast to L's parse
method, parse() only parses strings.
=head1 Handler methods
=head2 Init
Called before parsing starts. You should perform any necessary initializations
in Init.
=head2 Start
Called at the start of each XML node. See L for details.
=head2 Char
Called for each character sequence. May be called multiple times for the
characters contained in an XML node (even for every single character).
Your implementation has to make sure that it captures all characters.
=head2 End
Called at the end of each XML node. See L for details
=head2 Comment
See L for details
=head2 XMLDecl
See L for details
=head2 Doctype
See L for details
=head2 Final
Called at the end of the parsing process. You should perform any necessary
cleanup here.
=head1 SEE ALSO
XML::Parser
=head1 COPYRIGHT
Copyright (C) 2000-2007 Paul Kulchenko. All rights reserved.
Copyright (C) 2008- Martin Kutter. All rights reserved.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
This parser is based on "shallow parser" http://www.cs.sfu.ca/~cameron/REX.html
Copyright (c) 1998, Robert D. Cameron.
=head1 AUTHOR
Paul Kulchenko (paulclinger@yahoo.com)
Martin Kutter (martin.kutter@fen-net.de)
Additional handlers supplied by Adam Leggett.
=cut