176
|
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;
|