XML-LibXML-Simple-0.97/0000755000175000001440000000000012703172073015145 5ustar00markovusers00000000000000XML-LibXML-Simple-0.97/lib/0000755000175000001440000000000012703172073015713 5ustar00markovusers00000000000000XML-LibXML-Simple-0.97/lib/XML/0000755000175000001440000000000012703172073016353 5ustar00markovusers00000000000000XML-LibXML-Simple-0.97/lib/XML/LibXML/0000755000175000001440000000000012703172073017442 5ustar00markovusers00000000000000XML-LibXML-Simple-0.97/lib/XML/LibXML/Simple.pm0000644000175000001440000003326612703172072021242 0ustar00markovusers00000000000000# Copyrights 2008-2016 by [Mark Overmeer]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.02. package XML::LibXML::Simple; use vars '$VERSION'; $VERSION = '0.97'; use base 'Exporter'; use strict; use warnings; our @EXPORT = qw(XMLin); our @EXPORT_OK = qw(xml_in); use XML::LibXML (); use File::Slurp::Tiny qw/read_file/; use File::Basename qw/fileparse/; use File::Spec (); use Carp; use Scalar::Util qw/blessed/; use Data::Dumper; #to be removed my %known_opts = map +($_ => 1), qw(keyattr keeproot forcecontent contentkey noattr searchpath forcearray grouptags nsexpand normalisespace normalizespace valueattr nsstrip parser parseropts hooknodes); my @default_attributes = qw(name key id); my $default_content_key = 'content'; #------------- sub new(@) { my $class = shift; my $self = bless {}, $class; my $opts = $self->{opts} = $self->_take_opts(@_); # parser object cannot be reused !defined $opts->{parser} or error __x"parser option for XMLin only"; $self; } #------------- sub XMLin { my $self = @_ > 1 && blessed $_[0] && $_[0]->isa(__PACKAGE__) ? shift : __PACKAGE__->new; my $target = shift; my $this = $self->_take_opts(@_); my $opts = $self->_init($self->{opts}, $this); my $xml = $self->_get_xml($target, $opts) or return; if(my $cb = $opts->{hooknodes}) { $self->{XCS_hooks} = $cb->($self, $xml); } my $top = $self->collapse($xml, $opts); if($opts->{keeproot}) { my $subtop = $opts->{forcearray_always} && ref $top ne 'ARRAY' ? [$top] : $top; $top = +{ $xml->localName => $subtop }; } $top; } *xml_in = \&XMLin; sub _get_xml($$) { my ($self, $source, $opts) = @_; $source = $self->default_data_source($opts) unless defined $source; $source = \*STDIN if $source eq '-'; my $parser = $opts->{parser} || $self->_create_parser($opts->{parseropts}); my $xml = blessed $source && ( $source->isa('XML::LibXML::Document') || $source->isa('XML::LibXML::Element' )) ? $source : ref $source eq 'SCALAR' ? $parser->parse_string($$source) : ref $source ? $parser->parse_fh($source) : $source =~ m{^\s*\<.*?\>\s*$}s ? $parser->parse_string($source) : $parser->parse_file ($self->find_xml_file($source, @{$opts->{searchpath}})); $xml = $xml->documentElement if $xml->isa('XML::LibXML::Document'); $xml; } sub _create_parser(@) { my $self = shift; my @popt = @_ != 1 ? @_ : ref $_[0] eq 'HASH' ? %{$_[0]} : @{$_[0]}; XML::LibXML->new ( line_numbers => 1 , no_network => 1 , expand_xinclude => 0 , expand_entities => 1 , load_ext_dtd => 0 , ext_ent_handler => sub { alert __x"parsing external entities disabled"; '' } , @popt ); } sub _take_opts(@) { my $self = shift; my %opts; @_ % 2==0 or die "ERROR: odd number of options.\n"; while(@_) { my ($key, $val) = (shift, shift); my $lkey = lc $key; $lkey =~ s/_//g; $known_opts{$lkey} or croak "Unrecognised option: $key"; $opts{$lkey} = $val; } \%opts; } # Returns the name of the XML file to parse if no filename or XML string # was provided explictly. sub default_data_source($) { my ($self, $opts) = @_; my ($basename, $script_dir, $ext) = fileparse $0, qr[\.[^\.]+]; # Add script directory to searchpath unshift @{$opts->{searchpath}}, $script_dir if $script_dir; "$basename.xml"; } sub _init($$) { my ($self, $global, $this) = @_; my %opt = (%$global, %$this); if(defined $opt{contentkey}) { $opt{collapseagain} = $opt{contentkey} =~ s/^\-// } else { $opt{contentkey} = $default_content_key } $opt{normalisespace} ||= $opt{normalizespace} || 0; $opt{searchpath} ||= []; ref $opt{searchpath} eq 'ARRAY' or $opt{searchpath} = [ $opt{searchpath} ]; my $fa = delete $opt{forcearray} || 0; my (@fa_regex, %fa_elem); if(ref $fa) { foreach (ref $fa eq 'ARRAY' ? @$fa : $fa) { if(ref $_ eq 'Regexp') { push @fa_regex, $_ } else { $fa_elem{$_} = 1 } } } else { $opt{forcearray_always} = $fa } $opt{forcearray_regex} = \@fa_regex; $opt{forcearray_elem} = \%fa_elem; # Special cleanup for {keyattr} which could be arrayref or hashref, # which behave differently. my $ka = $opt{keyattr} || \@default_attributes; $ka = [ $ka ] unless ref $ka; if(ref $ka eq 'ARRAY') { if(@$ka) { $opt{keyattr} = $ka } else { delete $opt{keyattr} } } elsif(ref $ka eq 'HASH') { # Convert keyattr => { elem => '+attr' } # to keyattr => { elem => [ 'attr', '+' ] } my %at; while(my($k,$v) = each %$ka) { $v =~ /^(\+|-)?(.*)$/; $at{$k} = [ $2, $1 || '' ]; } $opt{keyattr} = \%at; } # Special cleanup for {valueattr} which could be arrayref or hashref my $va = delete $opt{valueattr} || {}; $va = +{ map +($_ => 1), @$va } if ref $va eq 'ARRAY'; $opt{valueattrlist} = $va; # make sure there's nothing weird in {grouptags} !$opt{grouptags} || ref $opt{grouptags} eq 'HASH' or croak "Illegal value for 'GroupTags' option -expected a hashref"; $opt{parseropts} ||= {}; \%opt; } sub find_xml_file($@) { my ($self, $file) = (shift, shift); my @search_path = @_ ? @_ : '.'; my ($filename, $filedir) = fileparse $file; if($filename eq $file) { foreach my $path (@search_path) { my $fullpath = File::Spec->catfile($path, $file); return $fullpath if -e $fullpath; } } elsif(-e $file) # Ignore searchpath if dir component { return $file; } local $" = ':'; die "data source $file not found in @search_path\n"; } sub _add_kv($$$$) { my ($d, $k, $v, $opts) = @_; if(defined $d->{$k}) { # Combine duplicate attributes into arrayref if required if(ref $d->{$k} eq 'ARRAY') { push @{$d->{$k}}, $v } else { $d->{$k} = [ $d->{$k}, $v ] } } elsif(ref $v eq 'ARRAY') { push @{$d->{$k}}, $v } elsif(ref $v eq 'HASH' && $k ne $opts->{contentkey} && $opts->{forcearray_always}) { push @{$d->{$k}}, $v } elsif($opts->{forcearray_elem}{$k} || grep $k =~ $_, @{$opts->{forcearray_regex}} ) { push @{$d->{$k}}, $v } else { $d->{$k} = $v } $d->{$k}; } # Takes the parse tree that XML::LibXML::Parser produced from the supplied # XML and recurse through it 'collapsing' unnecessary levels of indirection # (nested arrays etc) to produce a data structure that is easier to work with. sub _expand_name($) { my $node = shift; my $uri = $node->namespaceURI || ''; (length $uri ? "{$uri}" : '') . $node->localName; } sub collapse($$) { my ($self, $xml, $opts) = @_; $xml->isa('XML::LibXML::Element') or return; my (%data, $text); my $hooks = $self->{XCS_hooks}; unless($opts->{noattr}) { ATTR: foreach my $attr ($xml->attributes) { my $value; if($hooks && (my $hook = $hooks->{$attr->unique_key})) { $value = $hook->($attr); defined $value or next ATTR; } else { $value = $attr->value; } $value = $self->normalise_space($value) if !ref $value && $opts->{normalisespace}==2; my $name = !$attr->isa('XML::LibXML::Attr') ? $attr->nodeName : $opts->{nsexpand} ? _expand_name($attr) : $opts->{nsstrip} ? $attr->localName : $attr->nodeName; _add_kv \%data, $name => $value, $opts; } } my $nr_attrs = keys %data; my $nr_elems = 0; CHILD: foreach my $child ($xml->childNodes) { if($child->isa('XML::LibXML::Text')) { $text .= $child->data; next CHILD; } $child->isa('XML::LibXML::Element') or next CHILD; $nr_elems++; my $v; if($hooks && (my $hook = $hooks->{$child->unique_key})) { $v = $hook->($child) } else { $v = $self->collapse($child, $opts) } defined $v or next CHILD; my $name = $opts->{nsexpand} ? _expand_name($child) : $opts->{nsstrip} ? $child->localName : $child->nodeName; _add_kv \%data, $name => $v, $opts; } $text = $self->normalise_space($text) if defined $text && $opts->{normalisespace}==2; return $opts->{forcecontent} ? { $opts->{contentkey} => $text } : $text if $nr_attrs+$nr_elems==0 && defined $text; $data{$opts->{contentkey}} = $text if defined $text && $nr_elems==0; # Roll up 'value' attributes (but only if no nested elements) if(keys %data==1) { my ($k) = keys %data; return $data{$k} if $opts->{valueattrlist}{$k}; } # Turn arrayrefs into hashrefs if key fields present if($opts->{keyattr}) { while(my ($key, $val) = each %data) { $data{$key} = $self->array_to_hash($key, $val, $opts) if ref $val eq 'ARRAY'; } } # disintermediate grouped tags if(my $gr = $opts->{grouptags}) { ELEMENT: while(my ($key, $val) = each %data) { my $sub = $gr->{$key} or next; if(ref $val eq 'ARRAY') { next ELEMENT if grep { keys %$_!=1 || !exists $_->{$sub} } @$val; $data{$key} = { map { %{$_->{$sub}} } @$val }; } else { ref $val eq 'HASH' && keys %$val==1 or next; my ($child_key, $child_val) = %$val; $data{$key} = $child_val if $gr->{$key} eq $child_key; } } } # Fold hashes containing a single anonymous array up into just the array return $data{anon} if keys %data == 1 && exists $data{anon} && ref $data{anon} eq 'ARRAY'; # Roll up named elements with named nested 'value' attributes if(my $va = $opts->{valueattrlist}) { while(my($key, $val) = each %data) { $va->{$key} && ref $val eq 'HASH' && keys %$val==1 or next; $data{$key} = $val->{$va->{$key}}; } } $nr_elems+$nr_attrs ? \%data : !defined $text ? {} : $opts->{forcecontent} ? { $opts->{contentkey} => $text } : $text; } sub normalise_space($) { my $self = shift; local $_ = shift; s/^\s+//s; s/\s+$//s; s/\s\s+/ /sg; $_; } # Attempts to 'fold' an array of hashes into an hash of hashes. Returns a # reference to the hash on success or the original array if folding is # not possible. Behaviour is controlled by 'keyattr' option. # sub array_to_hash($$$$) { my ($self, $name, $in, $opts) = @_; my %out; my $ka = $opts->{keyattr} or return $in; if(ref $ka eq 'HASH') { my $newkey = $ka->{$name} or return $in; my ($key, $flag) = @$newkey; foreach my $h (@$in) { unless(ref $h eq 'HASH' && defined $h->{$key}) { warn "<$name> element has no '$key' key attribute\n" if $^W; return $in; } my $val = $h->{$key}; if(ref $val) { warn "<$name> element has non-scalar '$key' key attribute\n" if $^W; return $in; } $val = $self->normalise_space($val) if $opts->{normalisespace}==1; warn "<$name> element has non-unique value in '$key' " . "key attribute: $val\n" if $^W && defined $out{$val}; $out{$val} = { %$h }; $out{$val}{"-$key"} = $out{$val}{$key} if $flag eq '-'; delete $out{$val}{$key} if $flag ne '+'; } } else # Arrayref { my $default_keys = "@default_attributes" eq "@$ka"; ELEMENT: foreach my $h (@$in) { ref $h eq 'HASH' or return $in; foreach my $key (@$ka) { my $val = $h->{$key}; defined $val or next; if(ref $val) { warn "<$name> element has non-scalar '$key' key attribute" if $^W && ! $default_keys; return $in; } $val = $self->normalise_space($val) if $opts->{normalisespace} == 1; warn "<$name> element has non-unique value in '$key' " . "key attribute: $val" if $^W && $out{$val}; $out{$val} = { %$h }; delete $out{$val}{$key}; next ELEMENT; } return $in; # No keyfield matched } } $opts->{collapseagain} or return \%out; # avoid over-complicated structures like # dir => { libexecdir => { content => '$exec_prefix/libexec' }, # localstatedir => { content => '$prefix' }, # } # into # dir => { libexecdir => '$exec_prefix/libexec', # localstatedir => '$prefix', # } my $contentkey = $opts->{contentkey}; # first go through the values, checking that they are fit to collapse foreach my $v (values %out) { next if !defined $v; next if ref $v eq 'HASH' && keys %$v == 1 && exists $v->{$contentkey}; next if ref $v eq 'HASH' && !keys %$v; return \%out; } $out{$_} = $out{$_}{$contentkey} for keys %out; \%out; } 1; __END__ XML-LibXML-Simple-0.97/lib/XML/LibXML/Simple.pod0000644000175000001440000005253712703172072021412 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME XML::LibXML::Simple - XML::LibXML clone of XML::Simple::XMLin() =head1 INHERITANCE XML::LibXML::Simple is a Exporter =head1 SYNOPSIS my $xml = ...; # filename, fh, string, or XML::LibXML-node Imperative: use XML::LibXML::Simple qw(XMLin); my $data = XMLin $xml, %options; Or the Object Oriented way: use XML::LibXML::Simple (); my $xs = XML::LibXML::Simple->new(%options); my $data = $xs->XMLin($xml, %options); =head1 DESCRIPTION This module is a blunt rewrite of XML::Simple (by Grant McLean) to use the XML::LibXML parser for XML structures, where the original uses plain Perl or SAX parsers. =head1 METHODS =head2 Constructors =over 4 =item XML::LibXML::Simple-EB(%options) Instantiate an object, which can be used to call L on. You can provide %options to this constructor (to be reused for each call to XMLin) and with each call of XMLin (to be used once) For descriptions of the %options see the L section of this manual page. =back =head2 Translators =over 4 =item $obj-EB($xmldata, %options) For $xmldata and descriptions of the %options see the L section of this manual page. =back =head1 FUNCTIONS The functions C (exported implictly) and C (exported on request) simply call C<new->XMLin() >> with the provided parameters. =head1 DETAILS =head2 Parameter $xmldata As first parameter to L must provide the XML message to be translated into a Perl structure. Choose one of the following: =over 4 =item A filename If the filename contains no directory components, C will look for the file in each directory in the SearchPath (see OPTIONS below) and in the current directory. eg: $data = XMLin('/etc/params.xml', %options); =item A dash (-) Parse from STDIN. $data = XMLin('-', %options); =item undef [deprecated] If there is no XML specifier, C will check the script directory and each of the SearchPath directories for a file with the same name as the script but with the extension '.xml'. Note: if you wish to specify options, you must specify the value 'undef'. eg: $data = XMLin(undef, ForceArray => 1); This feature is available for backwards compatibility with XML::Simple, but quite sensitive. You can easily hit the wrong xml file as input. Please do not use it: always use an explicit filename. =item A string of XML A string containing XML (recognised by the presence of '<' and '>' characters) will be parsed directly. eg: $data = XMLin('', %options); =item An IO::Handle object In this case, XML::LibXML::Parser will read the XML data directly from the provided file. # $fh = IO::File->new('/etc/params.xml') or die; open my $fh, '<:encoding(utf8)', '/etc/params.xml' or die; $data = XMLin($fh, %options); =item An XML::LibXML::Document or ::Element [Not available in XML::Simple] When you have a pre-parsed XML::LibXML node, you can pass that. =back =head2 Parameter %options L supports most options defined by XML::Simple, so the interface is quite compatible. Minor changes apply. This explanation is extracted from the XML::Simple manual-page. =over 4 =item * check out C because you'll almost certainly want to turn it on =item * make sure you know what the C option does and what its default value is because it may surprise you otherwise. =item * Option names are case in-sensitive so you can use the mixed case versions shown here; you can add underscores between the words (eg: key_attr) if you like. =back In alphabetic order: =over 4 =item ContentKey => 'keyname' I<# seldom used> When text content is parsed to a hash value, this option let's you specify a name for the hash key to override the default 'content'. So for example: XMLin('Two', ContentKey => 'text') will parse to: { one => 1, text => 'Two' } instead of: { one => 1, content => 'Two' } You can also prefix your selected key name with a '-' character to have C try a little harder to eliminate unnecessary 'content' keys after array folding. For example: XMLin( 'FirstSecond', KeyAttr => {item => 'name'}, ForceArray => [ 'item' ], ContentKey => '-content' ) will parse to: { item => { one => 'First' two => 'Second' } } rather than this (without the '-'): { item => { one => { content => 'First' } two => { content => 'Second' } } } =item ForceArray => 1 I<# important> This option should be set to '1' to force nested elements to be represented as arrays even when there is only one. Eg, with ForceArray enabled, this XML: value would parse to this: { name => [ 'value' ] } instead of this (the default): { name => 'value' } This option is especially useful if the data structure is likely to be written back out as XML and the default behaviour of rolling single nested elements up into attributes is not desirable. If you are using the array folding feature, you should almost certainly enable this option. If you do not, single nested elements will not be parsed to arrays and therefore will not be candidates for folding to a hash. (Given that the default value of 'KeyAttr' enables array folding, the default value of this option should probably also have been enabled as well). =item ForceArray => [ names ] I<# important> This alternative (and preferred) form of the 'ForceArray' option allows you to specify a list of element names which should always be forced into an array representation, rather than the 'all or nothing' approach above. It is also possible to include compiled regular expressions in the list --any element names which match the pattern will be forced to arrays. If the list contains only a single regex, then it is not necessary to enclose it in an arrayref. Eg: ForceArray => qr/_list$/ =item ForceContent => 1 I<# seldom used> When C parses elements which have text content as well as attributes, the text content must be represented as a hash value rather than a simple scalar. This option allows you to force text content to always parse to a hash value even when there are no attributes. So for example: XMLin('text1text2', ForceContent => 1) will parse to: { x => { content => 'text1' }, y => { a => 2, content => 'text2' } } instead of: { x => 'text1', y => { 'a' => 2, 'content' => 'text2' } } =item GroupTags => { grouping tag => grouped tag } I<# handy> You can use this option to eliminate extra levels of indirection in your Perl data structure. For example this XML: /usr/bin /usr/local/bin /usr/X11/bin Would normally be read into a structure like this: { searchpath => { dir => [ '/usr/bin', '/usr/local/bin', '/usr/X11/bin' ] } } But when read in with the appropriate value for 'GroupTags': my $opt = XMLin($xml, GroupTags => { searchpath => 'dir' }); It will return this simpler structure: { searchpath => [ '/usr/bin', '/usr/local/bin', '/usr/X11/bin' ] } The grouping element (C<< >> in the example) must not contain any attributes or elements other than the grouped element. You can specify multiple 'grouping element' to 'grouped element' mappings in the same hashref. If this option is combined with C, the array folding will occur first and then the grouped element names will be eliminated. =item HookNodes => CODE Select document nodes to apply special tricks. Introduced in [0.96], not available in XML::Simple. When this option is provided, the CODE will be called once the XML DOM tree is ready to get transformed into Perl. Your CODE should return either C (nothing to do) or a HASH which maps values of unique_key (see XML::LibXML::Node method C onto CODE references to be called. Once the translater from XML into Perl reaches a selected node, it will call your routine specific for that node. That triggering node found is the only parameter. When you return C, the node will not be found in the final result. You may return any data (even the node itself) which will be included in the final result as is, under the name of the original node. Example: my $out = XMLin $file, HookNodes => \&protect_html; sub protect_html($$) { # $obj is the instantated XML::Compile::Simple object # $xml is a XML::LibXML::Element to get transformed my ($obj, $xml) = @_; my %hooks; # collects the table of hooks # do an xpath search for HTML my $xpc = XML::LibXML::XPathContext->new($xml); my @nodes = $xpc->findNodes(...); #XXX @nodes or return undef; my $as_text = sub { $_[0]->toString(0) }; # as text # $as_node = sub { $_[0] }; # as node # $skip = sub { undef }; # not at all # the same behavior for all xpath nodes, in this example $hook{$_->unique_key} = $as_text for @nodes; \%hook; } =item KeepRoot => 1 I<# handy> In its attempt to return a data structure free of superfluous detail and unnecessary levels of indirection, C normally discards the root element name. Setting the 'KeepRoot' option to '1' will cause the root element name to be retained. So after executing this code: $config = XMLin('', KeepRoot => 1) You'll be able to reference the tempdir as C<$config-E{config}-E{tempdir}> instead of the default C<$config-E{tempdir}>. =item KeyAttr => [ list ] I<# important> This option controls the 'array folding' feature which translates nested elements from an array to a hash. It also controls the 'unfolding' of hashes to arrays. For example, this XML: would, by default, parse to this: { user => [ { login => 'grep', fullname => 'Gary R Epstein' }, { login => 'stty', fullname => 'Simon T Tyson' } ] } If the option 'KeyAttr => "login"' were used to specify that the 'login' attribute is a key, the same XML would parse to: { user => { stty => { fullname => 'Simon T Tyson' }, grep => { fullname => 'Gary R Epstein' } } } The key attribute names should be supplied in an arrayref if there is more than one. C will attempt to match attribute names in the order supplied. Note 1: The default value for 'KeyAttr' is C<< ['name', 'key', 'id'] >>. If you do not want folding on input or unfolding on output you must setting this option to an empty list to disable the feature. Note 2: If you wish to use this option, you should also enable the C option. Without 'ForceArray', a single nested element will be rolled up into a scalar rather than an array and therefore will not be folded (since only arrays get folded). =item KeyAttr => { list } I<# important> This alternative (and preferred) method of specifiying the key attributes allows more fine grained control over which elements are folded and on which attributes. For example the option 'KeyAttr => { package => 'id' } will cause any package elements to be folded on the 'id' attribute. No other elements which have an 'id' attribute will be folded at all. Two further variations are made possible by prefixing a '+' or a '-' character to the attribute name: The option 'KeyAttr => { user => "+login" }' will cause this XML: to parse to this data structure: { user => { stty => { fullname => 'Simon T Tyson', login => 'stty' }, grep => { fullname => 'Gary R Epstein', login => 'grep' } } } The '+' indicates that the value of the key attribute should be copied rather than moved to the folded hash key. A '-' prefix would produce this result: { user => { stty => { fullname => 'Simon T Tyson', -login => 'stty' }, grep => { fullname => 'Gary R Epstein', -login => 'grep' } } } =item NoAttr => 1 I<# handy> When used with C, any attributes in the XML will be ignored. =item NormaliseSpace => 0 | 1 | 2 I<# handy> This option controls how whitespace in text content is handled. Recognised values for the option are: =over 4 =item "0" (default) whitespace is passed through unaltered (except of course for the normalisation of whitespace in attribute values which is mandated by the XML recommendation) =item "1" whitespace is normalised in any value used as a hash key (normalising means removing leading and trailing whitespace and collapsing sequences of whitespace characters to a single space) =item "2" whitespace is normalised in all text content =back Note: you can spell this option with a 'z' if that is more natural for you. =item Parser => OBJECT You may pass your own XML::LibXML object, in stead of having one created for you. This is useful when you need specific configuration on that object (See XML::LibXML::Parser) or have implemented your own extension to that object. The internally created parser object is configured in safe mode. Read the XML::LibXML::Parser manual about security issues with certain parameter settings. The default is unsafe! =item ParserOpts => HASH|ARRAY Pass parameters to the creation of a new internal parser object. You can overrule the options which will create a safe parser. It may be more readible to use the C parameter. =item SearchPath => [ list ] I<# handy> If you pass C a filename, but the filename include no directory component, you can use this option to specify which directories should be searched to locate the file. You might use this option to search first in the user's home directory, then in a global directory such as /etc. If a filename is provided to C but SearchPath is not defined, the file is assumed to be in the current directory. If the first parameter to C is undefined, the default SearchPath will contain only the directory in which the script itself is located. Otherwise the default SearchPath will be empty. =item ValueAttr => [ names ] I<# handy> Use this option to deal elements which always have a single attribute and no content. Eg: Setting C<< ValueAttr => [ 'value' ] >> will cause the above XML to parse to: { colour => 'red', size => 'XXL' } instead of this (the default): { colour => { value => 'red' }, size => { value => 'XXL' } } =item NsExpand => 0 I When name-spaces are used, the default behavior is to include the prefix in the key name. However, this is very dangerous: the prefixes can be changed without a change of the XML message meaning. Therefore, you can better use this C option. The downside, however, is that the labels get very long. Without this option: 42 42 translates into { 'x:field1' => 42 } { 'y:field1' => 42 } but both source component have exactly the same meaning. When C is used, the result is: { '{http://xyz}field1' => 42 } { '{http://xyz}field1' => 42 } Of course, addressing these fields is more work. It is advised to implement it like this: my $ns = 'http://xyz'; $data->{"{$ns}field1"}; =item NsStrip => 0 I [not available in XML::Simple] Namespaces are really important to avoid name collissions, but they are a bit of a hassle. To do it correctly, use option C. To do it sloppy, use C. With this option set, the above example will return { field1 => 42 } { field1 => 42 } =back =head1 EXAMPLES When C reads the following very simple piece of XML: it returns the following data structure: { username => 'testuser', password => 'frodo' } The identical result could have been produced with this alternative XML: Or this (although see 'ForceArray' option for variations): testuser frodo Repeated nested elements are represented as anonymous arrays: joe@smith.com jsmith@yahoo.com bob@smith.com { person => [ { email => [ 'joe@smith.com', 'jsmith@yahoo.com' ], firstname => 'Joe', lastname => 'Smith' }, { email => 'bob@smith.com', firstname => 'Bob', lastname => 'Smith' } ] } Nested elements with a recognised key attribute are transformed (folded) from an array into a hash keyed on the value of that attribute (see the C option): { person => { jbloggs => { firstname => 'Joe', lastname => 'Bloggs' }, tsmith => { firstname => 'Tom', lastname => 'Smith' }, jsmith => { firstname => 'Joe', lastname => 'Smith' } } } The tag can be used to form anonymous arrays: Col 1Col 2Col 3 R1C1R1C2R1C3 R2C1R2C2R2C3 R3C1R3C2R3C3 { head => [ [ 'Col 1', 'Col 2', 'Col 3' ] ], data => [ [ 'R1C1', 'R1C2', 'R1C3' ], [ 'R2C1', 'R2C2', 'R2C3' ], [ 'R3C1', 'R3C2', 'R3C3' ] ] } Anonymous arrays can be nested to arbirtrary levels and as a special case, if the surrounding tags for an XML document contain only an anonymous array the arrayref will be returned directly rather than the usual hashref: Col 1Col 2 R1C1R1C2 R2C1R2C2 [ [ 'Col 1', 'Col 2' ], [ 'R1C1', 'R1C2' ], [ 'R2C1', 'R2C2' ] ] Elements which only contain text content will simply be represented as a scalar. Where an element has both attributes and text content, the element will be represented as a hashref with the text content in the 'content' key (see the C option): first second { one => 'first', two => { attr => 'value', content => 'second' } } Mixed content (elements which contain both text content and nested elements) will be not be represented in a useful way - element order and significant whitespace will be lost. If you need to work with mixed content, then XML::Simple is not the right tool for your job - check out the next section. =head2 Differences to XML::Simple In general, the output and the options are equivalent, although this module has some differences with XML::Simple to be aware of. =over 4 =item only L is supported If you want to write XML then use a schema (for instance with XML::Compile). Do not attempt to create XML by hand! If you still think you need it, then have a look at XMLout() as implemented by XML::Simple or any of a zillion template systems. =item no "variables" option IMO, you should use a templating system if you want variables filled-in in the input: it is not a task for this module. =item empty elements are not removed Being empty has a meaning which should not be ignored. =item ForceArray options There are a few small differences in the result of the C option, because XML::Simple seems to behave inconsequently. =item hooks XML::Simple does not support hooks. =back =head1 SEE ALSO L for processing XML when a schema is available. When you have a schema, the data and structure of your message get validated. L, the original implementation which interface is followed as closely as possible. =head1 COPYRIGHTS The interface design and large parts of the documentation were taken from the L module, written by Grant McLean Egrantm@cpan.orgE Copyrights of the perl code and the related documentation by 2008-2016 by [Mark Overmeer]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F XML-LibXML-Simple-0.97/t/0000755000175000001440000000000012703172073015410 5ustar00markovusers00000000000000XML-LibXML-Simple-0.97/t/subdir/0000755000175000001440000000000012703172073016700 5ustar00markovusers00000000000000XML-LibXML-Simple-0.97/t/subdir/test2.xml0000644000175000001440000000004612703172072020462 0ustar00markovusers00000000000000 XML-LibXML-Simple-0.97/t/10XMLin.t0000644000175000001440000007673412703172072016745 0ustar00markovusers00000000000000#!/usr/bin/perl use warnings; use strict; use Test::More; use IO::File; use File::Spec; use Data::Dumper; # to be remove # Initialise filenames and check they're there my $XMLFile = File::Spec->catfile('t', 'test1.xml'); # t/test1.xml unless(-e $XMLFile) { plan skip_all => 'Test data missing'; } plan tests => 117; my $last_warning = ''; use_ok('XML::LibXML::Simple'); # Start by parsing an extremely simple piece of XML my $opt = XMLin(q()); my $expected = { name1 => 'value1', name2 => 'value2', }; ok(1, "XMLin() didn't crash"); ok(defined($opt), 'and it returned a value'); is(ref($opt), 'HASH', 'and a hasref at that'); is_deeply($opt, $expected, 'matches expectations (attributes)'); # Now try a slightly more complex one that returns the same value $opt = XMLin(<<__XML); value1 value2 __XML is_deeply($opt, $expected, 'same again with nested elements'); # And something else that returns the same (line break included to pick up # missing /s bug) $opt = XMLin(q()); is_deeply($opt, $expected, 'attributes in empty element'); # Try something with two lists of nested values $opt = XMLin(<<__XML); value1.1 value1.2 value1.3 value2.1 value2.2 value2.3 __XML is_deeply($opt, { name1 => [ 'value1.1', 'value1.2', 'value1.3' ], name2 => [ 'value2.1', 'value2.2', 'value2.3' ], }, 'repeated child elements give arrays of scalars'); # Now a simple nested hash $opt = XMLin(<<__XML); __XML is_deeply($opt, { item => { name1 => 'value1', name2 => 'value2' } }, 'nested element gives hash'); # Now a list of nested hashes $opt = XMLin(q( ) ); is_deeply($opt, { item => [ { name1 => 'value1', name2 => 'value2' }, { name1 => 'value3', name2 => 'value4' } ] }, 'repeated child elements give list of hashes'); # Now a list of nested hashes transformed into a hash using default key names my $string = q( ); my $target = { item => { item1 => { attr1 => 'value1', attr2 => 'value2' }, item2 => { attr1 => 'value3', attr2 => 'value4' } } }; $opt = XMLin($string); is_deeply($opt, $target, "array folded on default key 'name'"); # Same thing left as an array by suppressing default key names $target = { item => [ {name => 'item1', attr1 => 'value1', attr2 => 'value2' }, {name => 'item2', attr1 => 'value3', attr2 => 'value4' } ] }; my @cont_key = (contentkey => '-content'); $opt = XMLin($string, keyattr => [], @cont_key); is_deeply($opt, $target, 'not folded when keyattr turned off'); # Same again with alternative key suppression $opt = XMLin($string, keyattr => {}, @cont_key); is_deeply($opt, $target, 'still works when keyattr is empty hash'); # Try the other two default key attribute names $opt = XMLin(q( ), @cont_key); is_deeply($opt, { item => { item1 => { attr1 => 'value1', attr2 => 'value2' }, item2 => { attr1 => 'value3', attr2 => 'value4' } } }, "folded on default key 'key'"); $opt = XMLin(q( ), @cont_key); is_deeply($opt, { item => { item1 => { attr1 => 'value1', attr2 => 'value2' }, item2 => { attr1 => 'value3', attr2 => 'value4' } } }, "folded on default key 'id'"); # Similar thing using non-standard key names my $xml = q( ); $target = { item => { item1 => { attr1 => 'value1', attr2 => 'value2' }, item2 => { attr1 => 'value3', attr2 => 'value4' } } }; $opt = XMLin($xml, keyattr => [qw(xname)], @cont_key); is_deeply($opt, $target, "folded on non-default key 'xname'"); # And with precise element/key specification $opt = XMLin($xml, keyattr => { 'item' => 'xname' }, @cont_key); is_deeply($opt, $target, 'same again but keyattr set with hash'); # Same again but with key field further down the list $opt = XMLin($xml, keyattr => [qw(wibble xname)], @cont_key); is_deeply($opt, $target, 'keyattr as array with value in second position'); # Same again but with key field supplied as scalar $opt = XMLin($xml, keyattr => qw(xname), @cont_key); is_deeply($opt, $target, 'keyattr as scalar'); # Same again but with mixed-case option name $opt = XMLin($xml, KeyAttr => qw(xname), @cont_key); is_deeply($opt, $target, 'KeyAttr as scalar'); # Same again but with underscores in option name $opt = XMLin($xml, key_attr => qw(xname), @cont_key); is_deeply($opt, $target, 'key_attr as scalar'); # Weird variation, not exactly what we wanted but it is what we expected # given the current implementation and we don't want to break it accidently $xml = q( ); $target = { item => { 'three' => { 'value' => 3 }, 'a' => { 'value' => 1, 'id' => 'one' }, 'two' => { 'value' => 2 } } }; $opt = XMLin($xml, @cont_key); is_deeply($opt, $target, 'fold same array on two different keys'); # Or somewhat more as one might expect $target = { item => { 'one' => { 'value' => '1', 'name' => 'a' }, 'two' => { 'value' => '2' }, 'three' => { 'value' => '3' }, } }; $opt = XMLin($xml, keyattr => { 'item' => 'id' }, @cont_key); is_deeply($opt, $target, 'same again but with priority switch'); # Now a somewhat more complex test of targetting folding $xml = q( ); $target = { 'car' => { 'LW1804' => { 'id' => 2, 'make' => 'GM', 'option' => { '9926543-1167' => { 'key' => 1, 'desc' => 'Steering Wheel' } } }, 'SH6673' => { 'id' => 1, 'make' => 'Ford', 'option' => { '6389733317-12' => { 'key' => 1, 'desc' => 'Electric Windows' }, '3735498158-01' => { 'key' => 2, 'desc' => 'Leather Seats' }, '5776155953-25' => { 'key' => 3, 'desc' => 'Sun Roof' } } } } }; $opt = XMLin($xml, forcearray => 1, keyattr => { 'car' => 'license', 'option' => 'pn' }, @cont_key); is_deeply($opt, $target, 'folded on multi-key keyattr hash'); # Now try leaving the keys in place $target = { 'car' => { 'LW1804' => { 'id' => 2, 'make' => 'GM', 'option' => { '9926543-1167' => { 'key' => 1, 'desc' => 'Steering Wheel', '-pn' => '9926543-1167' } }, license => 'LW1804' }, 'SH6673' => { 'id' => 1, 'make' => 'Ford', 'option' => { '6389733317-12' => { 'key' => 1, 'desc' => 'Electric Windows', '-pn' => '6389733317-12' }, '3735498158-01' => { 'key' => 2, 'desc' => 'Leather Seats', '-pn' => '3735498158-01' }, '5776155953-25' => { 'key' => 3, 'desc' => 'Sun Roof', '-pn' => '5776155953-25' } }, license => 'SH6673' } } }; $opt = XMLin($xml, forcearray => 1, keyattr => { 'car' => '+license', 'option' => '-pn' }, @cont_key); is_deeply($opt, $target, "same again but with '+' prefix to copy keys"); # Confirm the stringifying references bug is fixed $xml = q( Bob 21 Kate 22 ); $target = { item => [ { age => '21', name => { firstname => 'Bob'} }, { age => '22', name => { firstname => 'Kate'} }, ] }; { local($SIG{__WARN__}) = \&warn_handler; local $^W = 1; $last_warning = ''; $opt = XMLin($xml, @cont_key); is_deeply($opt, $target, "did not fold on default key with non-scalar value"); is($last_warning, '', 'no warning issued'); $last_warning = ''; $opt = XMLin($xml, keyattr => { item => 'name' }, @cont_key); is_deeply($opt, $target, "did not fold on specific key with non-scalar value"); isnt($last_warning, '', 'warning issued as expected'); like($last_warning, qr{ element has non-scalar 'name' key attribute}, 'text in warning is correct' ); $last_warning = ''; $opt = XMLin($xml, keyattr => [ 'name' ], @cont_key); is_deeply($opt, $target, "same again but with keyattr as array"); isnt($last_warning, '', 'warning issued as expected'); like($last_warning, qr{ element has non-scalar 'name' key attribute}, 'text in warning is correct' ); $last_warning = ''; local($^W) = 0; $opt = XMLin($xml, keyattr => {item => 'name'}, @cont_key); is_deeply($opt, $target, "did not fold on specific key with non-scalar value"); is($last_warning, '', 'no warning issued (as expected)'); $last_warning = ''; $^W = 1; my $xitems = q( red heavy ornery ); my $items = { 'item' => [ { 'name' => 'color', 'content' => 'red', }, { 'name' => 'mass', 'content' => 'heavy', }, { 'nime' => 'disposition', 'content' => 'ornery', } ] }; $opt = XMLin($xitems, keyattr => { item => 'name' }, @cont_key); is_deeply($opt, $items, "did not fold when element missing key attribute"); like($last_warning, qr{^ element has no 'name' key attribute}, 'expected warning issued'); $last_warning = ''; $^W = 0; $opt = XMLin($xitems, keyattr => { item => 'name' }, @cont_key); is_deeply($opt, $items, "same again"); is($last_warning, '', 'but with no warning this time'); $last_warning = ''; $^W = 1; $xitems = q( red heavy ornery green ); $items = { 'item' => { 'color' => 'green', 'mass' => 'heavy', 'disposition' => 'ornery', } }; $opt = XMLin($xitems, keyattr => { item => 'name' }, @cont_key); is_deeply($opt, $items, "folded elements despite non-unique key attribute"); like($last_warning, qr{^ element has non-unique value in 'name' key attribute: color}, 'expected warning issued'); $last_warning = ''; $opt = XMLin($xitems, keyattr => [ 'name' ], @cont_key); is_deeply($opt, $items, "same again but with keyattr as array"); like($last_warning, qr{^ element has non-unique value in 'name' key attribute: color}, 'expected warning issued'); $last_warning = ''; $^W = 0; $opt = XMLin($xitems, keyattr => { item => 'name' }, @cont_key); is_deeply($opt, $items, "same again"); is($last_warning, '', 'but with no warning this time'); } # Make sure that the root element name is preserved if we ask for it $target = XMLin("$xml", forcearray => 1, keyattr => { 'car' => '+license', 'option' => '-pn' }, @cont_key); $opt = XMLin( $xml, forcearray => 1, keeproot => 1, keyattr => { 'car' => '+license', 'option' => '-pn' }, @cont_key); is_deeply($opt, $target, 'keeproot option works'); # confirm that CDATA sections parse correctly $xml = q{Hello, world!]]>}; $opt = XMLin($xml, @cont_key); is_deeply($opt, { 'cdata' => 'Hello, world!' }, 'CDATA section parsed correctly'); $xml = q{one]]>two]]>}; $opt = XMLin($xml, @cont_key); is_deeply($opt, { 'x' => 'onetwo' }, 'CDATA section containing markup characters parsed correctly'); # Try parsing a named external file $@ = ''; $opt = eval{ XMLin($XMLFile); }; is($@, '', "XMLin didn't choke on named external file"); is_deeply($opt, { location => 't/test1.xml' }, 'and contents parsed as expected'); # Try parsing default external file (scriptname.xml in script directory) $@ = ''; $opt = eval { XMLin(); }; is($@, '', "XMLin didn't choke on un-named (default) external file"); is_deeply($opt, {location => 't/10XMLin.xml'}, 'and contents parsed as expected'); # Try parsing named file in a directory in the searchpath $@ = ''; $opt = eval { XMLin('test2.xml', searchpath => [ 'dir1', 'dir2', File::Spec->catdir('t', 'subdir'), @cont_key ] ); }; is($@, '', 'XMLin found file using searchpath'); is_deeply($opt, { location => 't/subdir/test2.xml' }, 'and contents parsed as expected'); # Ensure we get expected result if file does not exist $@ = ''; $opt = undef; $opt = eval { XMLin('bogusfile.xml', searchpath => 't' ); # should 'die' }; is($opt, undef, 'XMLin choked on nonexistant file'); like($@, qr/^data source bogusfile.xml not/, 'with the expected message'); # same again, but with no searchpath $@ = ''; $opt = undef; $opt = eval { XMLin('bogusfile.xml'); }; is($opt, undef, 'nonexistant file not found in current directory'); like($@, qr/data source bogusfile.xml not/, 'with the expected message'); # Confirm searchpath is ignored if filename includes directory component $@ = ''; $opt = undef; $opt = eval { XMLin(File::Spec->catfile('subdir', 'test2.xml'), searchpath => 't' ); }; is($opt, undef, 'search path ignored when pathname supplied'); # Try parsing from an IO::Handle $@ = ''; my $fh = new IO::File; $XMLFile = File::Spec->catfile('t', '10XMLin.xml'); eval { $fh->open($XMLFile) || die "$!"; $opt = XMLin($fh, @cont_key); }; is($@, '', "XMLin didn't choke on an IO::File object"); is($opt->{location}, 't/10XMLin.xml', 'and it parsed the right file'); # Try parsing from STDIN close(STDIN); $@ = ''; eval { open(STDIN, $XMLFile) || die "$!"; $opt = XMLin('-'); }; is($@, '', "XMLin didn't choke on STDIN ('-')"); is($opt->{location}, 't/10XMLin.xml', 'and data parsed correctly'); # Confirm anonymous array handling works in general $xml = q{ 0.00.10.2 1.01.11.2 2.02.12.2 }; $expected = { row => [ [ '0.0', '0.1', '0.2' ], [ '1.0', '1.1', '1.2' ], [ '2.0', '2.1', '2.2' ] ] }; $opt = XMLin($xml, @cont_key); is_deeply($opt, $expected, 'anonymous arrays parsed correctly'); # Confirm it still works with array folding disabled (was a bug) $opt = XMLin($xml, keyattr => [], @cont_key); is_deeply($opt, $expected, 'anonymous arrays parsed correctly'); # Confirm anonymous array handling works in special top level case $opt = XMLin(q{ one two three }, @cont_key); is_deeply($opt, [ qw(one two three) ], 'top level anonymous array returned arrayref'); $opt = XMLin(q( 1 2.1 2.2.1 2.2.2 ), @cont_key); is_deeply($opt, [ 1, [ '2.1', [ '2.2.1', '2.2.2'] ] ], 'nested anonymous arrays parsed correctly'); # Check for the dreaded 'content' attribute $xml = q( text ); $opt = XMLin($xml); is_deeply($opt, { item => { content => 'text', attr => 'value' } }, "'content' key appears as expected"); # And check that we can change its name if required $opt = XMLin($xml, contentkey => 'text_content'); is_deeply($opt, { item => { text_content => 'text', attr => 'value' } }, "'content' key successfully renamed to 'text'"); # Check that it doesn't get screwed up by forcearray option $xml = q(text content); $opt = XMLin($xml, forcearray => 1); is_deeply($opt, { 'attr' => 'value', 'content' => 'text content' }, "'content' key not munged by forcearray"); # Test that we can force all text content to parse to hash values $xml = q(text1text2); $opt = XMLin($xml, forcecontent => 1); is_deeply($opt, { 'x' => { 'content' => 'text1' }, 'y' => { 'a' => 2, 'content' => 'text2' } }, 'gratuitous use of content key works as expected'); # And that this is compatible with changing the key name $opt = XMLin($xml, forcecontent => 1, contentkey => '0'); is_deeply($opt, { 'x' => { 0 => 'text1' }, 'y' => { 'a' => 2, 0 => 'text2' } }, "even when we change it's name to 'text'"); # Confirm that spurious 'content' keys are *not* eliminated after array folding $xml = q(FirstSecond); $opt = XMLin($xml, forcearray => [ 'x' ], keyattr => {x => 'y'}); is_deeply($opt, { x => { one => { content => 'First' }, two => { content => 'Second' }, } }, "spurious content keys not eliminated after folding"); # unless we ask nicely $xml = q(FirstSecond); $opt = XMLin( $xml, forcearray => [ 'x' ], keyattr => {x => 'y'}, contentkey => '-content' ); is_deeply($opt, { x => { one => 'First', two => 'Second', } }, "spurious content keys not eliminated after folding"); # Check that mixed content parses in the weird way we expect $xml = q( Text with a bold word Mixed but no attributes ); my $out = XMLin($xml, @cont_key); is_deeply($out , { 'p1' => { 'class' => 'mixed', 'b' => 'bold' }, 'p2' => { 'b' => 'but' } }, "mixed content doesn't work - no surprises there"); # Confirm single nested element rolls up into a scalar attribute value $string = q( value ); $opt = XMLin($string); is_deeply($opt, { name => 'value' }, 'nested element rolls up to scalar'); # Confirm array folding of single nested hash $string = q( ); $opt = XMLin($string, forcearray => 1, @cont_key); is_deeply($opt, { 'inner' => { 'one' => { 'value' => 1 } } }, 'array folding works with single nested hash'); # But not without forcearray option specified $opt = XMLin($string, forcearray => 0, @cont_key); is_deeply($opt, { 'inner' => { 'name' => 'one', 'value' => 1 } }, 'but not if forcearray is turned off'); # Test advanced features of forcearray $xml = q( i ii iii 3 c ); $opt = XMLin($xml, forcearray => [ 'two' ], @cont_key); is_deeply($opt, { 'zero' => '0', 'one' => 'i', 'two' => [ 'ii' ], 'three' => [ 'iii', 3, 'c' ] }, 'selective application of forcearray successful'); # Test forcearray regexes $xml = q( i ii iii iv v ); $opt = XMLin($xml, forcearray => [ qr/^f/, 'two', qr/n/ ], @cont_key); is_deeply($opt, { 'zero' => '0', 'one' => [ 'i' ], 'two' => [ 'ii' ], 'three' => 'iii', 'four' => [ 'iv' ], 'five' => [ 'v' ], }, 'forcearray using regex successful'); # Same again but a single regexp rather than in an arrayref $opt = XMLin($xml, forcearray => qr/^f|e$/, @cont_key); is_deeply($opt, { 'zero' => '0', 'one' => [ 'i' ], 'two' => 'ii', 'three' => [ 'iii'], 'four' => [ 'iv' ], 'five' => [ 'v' ], }, 'forcearray using a single regex successful'); # Test 'noattr' option $xml = q( text ); $opt = XMLin($xml, noattr => 1, @cont_key); is_deeply($opt, { nest => 'text' }, 'attributes successfully skipped'); # And make sure it doesn't screw up array folding $xml = q{ aalpha bbeta ggamma }; $opt = XMLin($xml, noattr => 1, @cont_key); is_deeply($opt, { 'item' => { 'a' => { 'value' => 'alpha' }, 'b' => { 'value' => 'beta' }, 'g' => { 'value' => 'gamma' } } }, 'noattr does not intefere with array folding'); # Confirm empty elements parse to empty hashrefs $xml = q( bob ); $opt = XMLin($xml, noattr => 1, @cont_key); is_deeply($opt, { 'name' => 'bob', 'outer' => { 'inner1' => {}, 'inner2' => {} } }, 'empty elements parse to hashrefs'); # Confirm nothing magical happens with grouped elements $xml = q( before /usr/bin /usr/local/bin after ); $opt = XMLin($xml); is_deeply($opt, { prefix => 'before', dirs => { dir => [ '/usr/bin', '/usr/local/bin' ] }, suffix => 'after', }, 'grouped tags parse normally'); # unless we specify how the grouping works $xml = q( before /usr/bin /usr/local/bin after ); $opt = XMLin($xml, grouptags => {dirs => 'dir'} ); is_deeply($opt, { prefix => 'before', dirs => [ '/usr/bin', '/usr/local/bin' ], suffix => 'after', }, 'disintermediation of grouped tags works'); # try again with multiple groupings $xml = q( before /usr/bin /usr/local/bin between vt100 xterm after ); $opt = XMLin($xml, grouptags => {dirs => 'dir', terms => 'term'} ); is_deeply($opt, { prefix => 'before', dirs => [ '/usr/bin', '/usr/local/bin' ], infix => 'between', terms => [ 'vt100', 'xterm' ], suffix => 'after', }, 'disintermediation works with multiple groups'); # confirm folding and ungrouping work together $xml = q( before /usr/bin /usr/local/bin after ); $opt = XMLin($xml, keyattr => {dir => 'name'}, grouptags => {dirs => 'dir'} ); is_deeply($opt, { prefix => 'before', dirs => { first => { content => '/usr/bin' }, second => { content => '/usr/local/bin' }, }, suffix => 'after', }, 'folding and ungrouping work together'); # confirm folding, ungrouping and content stripping work together $xml = q( before /usr/bin /usr/local/bin after ); $opt = XMLin($xml, contentkey => '-text', keyattr => {dir => 'name'}, grouptags => {dirs => 'dir'} ); is_deeply($opt, { prefix => 'before', dirs => { first => '/usr/bin', second => '/usr/local/bin', }, suffix => 'after', }, 'folding, ungrouping and content stripping work together'); # confirm folding fails as expected even with ungrouping but (no forcearray) $xml = q( before /usr/bin after ); $opt = XMLin($xml, contentkey => '-text', keyattr => {dir => 'name'}, grouptags => {dirs => 'dir'} ); is_deeply($opt, { prefix => 'before', dirs => { name => 'first', text => '/usr/bin'}, suffix => 'after', }, 'folding without forcearray but with ungrouping fails as expected'); # but works with forcearray enabled $xml = q( before /usr/bin after ); $opt = XMLin($xml, contentkey => '-text', forcearray => [ 'dir' ], keyattr => {dir => 'name'}, grouptags => {dirs => 'dir'} ); is_deeply($opt, { prefix => 'before', dirs => {'first' => '/usr/bin'}, suffix => 'after', }, 'folding with forcearray and ungrouping works'); # Try to disintermediate on the wrong child key $xml = q( before /usr/bin /usr/local/bin after ); $opt = XMLin($xml, grouptags => {dirs => 'dir'} ); is_deeply($opt, { prefix => 'before', dirs => { lib => [ '/usr/bin', '/usr/local/bin' ] }, suffix => 'after', }, 'disintermediation using wrong child key - as expected'); # Test option error handling $@=''; $_ = eval { XMLin('', rootname => 'fred') }; # not valid for XMLin() is($_, undef, 'invalid options are trapped'); like($@, qr/Unrecognised option:/, 'with correct error message'); $@=''; $_ = eval { XMLin('', 'searchpath') }; is($_, undef, 'invalid number of options are trapped'); like($@, qr/odd number/, 'with correct error message'); # Test the NormaliseSpace option $xml = q( Jane Doe three four ); $opt = XMLin($xml, KeyAttr => [ 'name' ], NormaliseSpace => 1); ok(ref($opt->{user}) eq 'HASH', "NS-1: folding OK"); ok(exists($opt->{user}->{'Joe Bloggs'}), "NS-2: space normalised in hash key"); ok(exists($opt->{user}->{'Jane Doe'}), "NS-3: space normalised in hash key"); like($opt->{user}->{'Jane Doe'}->{id}, qr{^\s\s+three\s\s+four\s\s+$}s, "NS-4: space not normalised in hash value"); $opt = XMLin($xml, KeyAttr => { user => 'name' }, NormaliseSpace => 1); ok(ref($opt->{user}) eq 'HASH', "NS-1a: folding OK"); ok(exists($opt->{user}->{'Joe Bloggs'}), "NS-2a: space normalised in hash key"); ok(exists($opt->{user}->{'Jane Doe'}), "NS-3a: space normalised in hash key"); like($opt->{user}->{'Jane Doe'}->{id}, qr{^\s\s+three\s\s+four\s\s+$}s, "NS-4a: space not normalised in hash value"); $opt = XMLin($xml, KeyAttr => [ 'name' ], NormaliseSpace => 2); ok(ref($opt->{user}) eq 'HASH', "NS-5: folding OK"); ok(exists($opt->{user}->{'Joe Bloggs'}), "NS-6: space normalised in hash key"); like($opt->{user}->{'Joe Bloggs'}->{id}, qr{^one\stwo$}s, "NS-7: space normalised in attribute value"); ok(exists($opt->{user}->{'Jane Doe'}), "NS-8: space normalised in hash key"); like($opt->{user}->{'Jane Doe'}->{id}, qr{^three\sfour$}s, "NS-9: space normalised in element text content"); # confirm NormaliseSpace works in anonymous arrays too $xml = q( one two three four five six seveneightnine ); $opt = XMLin($xml, NormaliseSpace => 2); is_deeply($opt, [ 'one two', 'three four five', 'six', 'seveneightnine' ], "NS-10: space normalised in anonymous array"); # Check that American speeling works too $opt = XMLin($xml, NormalizeSpace => 2); is_deeply($opt, [ 'one two', 'three four five', 'six', 'seveneightnine' ], "NS-11: space normalized in anonymous array"); # Check that attributes called 'value' are not special $xml = q( ); $opt = XMLin($xml); is_deeply($opt, { 'today' => { value => "today.png" }, 'nav-prev' => { value => "prev.png" }, 'nav-home' => { value => "home.png" }, 'nav-next' => { value => "next.png" }, }, "Nothing special about 'value' attributes"); # Now turn on the ValueAttr option and try again $opt = XMLin($xml, ValueAttr => [ 'value' ]); is_deeply($opt, { 'today' => "today.png", 'nav-prev' => "prev.png", 'nav-home' => "home.png", 'nav-next' => "next.png", }, "ValueAttr as arrayref works"); # Try with a list of different ValueAttr names $xml = q( ); $opt = XMLin($xml, ValueAttr => [ qw(xxx yyy zzz) ]); is_deeply($opt, { 'today' => "today.png", 'nav-prev' => "prev.png", 'nav-home' => "home.png", 'nav-next' => { value => "next.png" }, }, "ValueAttr as arrayref works"); # Try specifying ValueAttr as a hashref $xml = q( ); $opt = XMLin($xml, ValueAttr => { 'today' => 'xxx', 'nav-home' => 'yyy', 'nav-next' => 'value' } ); is_deeply($opt, { 'today' => "today.png", 'nav-prev' => { value => "prev.png" }, 'nav-home' => "home.png", 'nav-next' => "next.png", }, "ValueAttr as hashref works too"); # Confirm that there's no conflict with KeyAttr or ContentKey defaults $xml = q( red ); $opt = XMLin($xml, ValueAttr => { 'today' => 'value' }); is_deeply($opt, { today => 'today.png', animal => { lion => { age => 7 }, elephant => { age => 97 }, }, colour => { rgb => '#FF0000', content => 'red' }, }, "ValueAttr as hashref works too"); # Now for a 'real world' test, try slurping in an SRT config file $opt = XMLin(File::Spec->catfile('t', 'srt.xml'), forcearray => 1, @cont_key ); $target = { 'global' => [ { 'proxypswd' => 'bar', 'proxyuser' => 'foo', 'exclude' => [ '/_vt', '/save\\b', '\\.bak$', '\\.\\$\\$\\$$' ], 'httpproxy' => 'http://10.1.1.5:8080/', 'tempdir' => 'C:/Temp' } ], 'pubpath' => { 'test1' => { 'source' => [ { 'label' => 'web_source', 'root' => 'C:/webshare/web_source' } ], 'title' => 'web_source -> web_target1', 'package' => { 'images' => { 'dir' => 'wwwroot/images' } }, 'target' => [ { 'label' => 'web_target1', 'root' => 'C:/webshare/web_target1', 'temp' => 'C:/webshare/web_target1/temp' } ], 'dir' => 'wwwroot' }, 'test2' => { 'source' => [ { 'label' => 'web_source', 'root' => 'C:/webshare/web_source' } ], 'title' => 'web_source -> web_target1 & web_target2', 'package' => { 'bios' => { 'dir' => 'wwwroot/staff/bios' }, 'images' => { 'dir' => 'wwwroot/images' }, 'templates' => { 'dir' => 'wwwroot/templates' } }, 'target' => [ { 'label' => 'web_target1', 'root' => 'C:/webshare/web_target1', 'temp' => 'C:/webshare/web_target1/temp' }, { 'label' => 'web_target2', 'root' => 'C:/webshare/web_target2', 'temp' => 'C:/webshare/web_target2/temp' } ], 'dir' => 'wwwroot' }, 'test3' => { 'source' => [ { 'label' => 'web_source', 'root' => 'C:/webshare/web_source' } ], 'title' => 'web_source -> web_target1 via HTTP', 'addexclude' => '\\.pdf$', 'target' => [ { 'label' => 'web_target1', 'root' => 'http://127.0.0.1/cgi-bin/srt_slave.plx', 'noproxy' => 1 } ], 'dir' => 'wwwroot' } } }; is_deeply($opt, $target, 'successfully read an SRT config file'); exit(0); sub warn_handler { $last_warning = $_[0]; } XML-LibXML-Simple-0.97/t/10XMLin.xml0000644000175000001440000000004112703172072017254 0ustar00markovusers00000000000000 XML-LibXML-Simple-0.97/t/srt.xml0000644000175000001440000000372012703172072016743 0ustar00markovusers00000000000000 /_vt /save\b \.bak$ \.\$\$\$$ wwwroot wwwroot wwwroot \.pdf$ XML-LibXML-Simple-0.97/t/01use.t0000644000175000001440000000134012703172072016527 0ustar00markovusers00000000000000#!/usr/bin/perl use warnings; use strict; use lib 'lib'; use Test::More tests => 1; # The versions of the following packages are reported to help understanding # the environment in which the tests are run. This is certainly not a # full list of all installed modules. my @show_versions = qw/Test::More XML::LibXML /; foreach my $package (@show_versions) { eval "require $package"; no strict 'refs'; my $report = !$@ ? "version ". (${"$package\::VERSION"} || 'unknown') : $@ =~ m/^Can't locate/ ? "not installed" : "reports error"; warn "$package $report\n"; } my $xml2_version = XML::LibXML::LIBXML_DOTTED_VERSION(); warn "libxml2 $xml2_version\n"; require_ok('XML::LibXML::Simple'); XML-LibXML-Simple-0.97/t/test1.xml0000644000175000001440000000003712703172072017171 0ustar00markovusers00000000000000 XML-LibXML-Simple-0.97/MANIFEST0000644000175000001440000000053112703172073016275 0ustar00markovusers00000000000000ChangeLog MANIFEST Makefile.PL README lib/XML/LibXML/Simple.pm lib/XML/LibXML/Simple.pod t/01use.t t/10XMLin.t t/10XMLin.xml t/srt.xml t/subdir/test2.xml t/test1.xml xt/99pod.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) XML-LibXML-Simple-0.97/ChangeLog0000644000175000001440000000413212703172072016716 0ustar00markovusers00000000000000 === version history for XML::LibXML::Simple version 0.97: Tue 12 Apr 15:12:21 CEST 2016 Fixes: - HookNodes parameter was not allowed. [Kit Peters] version 0.96: Fri 11 Mar 15:09:43 CET 2016 Improvements: - deprecate XML input from 'undef' - rewrite UNIVERSAL::isa into blessed ->isa - implement hooks on nodes version 0.95: Mon Dec 22 08:19:53 CET 2014 Fixes: - content-key collapse did not work with any key value of 0. Improvements: - doc: be clear that an XML::LibXML node can be used as source for XMLin as well [Salve J. Nilsen] - doc: cleaner SYNOPSIS, minor reorganisation. version 0.94: Sat Jun 7 22:39:23 CEST 2014 Improvements: - change documentation style. - replace File::Slurp by File::Slurp::Tiny [Caleb Cushing] version 0.93: Sat Mar 2 11:58:52 CET 2013 Improvements: - move pod-test to xt/ - fix warning produced by Pod::Checker version 0.92: Fri Dec 21 12:22:16 CET 2012 Fixes: - include license in the manuals. version 0.91: Mon Jul 11 22:40:02 CEST 2011 Fixes: - forcearray option with one element rt.cpan.org#69336 [Matt W Johnson] version 0.90: Wed Jun 15 10:20:48 CEST 2011 Fixes: - initialize XML::LibXML::Parser into safe mode. rt.cpan.org#68803 [Yann Kerherve] Improvements: - new Parser and ParserOpts parameters version 0.15: Thu Apr 28 10:22:34 CEST 2011 Fixes: - parser object recreated each time, because it cannot be reused (any more?). [Didier Brun] version 0.14: Fri Jul 16 11:17:49 CEST 2010 Fixes: - do not use /bin/pwd in t/99pod.t - forgot to define xml_in. rt.cpan.org#59172 [Justin Case] version 0.13: Wed Nov 19 11:03:52 CET 2008 Fixes: - do not try to expand namespace in "pseudo-" attributes, like namespace declarations. Improvements: - include the ChangeLog in the package. Discovered by [CPANTS] - add option NsStrip version 0.12: Wed Mar 26 11:43:09 CET 2008 Fixes: - fix tests on Windows. version 0.11: Fri Feb 8 14:41:35 CET 2008 Improvements: - moved XML input parsing to separate subroutine - added ChangeLog - added some more docs version 0.10: Mon Feb 4 17:46:07 CET 2008 - initial release XML-LibXML-Simple-0.97/xt/0000755000175000001440000000000012703172073015600 5ustar00markovusers00000000000000XML-LibXML-Simple-0.97/xt/99pod.t0000644000175000001440000000041212703172072016725 0ustar00markovusers00000000000000#!/usr/bin/perl use warnings; use strict; use Test::More; BEGIN { eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; plan skip_all => "devel home uses OODoc" if $ENV{MARKOV_DEVEL}; } all_pod_files_ok(); XML-LibXML-Simple-0.97/Makefile.PL0000644000175000001440000000140612703172072017117 0ustar00markovusers00000000000000use ExtUtils::MakeMaker; use 5.008; WriteMakefile ( NAME => 'XML::LibXML::Simple' , VERSION => '0.97' , PREREQ_PM => { XML::LibXML => 1.64 , Test::More => 0.54 , File::Slurp::Tiny => 0 , Scalar::Util => 0 } , AUTHOR => 'Mark Overmeer' , ABSTRACT => 'XML::LibXML based XML::Simple clone' , LICENSE => 'perl' ); ### used by oodist during production of distribution sub MY::postamble { <<'__POSTAMBLE' } RAWDIR = ../public_html/xml-libxml-simple/raw DISTDIR = ../public_html/xml-libxml-simple/source LICENSE = artistic SKIP_LINKS = XML::LibXML # for POD FIRST_YEAR = 2008 EMAIL = perl@overmeer.net WEBSITE = http://perl.overmeer.net/xml-libxml-simple/ __POSTAMBLE XML-LibXML-Simple-0.97/README0000644000175000001440000000147612703172072016034 0ustar00markovusers00000000000000=== README for XML-LibXML-Simple version 0.97 = Generated on Tue Apr 12 15:12:26 2016 by OODoc 2.02 There are various ways to install this module: (1) if you have a command-line, you can do: perl -MCPAN -e 'install ' (2) if you use Windows, have a look at http://ppm.activestate.com/ (3) if you have downloaded this module manually (as root/administrator) gzip -d XML-LibXML-Simple-0.97.tar.gz tar -xf XML-LibXML-Simple-0.97.tar cd XML-LibXML-Simple-0.97 perl Makefile.PL make # optional make test # optional make install For usage, see the included manual-pages or http://search.cpan.org/dist/XML-LibXML-Simple-0.97/ Please report problems to http://rt.cpan.org/Dist/Display.html?Queue=XML-LibXML-Simple XML-LibXML-Simple-0.97/META.yml0000644000175000001440000000104112703172073016412 0ustar00markovusers00000000000000--- abstract: 'XML::LibXML based XML::Simple clone' author: - 'Mark Overmeer' build_requires: ExtUtils::MakeMaker: 0 configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.64, CPAN::Meta::Converter version 2.120630' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: XML-LibXML-Simple no_index: directory: - t - inc requires: File::Slurp::Tiny: 0 Scalar::Util: 0 Test::More: 0.54 XML::LibXML: 1.64 version: 0.97 XML-LibXML-Simple-0.97/META.json0000644000175000001440000000172512703172073016573 0ustar00markovusers00000000000000{ "abstract" : "XML::LibXML based XML::Simple clone", "author" : [ "Mark Overmeer" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.64, CPAN::Meta::Converter version 2.120630", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "XML-LibXML-Simple", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "File::Slurp::Tiny" : "0", "Scalar::Util" : "0", "Test::More" : "0.54", "XML::LibXML" : "1.64" } } }, "release_status" : "stable", "version" : "0.97" }