"Fossies" - the Fresh Open Source Software Archive

Member "install-tl-20200916/tlpkg/tlperl/site/lib/Net/HTTP/NB.pm" (7 Mar 2020, 2521 Bytes) of package /windows/misc/install-tl.zip:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

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