1 | package Net::HTTP::NB;
|
---|
2 |
|
---|
3 | use strict;
|
---|
4 | use vars qw($VERSION @ISA);
|
---|
5 |
|
---|
6 | $VERSION = "5.810";
|
---|
7 |
|
---|
8 | require Net::HTTP;
|
---|
9 | @ISA=qw(Net::HTTP);
|
---|
10 |
|
---|
11 | sub sysread {
|
---|
12 | my $self = $_[0];
|
---|
13 | if (${*$self}{'httpnb_read_count'}++) {
|
---|
14 | ${*$self}{'http_buf'} = ${*$self}{'httpnb_save'};
|
---|
15 | die "Multi-read\n";
|
---|
16 | }
|
---|
17 | my $buf;
|
---|
18 | my $offset = $_[3] || 0;
|
---|
19 | my $n = sysread($self, $_[1], $_[2], $offset);
|
---|
20 | ${*$self}{'httpnb_save'} .= substr($_[1], $offset);
|
---|
21 | return $n;
|
---|
22 | }
|
---|
23 |
|
---|
24 | sub read_response_headers {
|
---|
25 | my $self = shift;
|
---|
26 | ${*$self}{'httpnb_read_count'} = 0;
|
---|
27 | ${*$self}{'httpnb_save'} = ${*$self}{'http_buf'};
|
---|
28 | my @h = eval { $self->SUPER::read_response_headers(@_) };
|
---|
29 | if ($@) {
|
---|
30 | return if $@ eq "Multi-read\n";
|
---|
31 | die;
|
---|
32 | }
|
---|
33 | return @h;
|
---|
34 | }
|
---|
35 |
|
---|
36 | sub read_entity_body {
|
---|
37 | my $self = shift;
|
---|
38 | ${*$self}{'httpnb_read_count'} = 0;
|
---|
39 | ${*$self}{'httpnb_save'} = ${*$self}{'http_buf'};
|
---|
40 | # XXX I'm not so sure this does the correct thing in case of
|
---|
41 | # transfer-encoding tranforms
|
---|
42 | my $n = eval { $self->SUPER::read_entity_body(@_); };
|
---|
43 | if ($@) {
|
---|
44 | $_[0] = "";
|
---|
45 | return -1;
|
---|
46 | }
|
---|
47 | return $n;
|
---|
48 | }
|
---|
49 |
|
---|
50 | 1;
|
---|
51 |
|
---|
52 | __END__
|
---|
53 |
|
---|
54 | =head1 NAME
|
---|
55 |
|
---|
56 | Net::HTTP::NB - Non-blocking HTTP client
|
---|
57 |
|
---|
58 | =head1 SYNOPSIS
|
---|
59 |
|
---|
60 | use Net::HTTP::NB;
|
---|
61 | my $s = Net::HTTP::NB->new(Host => "www.perl.com") || die $@;
|
---|
62 | $s->write_request(GET => "/");
|
---|
63 |
|
---|
64 | use IO::Select;
|
---|
65 | my $sel = IO::Select->new($s);
|
---|
66 |
|
---|
67 | READ_HEADER: {
|
---|
68 | die "Header timeout" unless $sel->can_read(10);
|
---|
69 | my($code, $mess, %h) = $s->read_response_headers;
|
---|
70 | redo READ_HEADER unless $code;
|
---|
71 | }
|
---|
72 |
|
---|
73 | while (1) {
|
---|
74 | die "Body timeout" unless $sel->can_read(10);
|
---|
75 | my $buf;
|
---|
76 | my $n = $s->read_entity_body($buf, 1024);
|
---|
77 | last unless $n;
|
---|
78 | print $buf;
|
---|
79 | }
|
---|
80 |
|
---|
81 | =head1 DESCRIPTION
|
---|
82 |
|
---|
83 | Same interface as C<Net::HTTP> but it will never try multiple reads
|
---|
84 | when the read_response_headers() or read_entity_body() methods are
|
---|
85 | invoked. This make it possible to multiplex multiple Net::HTTP::NB
|
---|
86 | using select without risk blocking.
|
---|
87 |
|
---|
88 | If read_response_headers() did not see enough data to complete the
|
---|
89 | headers an empty list is returned.
|
---|
90 |
|
---|
91 | If read_entity_body() did not see new entity data in its read
|
---|
92 | the value -1 is returned.
|
---|
93 |
|
---|
94 | =head1 SEE ALSO
|
---|
95 |
|
---|
96 | L<Net::HTTP>
|
---|
97 |
|
---|
98 | =head1 COPYRIGHT
|
---|
99 |
|
---|
100 | Copyright 2001 Gisle Aas.
|
---|
101 |
|
---|
102 | This library is free software; you can redistribute it and/or
|
---|
103 | modify it under the same terms as Perl itself.
|
---|
104 |
|
---|
105 | =cut
|
---|