home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _624f65b5d1eba7b2324dae3c35b48cdd < prev    next >
Encoding:
Text File  |  2004-06-01  |  1.6 KB  |  72 lines
  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;
  72.