XML::Toolkit::Loader::Filter - A class to ...


XML-Toolkit documentation Contained in the XML-Toolkit distribution.

Index


Code Index:

NAME

Top

XML::Toolkit::Loader::Filter - A class to ...

VERSION

Top

This documentation refers to version 0.01.

SYNOPSIS

Top

use XML::Toolkit::Loader::Filter;

DESCRIPTION

Top

The XML::Toolkit::Loader::Filter class implements ...

SUBROUTINES / METHODS

Top

parent_object (method)

Parameters: none

Insert description of method here...

current_object (method)

Parameters: none

Insert description of method here...

root_object (method)

Parameters: none

Insert description of method here...

load_class (method)

Parameters: name

Insert description of method here...

get_class_name (method)

Parameters: name self el self el

Insert description of method here...

render

Parameters: none

Insert description of subroutine here...

DEPENDENCIES

Top

Moose

NOTES

Top

...

BUGS AND LIMITATIONS

Top

None known currently, please email the author if you find any.

AUTHOR

Top

Chris Prather (perigrin@domain.tld)

LICENCE

Top

Copyright 2009 by Chris Prather.

This software is free. It is licensed under the same terms as Perl itself.


XML-Toolkit documentation Contained in the XML-Toolkit distribution.

package XML::Toolkit::Loader::Filter;
use Moose;
use namespace::autoclean;

extends qw(XML::Filter::Moose);
with qw(XML::Toolkit::Builder::ClassRegistry);

has objects => (
    isa     => 'ArrayRef',
    is      => 'ro',
    traits  => ['Array'],
    lazy    => 1,
    builder => '_build_objects',
    clearer => 'reset_state',
    handles => {
        pop_object     => ['pop'],
        add_object     => ['push'],
        objects_count  => ['count'],
        current_object => [ 'get', -1 ],
        root_object    => [ 'get', 0 ],
      }

);

sub _build_objects { [] }

sub parent_object {
    my ($self) = @_;
    if ( $self->objects_count >= 2 ) {
        return $self->objects->[-2];
    }
    return undef if $self->objects_count == 1;
    return $self->objects->[-1];
}

sub at_root_object { $_[0]->current_object == $_[0]->root_object }

sub load_class {
    my ( $self, $name ) = @_;
    Class::MOP::load_class($name);
    return $name;
}

sub create_and_add_object {
    my ( $self, $class, $el ) = @_;
    my %params =
      map { $_->{LocalName} => $_->{Value} } values %{ $el->{Attributes} };
    my $obj = $class->new(%params);
    $self->add_object($obj);

}

sub start_element {
    my ( $self, $el ) = @_;

    my $classname = $self->get_class_name($el);
    $el->{classname} = $classname;

    if ( my $class = $self->load_class($classname) ) {
        $self->create_and_add_object( $class => $el );
    }
    $self->add_element($el);
    return;
}

sub append_to_parent {
    my ( $self, $parent, $el ) = @_;
    if ( my $method = $parent->can("add_$el->{LocalName}") ) {
        $parent->$method( $self->current_object );
    }
}

sub set_object_text {
    my ($self) = @_;
    $self->current_object->text( $self->text )
      if $self->current_object->can('text');
}

sub end_element {
    my ( $self, $el ) = @_;
    $self->set_object_text if $self->has_text;
    if ( my $parent = $self->parent_object ) {
        $self->append_to_parent( $parent => $el );
    }
    $self->pop_object unless $self->at_root_object;
    $self->pop_element;
    $self->reset_text;
}

sub render {
    warn shift->root_object->dump;
}

__PACKAGE__->meta->make_immutable;
1;
__END__