SWALTERS / SOAP-WSDL-3.004 / lib / SOAP / WSDL / Expat / Base.pm 

            

              
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
133
134
135
136
137
138
139
140
141
142

              
package SOAP::WSDL::Expat::Base;
use strict;
use warnings;
use URI;
use XML::Parser::Expat;
# TODO: convert to Class::Std::Fast based class - hash based classes suck.
our $VERSION = 3.004;
sub new {
    my ($class, $arg_ref) = @_;
    my $self = {
        data => undef,
    };
    bless $self, $class;
    $self->set_user_agent($arg_ref->{ user_agent })
        if $arg_ref->{ user_agent };
    $self->{ parsed } = $arg_ref->{ parsed } if $arg_ref->{ parsed };
    return $self;
}
sub clone {
    my $self = shift;
    my $class = ref $self;
    my $clone = $class->new($self);
    return $clone;
}
sub set_uri { $_[0]->{ uri } = $_[1]; }
sub get_uri { return $_[0]->{ uri }; }
sub set_user_agent { $_[0]->{ user_agent } = $_[1]; }
sub get_user_agent { return $_[0]->{ user_agent }; }
# Mark a URI as "already parsed"
sub set_parsed {
    my ($self, $uri) = @_;
    $self->{ parsed }->{ $uri } = 1;
    return;
}
# returns true if a specific URI has already been parsed
sub is_parsed {
    my ($self, $uri) = @_;
    return exists $self->{ parsed }->{ $uri };
}
# parse a URI. This is the preferred parsing method for WSDL files, as it's
# the only one allowing automatic import resolution
sub parse_uri {
    my $self = shift;
    my $uri = shift;
    if ($self->is_parsed($uri)){
        warn "$uri already imported; ignoring it.\n";
        return;
    }
    $self->set_parsed($uri);
    $self->set_uri( $uri );
    if (not $self->{ user_agent }) {
        require LWP::UserAgent;
        $self->{ user_agent } = LWP::UserAgent->new();
    }
    my $response = $self->{ user_agent }->get($uri);
    die $response->message() if $response->code() ne '200';
    return $self->parse( $response->content() );
}
sub parse {
    eval {
        $_[0]->_initialize( XML::Parser::Expat->new( Namespaces => 1 )  )->parse( $_[1] );
        $_[0]->{ parser }->release();
    };
    $_[0]->{ parser }->xpcroak( $@ ) if $@;
    delete $_[0]->{ parser };
    return $_[0]->{ data };
}
sub parsefile {
    eval {
        $_[0]->_initialize( XML::Parser::Expat->new(Namespaces => 1) )->parsefile( $_[1] );
        $_[0]->{ parser }->release();
    };
    $_[0]->{ parser }->xpcroak( $@ ) if $@;
    delete $_[0]->{ parser };
    return $_[0]->{ data };
}
# SAX-like aliases
sub parse_string;
*parse_string = \&parse;
sub parse_file;
*parse_file = \&parsefile;
sub get_data {
    return $_[0]->{ data };
}
1;
=pod
=head1 NAME
SOAP::WSDL::Expat::Base - Base class for XML::Parser::Expat based XML parsers
=head1 DESCRIPTION
Base class for XML::Parser::Expat based XML parsers. All XML::SAX::Expat based
parsers in SOAP::WSDL inherit from this class.
=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 $