File Coverage

blib/lib/SOAP/WSDL/Expat/Message2Hash.pm
Criterion Covered Total %
statement 9 9 100.0
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 12 12 100.0


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2             package SOAP::WSDL::Expat::Message2Hash;
3 1     1   3 use strict;
  1         1  
  1         29  
4 1     1   3 use warnings;
  1         1  
  1         17  
5 1     1   3 use base qw(SOAP::WSDL::Expat::Base);
  1         1  
  1         386  
6              
7             our $VERSION = 3.003;
8              
9             sub _initialize {
10             my ($self, $parser) = @_;
11             $self->{ parser } = $parser;
12             delete $self->{ data }; # remove potential old results
13              
14             my $characters;
15             my $current = {};
16             my $list = []; # node list
17             my $current_part = q{}; # are we in header or body ?
18             $self->{ data } = $current;
19              
20             # use "globals" for speed
21             my ($_element, $_method,
22             $_class, $_parser, %_attrs) = ();
23              
24             # no strict qw(refs);
25             $parser->setHandlers(
26             Start => sub {
27             push @$list, $current;
28             #If our element exists and is a list ref, add to it
29             if ( exists $current->{ $_[1] }
30             && ( ref ($current->{ $_[1] }) eq 'ARRAY')
31             ) {
32             push @{ $current->{ $_[1] } }, {};
33             $current = $current->{ $_[1] }->[-1];
34             }
35             elsif ( exists $current->{ $_[1] } )
36             {
37             $current->{ $_[1] } = [ $current->{ $_[1] }, {} ];
38             $current = $current->{ $_[1] }->[-1];
39             }
40             else {
41             $current->{ $_[1] } = {};
42             $current = $current->{ $_[1] };
43             }
44             return;
45             },
46              
47             Char => sub {
48             $characters .= $_[1] if $_[1] !~m{ \A \s* \z}xms;
49             return;
50             },
51              
52             End => sub {
53             $_element = $_[1];
54              
55             # This one easily handles ignores for us, too...
56             # return if not ref $$list[-1];
57              
58             if (length $characters) {
59             if (ref $list->[-1]->{ $_element } eq 'ARRAY') {
60             $list->[-1]->{ $_element }->[-1] = $characters ;
61             }
62             else {
63             $list->[-1]->{ $_element } = $characters;
64             }
65             }
66             $characters = q{};
67             $current = pop @$list; # step up in object hierarchy...
68             return;
69             }
70             );
71             return $parser;
72             }
73              
74             1;
75              
76             =pod
77              
78             =head1 NAME
79              
80             SOAP::WSDL::Expat::Message2Hash - Convert SOAP messages to perl hash refs
81              
82             =head1 SYNOPSIS
83              
84             my $parser = SOAP::WSDL::Expat::MessageParser->new({
85             class_resolver => 'My::Resolver'
86             });
87             $parser->parse( $xml );
88             my $obj = $parser->get_data();
89              
90             =head1 DESCRIPTION
91              
92             Real fast expat based SOAP message parser.
93              
94             See L for details.
95              
96             =head1 Bugs and Limitations
97              
98             =over
99              
100             =item * Ignores all namespaces
101              
102             =item * Ignores all attributes
103              
104             =item * Does not handle mixed content
105              
106             =item * The SOAP header is ignored
107              
108             =back
109              
110             =head1 AUTHOR
111              
112             Replace the whitespace by @ for E-Mail Address.
113              
114             Martin Kutter Emartin.kutter fen-net.deE
115              
116             =head1 LICENSE AND COPYRIGHT
117              
118             Copyright 2004-2007 Martin Kutter.
119              
120             This file is part of SOAP-WSDL. You may distribute/modify it under
121             the same terms as perl itself
122              
123             =head1 Repository information
124              
125             $Id: $
126              
127             $LastChangedDate: 2007-09-10 18:19:23 +0200 (Mo, 10 Sep 2007) $
128             $LastChangedRevision: 218 $
129             $LastChangedBy: kutterma $
130              
131             $HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Expat/MessageParser.pm $
132