| 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; |