[31809] | 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;
|
---|