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