XML-Quick

 view release on metacpan or  search on metacpan

lib/XML/Quick.pm  view on Meta::CPAN

use warnings;
use strict;

use Scalar::Util qw(reftype);
use Exporter;

use base qw(Exporter);

our @EXPORT = qw(xml);

# cdata escaping
sub _escape($) {
    my ($cdata) = @_;

    $cdata =~ s/&/&/g;
    $cdata =~ s/</&lt;/g;
    $cdata =~ s/>/&gt;/g;
    $cdata =~ s/"/&quot;/g;

    $cdata =~ s/([^\x20-\x7E])/'&#' . ord($1) . ';'/ge;

    return $cdata;
};

sub xml {
    my ($data, $opts) = @_;

    # handle undef properly
    $data = '' if not defined $data;
    
    if (not defined $opts or reftype $opts ne 'HASH') {
        # empty options hash if they didn't provide one

lib/XML/Quick.pm  view on Meta::CPAN

    my $xml = '';

    # stringify anything thats not a hash
    if(not defined reftype $data or reftype $data ne 'HASH') {
        $xml = $opts->{escape} ? _escape($data) : $data;
    }

    # dig down into hashes
    else {
        # move attrs/cdata into opts as necessary
        if(exists $data->{_attrs}) {
            $opts->{attrs} = $data->{_attrs} if not exists $opts->{attrs};
        }

        if(exists $data->{_cdata}) {
            $opts->{cdata} = $data->{_cdata} if not exists $opts->{cdata};
        }
        
        # loop over the keys
        for my $key (keys %{$data}) {
            # skip meta
            next if $key =~ m/^_/;

            # undef
            if(not defined $data->{$key}) {
                $xml .= xml('', { root => $key });

lib/XML/Quick.pm  view on Meta::CPAN

            # plain scalar
            elsif(not ref $data->{$key}) {
                $xml .= xml($data->{$key}, { root => $key });
            }

            # hash
            elsif(reftype $data->{$key} eq 'HASH') {
                $xml .= xml($data->{$key}, { root => $key,
                                             attrs => $data->{$key}->{_attrs} || {},
                                             cdata => $data->{$key}->{_cdata} || '' })
            }

            # array
            elsif(reftype $data->{$key} eq 'ARRAY') {
                $xml .= xml($_, { root => $key }) for @{$data->{$key}};
            }
        }
    }

    # wrap it up

lib/XML/Quick.pm  view on Meta::CPAN

        if($opts->{attrs}) {
            for my $key (keys %{$opts->{attrs}}) {
                my $val = $opts->{attrs}->{$key};
                $val =~ s/'/'/g;

                $wrap .= " $key='$val'";
            }
        }

        # character data
        if($opts->{cdata}) {
            $xml = ($opts->{escape} ? _escape($opts->{cdata}) : $opts->{cdata}) . $xml;
        }

        # if there's no content, then close it up right now
        if($xml eq '') {
            $wrap .= '/>';
        }

        # otherwise dump in the contents and close
        else {
            $wrap .= ">$xml</$opts->{root}>";

lib/XML/Quick.pm  view on Meta::CPAN

          'tag' => {
                     '_attrs' => {
                                   'foo' => 'bar'
                                 }
                   }
        });

    # produces: <tag foo='bar'/>
 
Of course, you're probably going to want to include a value or other tags
inside this tag. For a value, use the C<_cdata> key:

    xml({
          'tag' => {
                     '_attrs' => {
                                   'foo' => 'bar'
                                 },
                     '_cdata' => 'value'
                   }
        });

    # produces: <tag foo='bar'>value</tag>

For nested tags, just include them like normal:
    
    xml({
          'tag' => {
                     '_attrs' => {

lib/XML/Quick.pm  view on Meta::CPAN

    xml({ tag => 'value' }, { root => 'wrap' });
    # produces: <wrap><tag>value</tag></wrap>

=item * attrs

Used in conjuction with the C<root> option to add attributes to the root tag.

    xml({ tag => 'value' }, { root => 'wrap', attrs => { style => 'shiny' }});
    # produces: <wrap style='shiny'><tag>value</tag></wrap>

=item * cdata

Used in conjunction with the C<root> option to add character data to the root
tag.

    xml({ tag => 'value' }, { root => 'wrap', cdata => 'just along for the ride' });
    # produces: <wrap>just along for the ride<tag>value</tag></wrap>

You probably don't need to use this. If you just want to create a basic tag
from nothing do this:

    xml({ tag => 'value' });

Rather than this:

    xml('', { root => 'tag', cdata => 'value' });

You almost certainly don't want to add character data to a root tag with nested
tags inside. See L<BUGS AND LIMITATIONS> for more details.

=item * escape

A flag, enabled by default. When enabled, character data values will be escaped
with XML entities as appropriate. Disabling this is useful when you want to
wrap an XML string with another tag.

lib/XML/Quick.pm  view on Meta::CPAN

=head1 BUGS AND LIMITATIONS

Because Perl hash keys get randomised, there's really no guarantee the
generated XML tags will be in the same order as they were when you put them in
the hash.  This generally won't be a problem as the vast majority of XML-based
datatypes don't care about order. I don't recommend you use this module to
create XML when order is important (eg XHTML, XSL, etc).

Things are even more hairy when including character data alongside tags via the
C<cdata> or C<_cdata> options. The C<cdata> options only really exist to allow
attributes and values to be specified for a single tag. The rich support
necessary to support multiple character data sections interspersed alongside
tags is entirely outside the scope of what the module is designed for.

There are probably bugs. This kind of thing is an inexact science. Feedback
welcome.

=head1 SUPPORT

=head2 Bugs / Feature Requests

t/10-xml.t  view on Meta::CPAN

    { 'tag' => undef }                      => qq(<tag/>),

    { 'tag' =>
        { '_attrs' =>
            { 'foo' => 'bar' }}}            => qq(<tag foo="bar"/>),

    { 'tag' =>
        { '_attrs' =>
            { 'foo' => 'bar' },
          '_cdata' => 'value' }}            => qq(<tag foo="bar">value</tag>),

    { 'tag' =>
        { '_attrs' =>
            { 'foo' => 'bar' },
            'subtag' => 'value' }}          => qq(<tag foo="bar"><subtag>value</subtag></tag>),

    [ { 'tag' => 'value' },
      { root => 'wrap' } ]                  => qq(<wrap><tag>value</tag></wrap>),

    [ { 'tag' => 'value' },
      { root => 'wrap',
        attrs => { 'style' => 'shiny' }} ]  => qq(<wrap style="shiny"><tag>value</tag></wrap>),

    [ { 'tag' => 'value' },
      { root => 'wrap',
        cdata => 'tagging along' } ]        => qq(<wrap>tagging along<tag>value</tag></wrap>),

    [ '',
      { root => 'tag',
        cdata => 'value' } ]                => qq(<tag>value</tag>),

    [ "<xml>foo</xml>",
      { root => 'wrap' } ]                  => qq(<wrap>&lt;xml&gt;foo&lt;/xml&gt;</wrap>),

    [ "<xml>foo</xml>",
      { root => 'wrap',
        escape => 0 } ]                     => qq(<wrap><xml>foo</xml></wrap>),
);

while(@tests > 1) {

t/20-keep-object.t  view on Meta::CPAN

        },
    };
    my $hash_orig = _dump($hash);
    xml($hash);
    is(_dump($hash), $hash_orig, "passed data hash retains attrs");
}

{
    my $hash = {
        root => {
            _cdata => '_cdata text',
            cdata  => 'cdata tag',
            tag    => 'text',
        },
    };
    my $hash_orig = _dump($hash);
    xml($hash);
    is(_dump($hash), $hash_orig, "passed data hash retains cdata");
}

{
    my $hash = {
        root => {
            _attrs => { attr=>'value' },
        },
    };
    my $opts = {};
    my $opts_orig = _dump($opts);