At 30 Aug 2001 09:04:05 -0700,
Gisle Aas wrote:
> > > Agree. If you could redo your patch relative to perl5.5.53_96 that
> > > would be great.
> > What version of Perl do you mean? I cannot find such version at
> Did I actually write that? Must have been very tired.
>
> What I want is a patch against libwww-perl-5.53_96.
I see. Here it is. This patch passed 'make test.'
--
Keiichiro Nagano
--- cut --- cut --- cut --- cut --- cut --- cut --- cut --- cut ---
*** LWP/UserAgent.pm.ORIGINAL Tue Aug 28 14:38:32 2001
--- LWP/UserAgent.pm Fri Aug 31 23:18:25 2001
***************
*** 257,266 ****
=cut
! sub simple_request
! {
! my($self, $request, $arg, $size) = @_;
!
# some sanity checking
if (defined $request) {
if (ref $request) {
--- 257,265 ----
=cut
! # private method. check sanity of given $request
! sub _request_sanity_check {
! my($self, $request) = @_;
# some sanity checking
if (defined $request) {
if (ref $request) {
***************
*** 275,280 ****
--- 274,333 ----
else {
Carp::croak("No request object passed in");
}
+ }
+
+ sub simple_request
+ {
+ my($self, $request, $arg, $size) = @_;
+ $self->_request_sanity_check($request);
+ my $new_request = $self->prepare_request($request);
+ return($self->send_request($new_request, $arg, $size));
+ }
+
+
+ =item $ua->prepare_request($request)
+
+ This method modifies given C<HTTP::Request> object for
+ C<send_request>. Used in C<simple_request>. This helps those who
+ want to see the whole content of the request before actual requesting.
+
+ =cut
+
+ sub prepare_request
+ {
+ my($self, $request) = @_;
+ $self->_request_sanity_check($request);
+
+ # Extract fields that will be used below
+ my ($agent, $from, $cookie_jar, $max_size) =
+ @{$self}{qw(agent from cookie_jar max_size)};
+
+ # Set User-Agent and From headers if they are defined
+ $request->init_header('User-Agent' => $agent) if $agent;
+ $request->init_header('From' => $from) if $from;
+ if (defined $max_size) {
+ my $last = $max_size - 1;
+ $last = 0 if $last < 0; # there is no way to actually request no content
+ $request->init_header('Range' => "bytes=0-$last");
+ }
+ $cookie_jar->add_cookie_header($request) if $cookie_jar;
+
+ return($request);
+ }
+
+
+ =item $ua->send_request($request, $arg [, $size])
+
+ This method processes given <$request> with no modification (but
+ checks errors). This helps those who wants to send his/her
+ C<HTTP::Request> object untouched. Also frienldy for inheritance.
+
+ =cut
+
+ sub send_request
+ {
+ my($self, $request, $arg, $size) = @_;
+ $self->_request_sanity_check($request);
my($method, $url) = ($request->method, $request->uri);
***************
*** 325,352 ****
# else fall thru and create the protocol object normally
}
-
unless($protocol) {
$protocol = eval { LWP::Protocol::create($scheme, $self) };
if ($@) {
$@ =~ s/ at .* line \d+.*//s; # remove file/line number
return HTTP::Response->new(&HTTP::Status::RC_NOT_IMPLEMENTED, $@);
}
}
# Extract fields that will be used below
! my ($agent, $from, $timeout, $cookie_jar, $use_eval, $max_size) =
! @{$self}{qw(agent from timeout cookie_jar use_eval max_size)};
!
! # Set User-Agent and From headers if they are defined
! $request->init_header('User-Agent' => $agent) if $agent;
! $request->init_header('From' => $from) if $from;
! if (defined $max_size) {
! my $last = $max_size - 1;
! $last = 0 if $last < 0; # there is no way to actually request no content
! $request->init_header('Range' => "bytes=0-$last");
! }
! $cookie_jar->add_cookie_header($request) if $cookie_jar;
my $response;
if ($use_eval) {
--- 378,395 ----
# else fall thru and create the protocol object normally
}
unless($protocol) {
$protocol = eval { LWP::Protocol::create($scheme, $self) };
if ($@) {
$@ =~ s/ at .* line \d+.*//s; # remove file/line number
+
return HTTP::Response->new(&HTTP::Status::RC_NOT_IMPLEMENTED, $@);
}
}
# Extract fields that will be used below
! my ($timeout, $cookie_jar, $use_eval, $parse_head, $max_size) =
! @{$self}{qw(timeout cookie_jar use_eval parse_head max_size)};
my $response;
if ($use_eval) {
