Commit | Line | Data |
3fea05b9 |
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; |