view release on metacpan or  search on metacpan

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

        attrs => {},
    };

    for my $arg (@args) {
        if (ref $arg eq "HASH") {
            for my $key (keys %$arg) {
                if (!defined $arg->{$key}) {
                    delete $chunk->{attrs}->{$key};
                } else {
                    $chunk->{attrs}->{$key} = "".$arg->{$key};
                }
            }
        }

        else {
            push @{$chunk->{sub}}, $arg;
        }
    }

    return bless $chunk, "XML::Spice::Chunk";
}


package # hide from PAUSE
    XML::Spice::Chunk;

use warnings;
use strict;

use Carp;

use overload
    '""' => \&_xml;

my $TIDY_LOADED;

sub _xml {
    my ($chunk) = @_;

    if ($PRETTY_PRINT && !defined $TIDY_LOADED) {
        eval { require XML::Tidy::Tiny };
        if ($@) {
            carp "Couldn't load XML::Tidy::Tiny: $@";
            $TIDY_LOADED = 0;
        }
        else {
            $TIDY_LOADED = 1;
        }
    }

    my $WANT_PRETTY = $PRETTY_PRINT && $TIDY_LOADED;

    return $chunk->{cached} if exists $chunk->{cached} && !$WANT_PRETTY;

    sub _escape_attr {
        my ($val) = @_;
        $val =~ s/'/'/g;
        return $val;
    }

    sub _escape_cdata {
        my ($val) = @_;
        $val =~ s/&/&/g;
        $val =~ s/</&lt;/g;
        $val =~ s/>/&gt;/g;
        $val =~ s/"/&quot;/g;
        $val =~ s/([^\x20-\x7E])/'&#' . ord($1) . ';'/ge;
        return $val;
    }

    sub _serialise {
        my ($chunk, @things) = @_;

        my $xml = '';

        for my $thing (@things) {
            next if ! defined $thing;

            if (ref $thing eq "CODE") {
                $thing = &{$thing};

                if (ref $thing eq "HASH") {
                    for my $key (keys %$thing) {
                        if (!defined $thing->{$key}) {
                            delete $chunk->{attrs}->{$key};
                        } else {
                            $chunk->{attrs}->{$key} = "".$thing->{$key};
                        }
                    }
                    undef $thing;
                }

                redo;
            }

            if (ref $thing eq "ARRAY") {
                $xml .= $chunk->_serialise(@$thing);
            }

            elsif (ref $thing eq "XML::Spice::Chunk") {
                $xml .= $thing->_xml;
            }

            else {
                next if $thing eq "";
                $xml .= _escape_cdata($thing);
            }
        }

        return $xml;
    }

    my $subxml = $chunk->_serialise(@{$chunk->{sub}}) if exists $chunk->{sub};

    my $xml = "<" . $chunk->{tag};

    for my $attr (keys %{$chunk->{attrs}}) {
        $xml .= " $attr='" . _escape_attr($chunk->{attrs}->{$attr}) . "'";
    }

    if (!defined $subxml) {
        $xml .= "/>";
        $chunk->{cached} = $xml unless $WANT_PRETTY;
        return $WANT_PRETTY ? XML::Tidy::Tiny::xml_tidy($xml) : $xml;
    }

    $xml .= ">" . $subxml . "</" . $chunk->{tag} . ">";

    $chunk->{cached} = $xml unless $WANT_PRETTY;
    return $WANT_PRETTY ? XML::Tidy::Tiny::xml_tidy($xml) : $xml;
}

sub forget {
    my ($chunk) = @_;

    delete $chunk->{cached};
}

1;

__END__

=pod

=encoding UTF-8

=for markdown [![Build Status](https://secure.travis-ci.org/robn/XML-Spice.png)](http://travis-ci.org/robn/XML-Spice)

=head1 NAME

XML::Spice - generating XML has never been so Perly!

=head1 SYNOPSIS

    use XML::Spice qw(html head title body h1 p a);

    print
        html(
            head(
                title("my great page"),
            ),
            body(
                h1("my great page"),
                p("this is my great page, made with ", 
                  a("spice", { href => "http://en.wikipedia.org/wiki/Spice/" }),
                ),