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
9package XML::Parser;
10
11use URI;
12use URI::file;
13use 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
21sub 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
65sub lwp_ext_ent_cleanup {
66  my ($xp) = @_;
67
68  $xp->base(pop(@{$xp->{_BaseStack}}));
69}  # End lwp_ext_ent_cleanup
70
711;
72