File Coverage

blib/lib/Simple/SAX/Serializer/Element.pm

Criterion	Covered	Total	%
statement	53	57	92.9
branch	13	20	65.0
condition	6	10	60.0
subroutine	12	13	92.3
pod	8	8	100.0
total	92	108	85.1

package Simple::SAX::Serializer::Element;

use warnings;
use strict;
use vars qw($VERSION);
use Carp 'confess';

$VERSION = 0.03;

use Abstract::Meta::Class ':all';

=head1 NAME

Simple::SAX::Serializer::Element - XML node element.

=head1 SYNOPSIS

    my $xml = Simple::SAX::Serializer->new;
    $xml->handler('dataset', sub {
             my ($self, $element, $parent) = @_;
             my $attributes = $element->attributes;
             my $children_result = $element->children_result;
             {properties => $attributes, dataset => $children_result}
         }
     );
     $xml->handler('*', sub {
         my ($self, $element, $parent) = @_;
         my $attributes = $element->attributes;
         my $children_result = $parent->children_array_result;
         my $result = $parent->children_result;
         push @$children_result, $element->name => {%$attributes};
     });
 }

=head1 DESCRIPTION

Represents xml node element.

=head2 EXPORT

None.

=head2 ATTRIBUTES

=over

=item node

Stores reference to the xml node.

=cut

has '$.node';

=back

=head2 METHODS

=over

=item attributes

Return attributes as hash ref.

=cut

sub attributes {
    my ($self) = @_;
    my $node = $self->node;
    $node->[1];
}


=item name

=cut

sub name {
    my ($self) = @_;
    my $node = $self->node;
    $node->[0];
}

=item children_result

Returns children results.

=cut

sub children_result {
    my ($self, $value) = @_;
    my $node = $self->node;
    $node->[-2] = $value if $value;
    $node->[-2];
}


=item children_array_result

Returns children result as array ref

=cut

sub children_array_result {
    my ($self, $value) = @_;
    my $node = $self->node;
    $node->[-2] = [] unless $node->[-2] ;
    $node->[-2] = $value if $value;
    $node->[-2];
}


=item children_hash_result

Returns children result as hash ref

=cut

sub children_hash_result {
    my ($self, $value) = @_;
    my $node = $self->node;
    $node->[-2] = {} unless $node->[-2] ;
    $node->[-2] = $value if $value;
    $node->[-2];
}


=item set_children_result

Sets children result

=cut

sub set_children_result {
    my ($self, $value) = @_;
    my $node = $self->node;
    $node->[-2] = $value;
    $self;
}


=item value

Return element's value. Takes optionally normalise spaces flag.

=cut

sub value {
    my ($self, $normailise_spaces) = @_;
    my $node = $self->node;
    my $result = $node->[-1];
    $result =~ s/^\s+|\s+$//sg if defined($result) && $normailise_spaces;
    $result;
}


=item validate_attributes

Validates element attributes takes, required attributes parameter as array ref,
optional attributes parameter as hash ref
    $element->validate_attributes(['name'], {type => 'text'});

=cut

sub validate_attributes {
    my ($self, $required, $optional) = @_;
    $required ||= [];
    $optional ||= {};
    my %attributes = map { $_ => 1 } @$required;
    my $attributes = $self->attributes;
    for (@$required) {
        confess "attribute $_ is required"
            unless exists $attributes->{$_};
    }

    for my $k (keys %$optional) {
            $attributes->{$k} = $optional->{$k}
                unless exists $attributes->{$k};
    }

    for my $k(keys %$attributes) {
        next if $k =~ /^_/;
        confess "unknown attributes $k on tag " . $self->name
            if (! exists($attributes{$k}) && ! exists($optional->{$k}));
    }

}

1;

__END__