1package XML::Toolkit::Loader::Filter;
2{
3  $XML::Toolkit::Loader::Filter::VERSION = '0.15';
4}
5use Moose;
6use namespace::autoclean;
7
8extends qw(XML::Filter::Moose);
9
10with qw(XML::Toolkit::Builder::ClassRegistry);
11
12has objects => (
13    isa     => 'ArrayRef',
14    is      => 'ro',
15    traits  => ['Array'],
16    lazy    => 1,
17    builder => '_build_objects',
18    clearer => 'reset_state',
19    handles => {
20        pop_object     => ['pop'],
21        add_object     => ['push'],
22        objects_count  => ['count'],
23        current_object => [ 'get', -1 ],
24        root_object    => [ 'get', 0 ],
25      }
26
27);
28
29sub _build_objects { [] }
30
31sub parent_object {
32    my ($self) = @_;
33    if ( $self->objects_count >= 2 ) {
34        return $self->objects->[-2];
35    }
36    return undef if $self->objects_count == 1;
37    return $self->objects->[-1];
38}
39
40sub at_root_object { $_[0]->current_object == $_[0]->root_object }
41
42sub load_class {
43    my ( $self, $name ) = @_;
44    Class::MOP::load_class($name);
45    return $name;
46}
47
48sub create_and_add_object {
49    my ( $self, $class, $el ) = @_;
50    my %params =
51      map { $_->{LocalName} => $_->{Value} } values %{ $el->{Attributes} };
52    my $obj = $class->new(%params);
53    $self->add_object($obj);
54
55}
56
57sub start_element {
58    my ( $self, $el ) = @_;
59
60    my $classname = $self->get_class_name($el);
61    $el->{classname} = $classname;
62
63    if ( my $class = $self->load_class($classname) ) {
64        $self->create_and_add_object( $class => $el );
65    }
66    $self->add_element($el);
67    return;
68}
69
70sub append_to_parent {
71    my ( $self, $parent, $el ) = @_;
72    if ( my $method = $parent->can("add_$el->{LocalName}") ) {
73        $parent->$method( $self->current_object );
74    }
75}
76
77sub set_object_text {
78    my ($self) = @_;
79    $self->current_object->text( $self->text )
80      if $self->current_object->can('text');
81}
82
83sub end_element {
84    my ( $self, $el ) = @_;
85    $self->set_object_text if $self->has_text;
86    if ( my $parent = $self->parent_object ) {
87        $self->append_to_parent( $parent => $el );
88    }
89    $self->pop_object unless $self->at_root_object;
90    $self->pop_element;
91    $self->reset_text;
92}
93
94sub render {
95    warn shift->root_object->dump;
96}
97
98__PACKAGE__->meta->make_immutable;
991;
100__END__
101
102=head1 NAME
103
104XML::Toolkit::Loader::Filter - A class to ...
105
106=head1 VERSION
107
108version 0.15
109
110=head1 SYNOPSIS
111
112use XML::Toolkit::Loader::Filter;
113
114=head1 DESCRIPTION
115
116The XML::Toolkit::Loader::Filter class implements ...
117
118=head1 SUBROUTINES / METHODS
119
120=head2 parent_object (method)
121
122Parameters:
123    none
124
125Insert description of method here...
126
127=head2 current_object (method)
128
129Parameters:
130    none
131
132Insert description of method here...
133
134=head2 root_object (method)
135
136Parameters:
137    none
138
139Insert description of method here...
140
141=head2 load_class (method)
142
143Parameters:
144    name
145
146Insert description of method here...
147
148=head2 get_class_name (method)
149
150Parameters:
151    name
152    self
153    el
154    self
155    el
156
157Insert description of method here...
158
159=head2 render
160
161Parameters:
162    none
163
164Insert description of subroutine here...
165
166=head1 DEPENDENCIES
167
168Moose
169
170=head1 NOTES
171
172...
173
174=head1 BUGS AND LIMITATIONS
175
176None known currently, please email the author if you find any.
177
178=head1 AUTHOR
179
180Chris Prather (perigrin@domain.tld)
181
182=head1 LICENCE
183
184Copyright 2009 by Chris Prather.
185
186This software is free.  It is licensed under the same terms as Perl itself.
187
188=cut
189