PROXY  WHOIS  RQUOTE  TEXTS  SOFT  FOREX  BBOARD
 Music  Philosophy  Code  Literature  Russian

= ROOT|Technical|Code_Examples|Perl|site_perl|LWP|Protocol.pm =

page 2 of 3



            $response->{default_add_content} = 1;
        }
        elsif (!ref($arg) && length($arg)) {
            open(my $fh, ">", $arg) || die "Can't write to '$arg': $!";
	    binmode($fh);
            push(@{$response->{handlers}{response_data}}, sub {
                print $fh $_[3] || die "Can't write to '$arg': $!";
                1;
            });
            push(@{$response->{handlers}{response_done}}, sub {
                close($fh) || die "Can't write to '$arg': $!";
                undef($fh);
            });
        }
        elsif (ref($arg) eq 'CODE') {
            push(@{$response->{handlers}{response_data}}, sub {
                &$arg($_[3], $_[0], $self);
                1;
            });
        }
        else {
            die "Unexpected collect argument '$arg'";
        }

        $ua->run_handlers("response_header", $response);

        if (delete $response->{default_add_content}) {
            push(@{$response->{handlers}{response_data}}, sub {
                $_[0]->add_content($_[3]);
                1;
            });
        }


        my $content_size = 0;
        my $length = $response->content_length;
        my %skip_h;

        while ($content = &$collector, length $$content) {
            for my $h ($ua->handlers("response_data", $response)) {
                next if $skip_h{$h};
                unless ($h->{callback}->($response, $ua, $h, $$content)) {
                    # XXX remove from $response->{handlers}{response_data} if present
                    $skip_h{$h}++;
                }
            }
            $content_size += length($$content);
            $ua->progress(($length ? ($content_size / $length) : "tick"), $response);
            if (defined($max_size) && $content_size > $max_size) {
                LWP::Debug::debug("Aborting because size limit exceeded");
                $response->push_header("Client-Aborted", "max_size");
                last;
            }
        }
    };
    if ($@) {
        chomp($@);
        $response->push_header('X-Died' => $@);
        $response->push_header("Client-Aborted", "die");
        return $response;
    }

    return $response;
}


sub collect_once
{
    my($self, $arg, $response) = @_;
    my $content = \ $_[3];
    my $first = 1;
    $self->collect($arg, $response, sub {
	return $content if $first--;
	return \ "";
    });
}

1;


__END__

=head1 NAME

LWP::Protocol - Base class for LWP protocols

=head1 SYNOPSIS

 package LWP::Protocol::foo;
 require LWP::Protocol;
 @ISA=qw(LWP::Protocol);

=head1 DESCRIPTION

This class is used a the base class for all protocol implementations
supported by the LWP library.

When creating an instance of this class using
C<LWP::Protocol::create($url)>, and you get an initialised subclass
appropriate for that access method. In other words, the
=2=

1| < PREV = PAGE 2 = NEXT > |3

UP TO ROOT | UP TO DIR | TO FIRST PAGE

Google
 


E-mail Facebook Google Digg del.icio.us BlinkList Fark Furl Ma.gnolia Netscape NewsVine Reddit Slashdot Spurl StumbleUpon Technorati YahooMyWeb LiveJournal Blogmarks TwitThis Live News2.ru BobrDobr.ru Memori.ru MoeMesto.ru

0.00566077 wallclock secs ( 0.00 usr + 0.00 sys = 0.00 CPU)