1#!/usr/bin/perl
2package SOAP::WSDL::Expat::Message2Hash;
3use strict;
4use warnings;
5use base qw(SOAP::WSDL::Expat::Base);
6
7our $VERSION = 3.004;
8
9sub _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
741;
75
76=pod
77
78=head1 NAME
79
80SOAP::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
92Real fast expat based SOAP message parser.
93
94See L<SOAP::WSDL::Manual::Parser> 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
112Replace the whitespace by @ for E-Mail Address.
113
114 Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
115
116=head1 LICENSE AND COPYRIGHT
117
118Copyright 2004-2007 Martin Kutter.
119
120This file is part of SOAP-WSDL. You may distribute/modify it under
121the 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
133