1package SOAP::WSDL::Expat::Base;
2use strict;
3use warnings;
4use URI;
5use XML::Parser::Expat;
6
7# TODO: convert to Class::Std::Fast based class - hash based classes suck.
8
9our $VERSION = 3.004;
10
11sub new {
12    my ($class, $arg_ref) = @_;
13    my $self = {
14        data => undef,
15    };
16    bless $self, $class;
17
18    $self->set_user_agent($arg_ref->{ user_agent })
19        if $arg_ref->{ user_agent };
20    $self->{ parsed } = $arg_ref->{ parsed } if $arg_ref->{ parsed };
21
22    return $self;
23}
24
25sub clone {
26    my $self = shift;
27    my $class = ref $self;
28    my $clone = $class->new($self);
29    return $clone;
30}
31
32sub set_uri { $_[0]->{ uri } = $_[1]; }
33sub get_uri { return $_[0]->{ uri }; }
34
35sub set_user_agent { $_[0]->{ user_agent } = $_[1]; }
36sub get_user_agent { return $_[0]->{ user_agent }; }
37
38# Mark a URI as "already parsed"
39sub set_parsed {
40    my ($self, $uri) = @_;
41    $self->{ parsed }->{ $uri } = 1;
42    return;
43}
44
45
46# returns true if a specific URI has already been parsed
47sub is_parsed {
48    my ($self, $uri) = @_;
49    return exists $self->{ parsed }->{ $uri };
50}
51
52
53# parse a URI. This is the preferred parsing method for WSDL files, as it's
54# the only one allowing automatic import resolution
55sub parse_uri {
56    my $self = shift;
57    my $uri = shift;
58
59    if ($self->is_parsed($uri)){
60        warn "$uri already imported; ignoring it.\n";
61        return;
62    }
63    $self->set_parsed($uri);
64
65    $self->set_uri( $uri );
66
67    if (not $self->{ user_agent }) {
68        require LWP::UserAgent;
69        $self->{ user_agent } = LWP::UserAgent->new();
70    }
71
72    my $response = $self->{ user_agent }->get($uri);
73    die $response->message() if $response->code() ne '200';
74    return $self->parse( $response->content() );
75}
76
77sub parse {
78    eval {
79        $_[0]->_initialize( XML::Parser::Expat->new( Namespaces => 1 )  )->parse( $_[1] );
80        $_[0]->{ parser }->release();
81    };
82    $_[0]->{ parser }->xpcroak( $@ ) if $@;
83    delete $_[0]->{ parser };
84    return $_[0]->{ data };
85}
86
87sub parsefile {
88    eval {
89        $_[0]->_initialize( XML::Parser::Expat->new(Namespaces => 1) )->parsefile( $_[1] );
90        $_[0]->{ parser }->release();
91    };
92    $_[0]->{ parser }->xpcroak( $@ ) if $@;
93    delete $_[0]->{ parser };
94    return $_[0]->{ data };
95}
96
97# SAX-like aliases
98sub parse_string;
99*parse_string = \&parse;
100
101sub parse_file;
102*parse_file = \&parsefile;
103
104sub get_data {
105    return $_[0]->{ data };
106}
107
1081;
109
110=pod
111
112=head1 NAME
113
114SOAP::WSDL::Expat::Base - Base class for XML::Parser::Expat based XML parsers
115
116=head1 DESCRIPTION
117
118Base class for XML::Parser::Expat based XML parsers. All XML::SAX::Expat based
119parsers in SOAP::WSDL inherit from this class.
120
121=head1 AUTHOR
122
123Replace the whitespace by @ for E-Mail Address.
124
125 Martin Kutter E<lt>martin.kutter fen-net.deE<gt>
126
127=head1 LICENSE AND COPYRIGHT
128
129Copyright 2004-2007 Martin Kutter.
130
131This file is part of SOAP-WSDL. You may distribute/modify it under
132the same terms as perl itself
133
134=head1 Repository information
135
136 $Id: $
137
138 $LastChangedDate: 2007-09-10 18:19:23 +0200 (Mo, 10 Sep 2007) $
139 $LastChangedRevision: 218 $
140 $LastChangedBy: kutterma $
141
142 $HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Expat/MessageParser.pm $
143