local-lib5/lib/perl5/XML/SAX/PurePerl/Reader/URI.pm

   1 # $Id: URI.pm,v 1.1 2001-11-11 18:41:51 matt Exp $
   2
   3 package XML::SAX::PurePerl::Reader::URI;
   4
   5 use strict;
   6
   7 use XML::SAX::PurePerl::Reader;
   8 use File::Temp qw(tempfile);
   9 use Symbol;
  10
  11 ## NOTE: This is *not* a subclass of Reader. It just returns Stream or String
  12 ## Reader objects depending on what it's capabilities are.
  13
  14 sub new {
  15     my $class = shift;
  16     my $uri = shift;
  17     # request the URI
  18     if (-e $uri && -f _) {
  19         my $fh = gensym;
  20         open($fh, $uri) || die "Cannot open file $uri : $!";
  21         return XML::SAX::PurePerl::Reader::Stream->new($fh);
  22     }
  23     elsif ($uri =~ /^file:(.*)$/ && -e $1 && -f _) {
  24         my $file = $1;
  25         my $fh = gensym;
  26         open($fh, $file) || die "Cannot open file $file : $!";
  27         return XML::SAX::PurePerl::Reader::Stream->new($fh);
  28     }
  29     else {
  30         # request URI, return String reader
  31         require LWP::UserAgent;
  32         my $ua = LWP::UserAgent->new;
  33         $ua->agent("Perl/XML/SAX/PurePerl/1.0 " . $ua->agent);
  34
  35         my $req = HTTP::Request->new(GET => $uri);
  36
  37         my $fh = tempfile();
  38
  39         my $callback = sub {
  40             my ($data, $response, $protocol) = @_;
  41             print $fh $data;
  42         };
  43
  44         my $res = $ua->request($req, $callback, 4096);
  45
  46         if ($res->is_success) {
  47             seek($fh, 0, 0);
  48             return XML::SAX::PurePerl::Reader::Stream->new($fh);
  49         }
  50         else {
  51             die "LWP Request Failed";
  52         }
  53     }
  54 }
  55
  56
  57 1;