XML-Parser-Wrapper-0.04pre1/ 0000755 0000764 0000764 00000000000 10324036550 015125 5 ustar don don 0000000 0000000 XML-Parser-Wrapper-0.04pre1/META.yml 0000644 0000764 0000764 00000000551 10324036550 016377 0 ustar don don 0000000 0000000 # http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: XML-Parser-Wrapper
version: 0.04pre1
version_from: lib/XML/Parser/Wrapper.pm
installdirs: site
requires:
XML::Parser: 0
distribution_type: module
generated_by: ExtUtils::MakeMaker version 6.17
XML-Parser-Wrapper-0.04pre1/t/ 0000755 0000764 0000764 00000000000 10324036550 015370 5 ustar don don 0000000 0000000 XML-Parser-Wrapper-0.04pre1/t/00use.t 0000755 0000764 0000764 00000000540 10232772374 016524 0 ustar don don 0000000 0000000 #!/usr/bin/env perl -w
# Creation date: 2005-04-24 12:24:03
# Authors: Don
# Change log:
# $Id: 00use.t,v 1.1 2005/04/24 19:35:24 don Exp $
use strict;
# main
{
use Test;
BEGIN { plan tests => 1 }
use XML::Parser::Wrapper; ok(1);
}
exit 0;
###############################################################################
# Subroutines
XML-Parser-Wrapper-0.04pre1/t/01element.t 0000755 0000764 0000764 00000001710 10236547460 017362 0 ustar don don 0000000 0000000 #!/usr/bin/env perl -w
# $Id: 01element.t,v 1.1 2005/05/06 01:58:08 don Exp $
use strict;
# main
{
use Test;
BEGIN { plan tests => 3 }
use XML::Parser::Wrapper;
my $xml = q{data with ]]>another elementval1val2val>3};
my $root = XML::Parser::Wrapper->new($xml);
ok($root->name eq 'store');
ok($root->kid('field')->attribute('id') eq $root->kids('field')->[0]->attribute('id'));
ok($root->kid('field')->kid('field')->kid('element')->text eq 'data with ]]>');
}
exit 0;
###############################################################################
# Subroutines
XML-Parser-Wrapper-0.04pre1/MANIFEST 0000644 0000764 0000764 00000000245 10236547134 016266 0 ustar don don 0000000 0000000 MANIFEST
README
INSTALL
Makefile.PL
lib/XML/Parser/Wrapper.pm
t/00use.t
t/01element.t
META.yml Module meta-data (added by MakeMaker)
XML-Parser-Wrapper-0.04pre1/lib/ 0000755 0000764 0000764 00000000000 10324036550 015673 5 ustar don don 0000000 0000000 XML-Parser-Wrapper-0.04pre1/lib/XML/ 0000755 0000764 0000764 00000000000 10324036550 016333 5 ustar don don 0000000 0000000 XML-Parser-Wrapper-0.04pre1/lib/XML/Parser/ 0000755 0000764 0000764 00000000000 10324036550 017567 5 ustar don don 0000000 0000000 XML-Parser-Wrapper-0.04pre1/lib/XML/Parser/Wrapper.pm 0000644 0000764 0000764 00000022605 10321376331 021553 0 ustar don don 0000000 0000000 # -*-perl-*-
# Creation date: 2005-04-23 22:39:14
# Authors: Don
# Change log:
# $Id: Wrapper.pm,v 1.8 2005/10/07 04:43:05 don Exp $
#
# Copyright (c) 2005 Don Owens
#
# All rights reserved. This program is free software; you can
# redistribute it and/or modify it under the same terms as Perl
# itself.
=pod
=head1 NAME
XML::Parser::Wrapper - A simple object wrapper around XML::Parser
=head1 SYNOPSIS
use XML::Parser::Wrapper;
my $xml = qq{Hello World!};
my $root = XML::Parser::Wrapper->new($xml);
my $root2 = XML::Parser::Wrapper->new({ file => '/tmp/test.xml' });
my $root_tag_name = $root->name;
my $roots_children = $root->elements;
foreach my $element (@$roots_children) {
if ($element->name eq 'head') {
my $id = $element->attr('id');
my $hello_world_text = $element->text; # eq "Hello World!"
}
}
my $head_element = $root->element('head2');
my $head_elements = $root->elements('head2');
my $test = $root->element('head2')->element('test_tag');
=head1 DESCRIPTION
XML::Parser::Wrapper provides a simple object around XML::Parser
to make it more convenient to deal with the parse tree returned
by XML::Parser.
=head1 METHODS
=cut
use strict;
use XML::Parser ();
{ package XML::Parser::Wrapper;
use vars qw($VERSION);
$VERSION = '0.04pre1';
=pod
=head2 new($xml), new({ file => $filename })
Calls XML::Parser to parse the given XML and returns a new
XML::Parser::Wrapper object using the parse tree output from
XML::Parser.
=cut
# Takes the 'Tree' style output from XML::Parser and wraps in in objects.
# A parse tree looks like the following:
#
# [foo, [{}, head, [{id => "a"}, 0, "Hello ", em, [{}, 0, "there"]],
# bar, [ {}, 0, "Howdy", ref, [{}]],
# 0, "do"
# ]
# ]
sub new {
my $proto = shift;
my $arg = shift;
my $parser = XML::Parser->new(Style => 'Tree');
my $tree = [];
if (ref($arg) eq 'HASH') {
if (exists($arg->{file})) {
$tree = $parser->parsefile($arg->{file});
}
} else {
$tree = $parser->parse($arg);
}
my $self = bless $tree, ref($proto) || $proto;
return $self;
}
sub new_element {
my $proto = shift;
my $tree = shift || [];
return bless $tree, ref($proto) || $proto;
}
=pod
=head2 name()
Returns the name of the element represented by this object.
Aliases: tag(), getName(), getTag()
=cut
sub tag {
my $tag = shift()->[0];
return '' if $tag eq '0';
return $tag;
}
*name = \&tag;
*getTag = \&tag;
*getName = \&tag;
=pod
=head2 is_text()
Returns a true value if this element is a text element, false
otherwise.
Aliases: isText()
=cut
sub is_text {
return shift()->[0] eq '0';
}
*isText = \&is_text;
=pod
=head2 text()
If this element is a text element, the text is returned.
Otherwise, return the text from the first child text element, or
undef if there is not one.
Aliases: content(), getText(), getContent()
=cut
sub text {
my $self = shift;
if ($self->is_text) {
return $self->[1];
} else {
my $kids = $self->kids;
foreach my $kid (@$kids) {
return $kid->text if $kid->is_text;
}
return undef;
}
}
*content = \&text;
*contents = \&text;
*getText = \&text;
*getContent = \&text;
*getContents = \&text;
=pod
=head2 html()
Like text(), except HTML-escape the text (escape &, <, >, and ")
before returning it.
Aliases: content_html(), getContentHtml()
=cut
sub html {
my $self = shift;
return $self->escape_html($self->text);
}
*content_html = \&html;
*getContentHtml = \&html;
=pod
=head2 xml()
Like text(), except XML-escape the text (escape &, <, >, and ")
before returning it.
Aliases: content_xml(), getContentXml()
=cut
sub xml {
my $self = shift;
return $self->escape_xml($self->text);
}
*content_xml = \&html;
*getContentXml = \&html;
=pod
=head2 attributes(), attributes($name1, $name2, ...)
If no arguments are given, returns a hash of attributes for this
element. If arguments are present, an array of corresponding
attribute values is returned. Returns an array in array context
and an array reference if called in scalar context.
E.g.,
bar
my ($name, $id) = $element->attributes('name', 'id');
Aliases: attrs(), getAttributes(), getAttrs()
=cut
sub attributes {
my $self = shift;
my $val = $self->[1];
if (ref($val) eq 'ARRAY' and scalar(@$val) > 0) {
my $attr = $val->[0];
if (@_) {
my @keys;
if (ref($_[0]) eq 'ARRAY') {
@keys = @{$_[0]};
} else {
@keys = @_;
}
return wantarray ? @$attr{@keys} : [ @$attr{@keys} ];
}
return wantarray ? %$attr : $attr;
} else {
return {};
}
}
*attrs = \&attributes;
*getAttributes = \&attributes;
*getAttrs = \&attributes;
=pod
=head2 attribute($name)
Similar to attributes(), but only returns one value.
Aliases: attr(), getAttribute(), getAttr()
=cut
sub attribute {
my $self = shift;
my $attr_name = shift;
return $self->attributes()->{$attr_name};
}
*attr = \&attribute;
*getAttribute = \&attribute;
*getAttr = \&attribute;
=pod
=head2 elements(), elements($element_name)
Returns an array of child elements. If $element_name is passed,
a list of child elements with that name is returned.
Aliases: getElements(), kids(), getKids(), children(), getChildren()
=cut
sub kids {
my $self = shift;
my $tag = shift;
my $val = $self->[1];
my $i = 1;
my $kids = [];
if (ref($val) eq 'ARRAY') {
my $stop = $#$val;
while ($i < $stop) {
my $this_tag = $val->[$i];
if (defined($tag)) {
push @$kids, XML::Parser::Wrapper->new_element([ $this_tag, $val->[$i + 1] ])
if $this_tag eq $tag;
} else {
push @$kids, XML::Parser::Wrapper->new_element([ $this_tag, $val->[$i + 1] ]);
}
$i += 2;
}
}
return wantarray ? @$kids : $kids;
}
*elements = \&kids;
*getKids = \&kids;
*getElements = \&kids;
*children = \&kids;
*getChildren = \&kids;
=pod
=head2 first_element(), first_element($element_name)
Returns the first child element of this element. If
$element_name is passed, returns the first child element with
that name is returned.
Aliases: getFirstElement(), kid(), first_kid()
=cut
sub kid {
my $self = shift;
my $tag = shift;
my $val = $self->[1];
if (ref($val) eq 'ARRAY') {
if (defined($tag)) {
my $i = 1;
my $stop = $#$val;
while ($i < $stop) {
my $kid;
my $this_tag = $val->[$i];
if ($this_tag eq $tag) {
return XML::Parser::Wrapper->new_element([ $this_tag, $val->[$i + 1] ]);
}
$i += 2;
}
return undef;
} else {
return XML::Parser::Wrapper->new_element([ $val->[1], $val->[2] ]);
}
} else {
return $val;
}
}
*first_element = \&kid;
*getFirstElement = \&kid;
*first_kid = \&kid;
=pod
=head2 first_element_if($element_name)
Like first_element(), except if there is no corresponding child,
return an object that will work instead of undef. This allows
for reliable chaining, e.g.
my $class = $root->kid_if('field')->kid_if('field')->kid_if('element')
->kid_if('field')->attribute('class');
Aliases: getFirstElementIf(), kidIf(), first_kid_if()
=cut
sub kid_if {
my $self = shift;
my $tag = shift;
my $kid = $self->kid($tag);
return $kid if defined $kid;
return XML::Parser::Wrapper->new_element([ undef, [ {} ] ]);
}
*kidIf = \&kid_if;
*first_element_if = \&kid_if;
*first_kid_if = \&kid_if;
*getFirstElementIf = \&kid_if;
sub escape_html {
my ($self, $text) = @_;
return undef unless defined $text;
$text =~ s/\&/\&/g;
$text =~ s//\>/g;
$text =~ s/\"/\"/g;
return $text;
}
sub escape_xml {
my ($self, $text) = @_;
return undef unless defined $text;
$text =~ s/\&/\&/g;
$text =~ s//\>/g;
$text =~ s/\"/\"/g;
return $text;
}
}
1;
__END__
=pod
=head1 EXAMPLES
=head1 AUTHOR
Don Owens
=head1 CONTRIBUTORS
David Bushong
=head1 COPYRIGHT
Copyright (c) 2003-2005 Don Owens
All rights reserved. This program is free software; you can
redistribute it and/or modify it under the same terms as Perl
itself.
=head1 VERSION
0.04pre1
=cut
XML-Parser-Wrapper-0.04pre1/INSTALL 0000644 0000764 0000764 00000000245 10232771067 016166 0 ustar don don 0000000 0000000 Copyright (c) 2005 Don Owens
See the COPYRIGHT section in README for usage and distribution rights.
INSTALLATION
perl Makefile.PL
make
make test
make install
XML-Parser-Wrapper-0.04pre1/README 0000644 0000764 0000764 00000007255 10324036546 016023 0 ustar don don 0000000 0000000 NAME
XML::Parser::Wrapper - A simple object wrapper around XML::Parser
SYNOPSIS
use XML::Parser::Wrapper;
my $xml = qq{Hello World!};
my $root = XML::Parser::Wrapper->new($xml);
my $root2 = XML::Parser::Wrapper->new({ file => '/tmp/test.xml' });
my $root_tag_name = $root->name;
my $roots_children = $root->elements;
foreach my $element (@$roots_children) {
if ($element->name eq 'head') {
my $id = $element->attr('id');
my $hello_world_text = $element->text; # eq "Hello World!"
}
}
my $head_element = $root->element('head2');
my $head_elements = $root->elements('head2');
my $test = $root->element('head2')->element('test_tag');
DESCRIPTION
XML::Parser::Wrapper provides a simple object around XML::Parser
to make it more convenient to deal with the parse tree returned
by XML::Parser.
METHODS
new($xml), new({ file => $filename })
Calls XML::Parser to parse the given XML and returns a new
XML::Parser::Wrapper object using the parse tree output from
XML::Parser.
name()
Returns the name of the element represented by this object.
Aliases: tag(), getName(), getTag()
is_text()
Returns a true value if this element is a text element, false
otherwise.
Aliases: isText()
text()
If this element is a text element, the text is returned.
Otherwise, return the text from the first child text element, or
undef if there is not one.
Aliases: content(), getText(), getContent()
html()
Like text(), except HTML-escape the text (escape &, <, >, and ")
before returning it.
Aliases: content_html(), getContentHtml()
xml()
Like text(), except XML-escape the text (escape &, <, >, and ")
before returning it.
Aliases: content_xml(), getContentXml()
attributes(), attributes($name1, $name2, ...)
If no arguments are given, returns a hash of attributes for this
element. If arguments are present, an array of corresponding
attribute values is returned. Returns an array in array context
and an array reference if called in scalar context.
E.g.,
bar
my ($name, $id) = $element->attributes('name', 'id');
Aliases: attrs(), getAttributes(), getAttrs()
attribute($name)
Similar to attributes(), but only returns one value.
Aliases: attr(), getAttribute(), getAttr()
elements(), elements($element_name)
Returns an array of child elements. If $element_name is passed,
a list of child elements with that name is returned.
Aliases: getElements(), kids(), getKids(), children(), getChildren()
first_element(), first_element($element_name)
Returns the first child element of this element. If
$element_name is passed, returns the first child element with
that name is returned.
Aliases: getFirstElement(), kid(), first_kid()
first_element_if($element_name)
Like first_element(), except if there is no corresponding child,
return an object that will work instead of undef. This allows
for reliable chaining, e.g.
my $class = $root->kid_if('field')->kid_if('field')->kid_if('element')
->kid_if('field')->attribute('class');
Aliases: getFirstElementIf(), kidIf(), first_kid_if()
EXAMPLES
AUTHOR
Don Owens
CONTRIBUTORS
David Bushong
COPYRIGHT
Copyright (c) 2003-2005 Don Owens
All rights reserved. This program is free software; you can
redistribute it and/or modify it under the same terms as Perl
itself.
VERSION
0.04pre1
XML-Parser-Wrapper-0.04pre1/Makefile.PL 0000755 0000764 0000764 00000002014 10324036547 017105 0 ustar don don 0000000 0000000 #!/usr/bin/perl
# Creation date: 2005-04-24 11:29:18
# Authors: Don
# Change log:
# $Id: Makefile.PL,v 1.2 2005/10/14 23:21:11 don Exp $
use strict;
# main
{
use ExtUtils::MakeMaker;
WriteMakefile(
NAME => 'XML::Parser::Wrapper',
DISTNAME => 'XML-Parser-Wrapper',
VERSION_FROM => 'lib/XML/Parser/Wrapper.pm',
ABSTRACT => 'Simple object wrapper around XML::Parser',
AUTHOR => 'DON OWENS ',
PM => { 'lib/XML/Parser/Wrapper.pm' => '$(INST_LIBDIR)/Wrapper.pm',
},
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz',
ZIP => '/usr/bin/zip', ZIPFLAGS => '-rl',
},
DIR => [],
EXE_FILES => [],
PREREQ_PM => { 'XML::Parser' => 0 },
);
}
exit 0;
###############################################################################
# Subroutines