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