File Coverage

blib/lib/XML/Quick.pm

Criterion	Covered	Total	%
statement	56	60	93.3
branch	28	38	73.6
condition	8	10	80.0
subroutine	7	7	100.0
pod	1	1	100.0
total	100	116	86.2

package XML::Quick;

use warnings;
use strict;

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

use base qw(Exporter);

our @EXPORT = qw(xml);

our $VERSION = '0.05';

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

    $cdata =~ s/&/&/g;
    $cdata =~ s/
    $cdata =~ s/>/>/g;
    $cdata =~ s/"/"/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
        $opts = {};
    }
    else {
        # shallow copy the opts so we don't modify the callers
        $opts = {%$opts};
    }

    # escape by default
    $opts->{escape} = 1 if not exists $opts->{escape};

    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 });
            }

            # 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
    if($opts->{root}) {
        # open the tag
        my $wrap = "<$opts->{root}";

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

                $wrap .= " $key='$opts->{attrs}->{$key}'";
            }
        }

        # 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{root}>";
        }

        $xml = $wrap;
    }

    # all done
    return $xml;
}

1;

__END__