1 | # LWPExternEnt.pl
|
---|
2 | #
|
---|
3 | # Copyright (c) 2000 Clark Cooper
|
---|
4 | # All rights reserved.
|
---|
5 | #
|
---|
6 | # This program is free software; you can redistribute it and/or
|
---|
7 | # modify it under the same terms as Perl itself.
|
---|
8 |
|
---|
9 | package XML::Parser;
|
---|
10 |
|
---|
11 | use URI;
|
---|
12 | use URI::file;
|
---|
13 | use LWP;
|
---|
14 |
|
---|
15 | ##
|
---|
16 | ## Note that this external entity handler reads the entire entity into
|
---|
17 | ## memory, so it will choke on huge ones. It would be really nice if
|
---|
18 | ## LWP::UserAgent optionally returned us an IO::Handle.
|
---|
19 | ##
|
---|
20 |
|
---|
21 | sub lwp_ext_ent_handler {
|
---|
22 | my ($xp, $base, $sys) = @_; # We don't use public id
|
---|
23 |
|
---|
24 | my $uri;
|
---|
25 |
|
---|
26 | if (defined $base) {
|
---|
27 | # Base may have been set by parsefile, which is agnostic about
|
---|
28 | # whether its a file or URI.
|
---|
29 | my $base_uri = new URI($base);
|
---|
30 | unless (defined $base_uri->scheme) {
|
---|
31 | $base_uri = URI->new_abs($base_uri, URI::file->cwd);
|
---|
32 | }
|
---|
33 |
|
---|
34 | $uri = URI->new_abs($sys, $base_uri);
|
---|
35 | }
|
---|
36 | else {
|
---|
37 | $uri = new URI($sys);
|
---|
38 | unless (defined $uri->scheme) {
|
---|
39 | $uri = URI->new_abs($uri, URI::file->cwd);
|
---|
40 | }
|
---|
41 | }
|
---|
42 |
|
---|
43 | my $ua = $xp->{_lwpagent};
|
---|
44 | unless (defined $ua) {
|
---|
45 | $ua = $xp->{_lwpagent} = new LWP::UserAgent();
|
---|
46 | $ua->env_proxy();
|
---|
47 | }
|
---|
48 |
|
---|
49 | my $req = new HTTP::Request('GET', $uri);
|
---|
50 |
|
---|
51 | my $res = $ua->request($req);
|
---|
52 | if ($res->is_error) {
|
---|
53 | $xp->{ErrorMessage} .= "\n" . $res->status_line . " $uri";
|
---|
54 | return undef;
|
---|
55 | }
|
---|
56 |
|
---|
57 | $xp->{_BaseStack} ||= [];
|
---|
58 | push(@{$xp->{_BaseStack}}, $base);
|
---|
59 |
|
---|
60 | $xp->base($uri);
|
---|
61 |
|
---|
62 | return $res->content;
|
---|
63 | } # End lwp_ext_ent_handler
|
---|
64 |
|
---|
65 | sub lwp_ext_ent_cleanup {
|
---|
66 | my ($xp) = @_;
|
---|
67 |
|
---|
68 | $xp->base(pop(@{$xp->{_BaseStack}}));
|
---|
69 | } # End lwp_ext_ent_cleanup
|
---|
70 |
|
---|
71 | 1;
|
---|