XML-Parser-Lite-0.721/ 000755 000765 000024 00000000000 12531024637 014560 5 ustar 00phred staff 000000 000000 XML-Parser-Lite-0.721/Changes 000644 000765 000024 00000002612 12531024627 016053 0 ustar 00phred staff 000000 000000 Revision history for Perl module XML::Parser::Lite
0.721 2015-05-26 PHRED
- Developer release (with PHRED's permission) to test changes
- Refactored t/37-mod_xmlrpc.t to make the modules it uses optional,
using Test::Requires. RT#91434
- Specified required versions of XMLRPC::Lite and XMLRPC::Test. GH#4
- Specified min perl version of 5.006 in Lite.pm and dist metadata
- Fixed RT#98635 - skip the planned number of tests
- Changed copyright to refer to XML::Parser::Lite rather than SOAP::Lite
(XML::Parser::Lite was forked from SOAP::Lite - see 0.717 below).
RT#92756
- Set PREREQ_PM, TEST_REQUIRES, and CONFIGURE_REQUIRES depending on
whether your version of ExtUtils::MakeMaker supports them.
- Doc tweaks: improved abstract, first paragraph of DESCRIPTION
and the SEE ALSO section.
- Added license type 'perl' to dist metadata, to match the doc.
- Updated this file (Changes) to follow CPAN::Changes::Spec
0.720_01 2015-05-13 NEILB
- Developer release with all the changes subsequently released in 0.721.
0.720 2014-09-15 PHRED
- RT 96206 - add README
- RT 96209 - add links to other parsers
0.719 2013-12-02 PHRED
- RT 90873 - restore test suite
0.718 2013-11-26 PHRED
- add skips for some dependencies
- https://rt.cpan.org/Ticket/Display.html?id=87604
0.717 2013-05-16 PHRED
- forked from SOAP::Lite 0.716
XML-Parser-Lite-0.721/lib/ 000755 000765 000024 00000000000 12531024637 015326 5 ustar 00phred staff 000000 000000 XML-Parser-Lite-0.721/Makefile.PL 000644 000765 000024 00000002305 12531024453 016526 0 ustar 00phred staff 000000 000000 #!/usr/bin/perl
use strict;
use warnings;
use ExtUtils::MakeMaker 6.30;
my $mm_ver = $ExtUtils::MakeMaker::VERSION;
if ($mm_ver =~ /_/) {
# developer release
$mm_ver = eval $mm_ver;
die $@ if $@;
}
my @REQUIRES = (
'strict' => 0,
'warnings' => 0,
);
my @TEST_REQUIRES = (
'Test::More' => 0.88,
'Test::Requires' => 0.06,
'diagnostics' => 0,
);
push(@REQUIRES, @TEST_REQUIRES) if $mm_ver < 6.64;
WriteMakefile(
NAME => 'XML::Parser::Lite',
VERSION_FROM => 'lib/XML/Parser/Lite.pm',
PREREQ_PM => { @REQUIRES },
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',
},
},
($mm_ver >= 6.48
? (MIN_PERL_VERSION => 5.006)
: ()
),
($mm_ver >= 6.31 ? (LICENSE => 'perl') : ()),
($mm_ver >= 6.64
? (TEST_REQUIRES => { @TEST_REQUIRES })
: ()
),
($mm_ver >= 6.52
? (CONFIGURE_REQUIRES => {
'ExtUtils::MakeMaker' => 6.30,
})
: ()
),
);
XML-Parser-Lite-0.721/MANIFEST 000644 000765 000024 00000000502 12531024637 015706 0 ustar 00phred 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.721/META.json 000644 000765 000024 00000002256 12531024637 016206 0 ustar 00phred staff 000000 000000 {
"abstract" : "Lightweight pure-perl XML Parser (based on regexps)",
"author" : [
"Byrne Reese (byrne@majordojo.com)"
],
"dynamic_config" : 1,
"generated_by" : "ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.140640",
"license" : [
"perl_5"
],
"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",
"Test::More" : "0.88",
"Test::Requires" : "0.06",
"diagnostics" : "0"
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "6.3"
}
},
"runtime" : {
"requires" : {
"perl" : "5.006",
"strict" : "0",
"warnings" : "0"
}
}
},
"release_status" : "stable",
"resources" : {
"repository" : {
"url" : "https://github.com/redhotpenguin/perl-XML-Parser-Lite"
}
},
"version" : "0.721"
}
XML-Parser-Lite-0.721/META.yml 000644 000765 000024 00000001274 12531024637 016035 0 ustar 00phred staff 000000 000000 ---
abstract: 'Lightweight pure-perl XML Parser (based on regexps)'
author:
- 'Byrne Reese (byrne@majordojo.com)'
build_requires:
ExtUtils::MakeMaker: '0'
Test::More: '0.88'
Test::Requires: '0.06'
diagnostics: '0'
configure_requires:
ExtUtils::MakeMaker: '6.3'
dynamic_config: 1
generated_by: 'ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.140640'
license: perl
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:
perl: '5.006'
strict: '0'
warnings: '0'
resources:
repository: https://github.com/redhotpenguin/perl-XML-Parser-Lite
version: '0.721'
XML-Parser-Lite-0.721/README 000644 000765 000024 00000007171 12531024453 015442 0 ustar 00phred staff 000000 000000 NAME
XML::Parser::Lite - Lightweight regexp-based XML parser
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!');
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).
SUBROUTINES/METHODS
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, "Handlers" 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.
setHandlers
Sets (or resets) the parsing handlers. Accepts a hash with the handler
names and handler code references as parameters. Passing "undef" 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.
parse
Parses the XML given. In contrast to XML::Parser's parse method, parse()
only parses strings.
Handler methods
Init
Called before parsing starts. You should perform any necessary
initializations in Init.
Start
Called at the start of each XML node. See XML::Parser for details.
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.
End
Called at the end of each XML node. See XML::Parser for details
Comment
See XML::Parser for details
XMLDecl
See XML::Parser for details
Doctype
See XML::Parser for details
Final
Called at the end of the parsing process. You should perform any
necessary cleanup here.
SEE ALSO
XML::Parser
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.
AUTHOR
Paul Kulchenko (paulclinger@yahoo.com)
Martin Kutter (martin.kutter@fen-net.de)
Additional handlers supplied by Adam Leggett.
XML-Parser-Lite-0.721/t/ 000755 000765 000024 00000000000 12531024637 015023 5 ustar 00phred staff 000000 000000 XML-Parser-Lite-0.721/t/07-xmlrpc_payload.t 000644 000765 000024 00000003771 12531024453 020456 0 ustar 00phred 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.721/t/26-xmlrpc.t 000644 000765 000024 00000004322 12531024453 016737 0 ustar 00phred 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', 6 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.721/t/27-xmlparserlite.t 000644 000765 000024 00000003613 12145113643 020331 0 ustar 00phred 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.721/t/37-mod_xmlrpc.t 000644 000765 000024 00000000333 12531024453 017576 0 ustar 00phred staff 000000 000000 #!/usr/bin/perl
use strict;
use warnings;
use Test::More;
use Test::Requires {
'XMLRPC::Lite' => 0.717,
'XMLRPC::Test' => 0.717,
};
XMLRPC::Test::Server::run_for( shift || 'http://localhost/mod_xmlrpc' );
XML-Parser-Lite-0.721/t/adam.xml 000644 000765 000024 00000010655 12145607271 016460 0 ustar 00phred 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.721/t/Lite.t 000644 000765 000024 00000005406 12145607271 016114 0 ustar 00phred 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.721/lib/XML/ 000755 000765 000024 00000000000 12531024637 015766 5 ustar 00phred staff 000000 000000 XML-Parser-Lite-0.721/lib/XML/Parser/ 000755 000765 000024 00000000000 12531024637 017222 5 ustar 00phred staff 000000 000000 XML-Parser-Lite-0.721/lib/XML/Parser/Lite.pm 000644 000765 000024 00000025660 12531024453 020462 0 ustar 00phred staff 000000 000000 # ======================================================================
#
# Copyright (C) 2000-2007 Paul Kulchenko (paulclinger@yahoo.com)
# Copyright (C) 2008 Martin Kutter (martin.kutter@fen-net.de)
# XML::Parser::Lite is free software; you can redistribute it
# and/or modify it under the same terms as Perl itself.
#
# ======================================================================
package XML::Parser::Lite;
use 5.006;
use strict;
use warnings;
our $VERSION = '0.721';
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 pure-perl XML Parser (based on regexps)
=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 module implements an XML parser with a interface similar to
L. 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.
The new() method returns the object called on when called as object method.
This behaviour was inherited from L,
which XML::Parser::Lite was split out from.
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
L - a full-blown XML Parser, on which XML::Parser::Lite is based.
Requires a C compiler and the I XML parser.
L - a fork in L.
L - another pure-perl module for XML parsing.
L - another module that parses XML with regular expressions.
=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"
L
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