local-lib5/lib/perl5/i486-linux-gnu-thread-multi/XML/Parser/LWPExternEnt.pl

   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;