File Coverage

blib/lib/XML/Parser/Style/Elemental.pm

Criterion	Covered	Total	%
statement	9	59	15.2
branch	0	20	0.0
condition	0	25	0.0
subroutine	3	9	33.3
pod	0	6	0.0
total	12	119	10.0

# Copyright (c) 2004-2005 Timothy Appnel
# http://www.timaoutloud.org/
# This code is released under the Artistic License.
#
# XML::Parser::Style::Elemental - A flexible and extensible object
# tree style for XML::Parser. DEPRECATED.
#

package XML::Parser::Style::Elemental;
use strict;
use warnings;

use vars qw($VERSION);
$VERSION = '0.72';

sub Init {
    my $xp = shift;
    $xp->{Elemental} ||= {};
    my $e = $xp->{Elemental};
    if ($xp->{Pkg} eq 'main' || !defined $xp->{Pkg}) {
        $e->{Document}   ||= 'XML::Elemental::Document';
        $e->{Element}    ||= 'XML::Elemental::Element';
        $e->{Characters} ||= 'XML::Elemental::Characters';
    }
    map { eval "use $e->{$_}" } qw( Document Element Characters);
    $xp->{__doc} = $e->{Document}->new;
    push(@{$xp->{__stack}}, $xp->{__doc});
}

sub Start {
    my $xp   = shift;
    my $tag  = shift;
    my $node = $xp->{Elemental}->{Element}->new();
    $node->name(ns_qualify($xp, $tag));
    $node->parent($xp->{__stack}->[-1]);
    if (@_) {
        $node->attributes({});
        while (@_) {
            my ($key, $value) = (shift @_, shift @_);
            $node->attributes->{ns_qualify($xp, $key, $tag)} = $value;
        }
    }
    $node->parent->contents([]) unless $node->parent->contents;
    push(@{$node->parent->contents}, $node);
    push(@{$xp->{__stack}},          $node);
}

sub Char {
    my ($xp, $data) = @_;
    my $parent = $xp->{__stack}->[-1];
    $parent->contents([]) unless $parent->contents;
    my $contents = $parent->contents();
    my $class    = $xp->{Elemental}->{Characters};
    unless ($contents && ref($contents->[-1]) eq $class) {
        return if ($xp->{Elemental}->{No_Whitespace} && $data !~ /\S/);
        my $node = $class->new();
        $node->parent($parent);
        $node->data($data);
        push(@{$contents}, $node);
    }
    else {
        my $d = $contents->[-1]->data() || '';
        return if ($xp->{Elemental}->{No_Whitespace} && $d !~ /\S/);
        $contents->[-1]->data("$d$data");
    }
}

sub End { pop(@{$_[0]->{__stack}}) }

sub Final {
    delete $_[0]->{__stack};
    $_[0]->{__doc};
}

sub ns_qualify {
    return $_[1] unless $_[0]->{Namespaces};
    my $ns = $_[0]->namespace($_[1]) || $_[0]->namespace($_[2]);
    return $_[1] unless $ns;
    $ns =~ m!(/|#)$! ? "$ns$_[1]" : "$ns/$_[1]";
}

1;

__END__