67 |
sub set_source ($%) { |
sub set_source ($%) { |
68 |
my $self = shift; |
my $self = shift; |
69 |
my %option = @_; |
my %option = @_; |
70 |
|
($self->{source}, $self->{meta_info}) = $self->_get_resource (%option); |
71 |
|
$self->default_parameter (base_uri => $option{uri}) if $option{uri}; |
72 |
|
## BUG: Doesn't support redirection |
73 |
|
if ($option{uri} || $option{file}) { |
74 |
|
my $c = $self->{hook_code_conversion} || \&_code_conversion; |
75 |
|
$self->{source} = &$c ($self, $self->{source}, \%option, $self->{meta_info}); |
76 |
|
} |
77 |
|
$self->{source} =~ s/\x0D(?!\x0A)/\x0D\x0A/g; |
78 |
|
$self->{source} =~ s/(?<!\x0D)\x0A/\x0D\x0A/g; |
79 |
|
$self; |
80 |
|
} |
81 |
|
|
82 |
|
sub _get_resource ($%) { |
83 |
|
my $self = shift; |
84 |
|
my %option = @_; |
85 |
|
my ($resource, $meta); |
86 |
if (defined $option{value}) { |
if (defined $option{value}) { |
87 |
$self->{source} = $option{value}; |
$resource = $option{value}; |
88 |
} elsif ($option{uri}) { |
} elsif ($option{uri}) { |
89 |
require Message::Field::UA; |
require Message::Field::UA; |
90 |
require LWP::UserAgent; |
require LWP::UserAgent; |
95 |
$lwp->agent ($ua->stringify); |
$lwp->agent ($ua->stringify); |
96 |
my $req = HTTP::Request->new (GET => $option{uri}); |
my $req = HTTP::Request->new (GET => $option{uri}); |
97 |
my $res = $lwp->request ($req); |
my $res = $lwp->request ($req); |
98 |
my $c = $self->{hook_code_conversion} || \&_code_conversion; |
$resource = $res->content; |
99 |
$self->{source} = &$c ($self, $res->content, \%option); |
$meta = parse Message::Header $res->headers_as_string, |
100 |
$self->default_parameter (base_uri => $option{uri}); |
-parse_all => 0, -format => 'http-response', |
101 |
|
; |
102 |
} elsif ($option{file}) { |
} elsif ($option{file}) { |
103 |
my $f = new FileHandle $option{file} => 'r'; |
my $f = new FileHandle $option{file} => 'r'; |
104 |
Carp::croak "set_source: $option{file}: $!" unless defined $f; |
Carp::croak "set_source: $option{file}: $!" unless defined $f; |
105 |
my $c = $self->{hook_code_conversion} || \&_code_conversion; |
my $c = $self->{hook_code_conversion} || \&_code_conversion; |
106 |
local $/ = undef; |
local $/ = undef; |
107 |
$self->{source} = &$c ($self, $f->getline, \%option); |
$resource = $f->getline; |
108 |
} else { |
} else { |
109 |
Carp::croak "set_source: $_[0]: Unsupported data source type"; |
Carp::croak "_get_resource: $_[0]: Unsupported data source type"; |
110 |
} |
} |
111 |
$self->{source} =~ s/\x0D(?!\x0A)/\x0D\x0A/g; |
($resource, $meta); |
|
$self->{source} =~ s/(?<!\x0D)\x0A/\x0D\x0A/g; |
|
|
$self; |
|
112 |
} |
} |
113 |
|
|
114 |
## $self->_code_conversion ($string, \%option) |
## $self->_code_conversion ($string, \%option, $meta_info) |
115 |
sub _code_conversion ($$\%) { |
sub _code_conversion ($$\%$) { |
116 |
$_[1]; |
$_[1]; |
117 |
} |
} |
118 |
|
|
255 |
$self; |
$self; |
256 |
} |
} |
257 |
|
|
258 |
|
=head1 $meta = $b->meta_information |
259 |
|
|
260 |
|
Gets meta information from resource requesting protocol. |
261 |
|
Usually returned value is Message::Header object. |
262 |
|
When resource is getten via HTTP, its content is HTTP response |
263 |
|
header. |
264 |
|
|
265 |
|
=cut |
266 |
|
|
267 |
|
sub meta_information ($) { |
268 |
|
my $self = shift; |
269 |
|
$self->{meta_info}; |
270 |
|
} |
271 |
|
|
272 |
=head1 LICENSE |
=head1 LICENSE |
273 |
|
|
274 |
Copyright 2002 wakaba E<lt>w@suika.fam.cxE<gt>. |
Copyright 2002 wakaba E<lt>w@suika.fam.cxE<gt>. |