t/handle/03_http_req.t

#!/opt/perl/bin/perl

use strict;

use AnyEvent;
BEGIN { require AnyEvent::Impl::Perl unless $ENV{PERL_ANYEVENT_MODEL} }
use AnyEvent::Socket;
use AnyEvent::Handle;

unless ($ENV{PERL_ANYEVENT_NET_TESTS}) {
   print "1..0 # Skip PERL_ANYEVENT_NET_TESTS environment variable not set\n";
   exit 0;
}

print "1..2\n";

my $cv = AnyEvent->condvar;

my $rbytes;

my $hdl; $hdl =
   AnyEvent::Handle->new (
      connect => ['www.google.com', 80],
      on_error => sub {
         warn "handle error: $_[2]";
         $cv->broadcast;
      },
      on_eof => sub {
         my ($hdl) = @_;

         if ($rbytes !~ /<\/html>/i) {
            print "not ";
         }

         print "ok 2 - received HTML page\n";

         $cv->broadcast;
      }
   );

$hdl->push_read (chunk => 10, sub {
   my ($hdl, $data) = @_;

   unless (substr ($data, 0, 4) eq 'HTTP') {
      print "not ";
   }

   print "ok 1 - received 'HTTP'\n";

   $hdl->on_read (sub {
      my ($hdl) = @_;
      $rbytes .= $hdl->rbuf;
      $hdl->rbuf = '';
      return 1;
   });
});

$hdl->push_write ("GET http://www.google.com/ HTTP/1.0\015\012\015\012");

$cv->wait;
Revision:	1.13
Committed:	Thu Apr 5 06:14:10 2012 UTC (12 years, 3 months ago) by root
Content type:	application/x-troff
Branch:	MAIN
CVS Tags:	rel-7_05, rel-7_07, rel-7_01, rel-7_02, rel-7_03, rel-7_08, rel-7_09, rel-7_16, rel-7_13, rel-7_11, rel-7_15, rel-7_14, rel-7_12, rel-7_0, rel-7_04, HEAD
Changes since 1.12:	+1 -1 lines
Log Message:	* empty log message *
#	Content
1	#!/opt/perl/bin/perl
2
3	use strict;
4
5	use AnyEvent;
6	BEGIN { require AnyEvent::Impl::Perl unless $ENV{PERL_ANYEVENT_MODEL} }
7	use AnyEvent::Socket;
8	use AnyEvent::Handle;
9
10	unless ($ENV{PERL_ANYEVENT_NET_TESTS}) {
11	print "1..0 # Skip PERL_ANYEVENT_NET_TESTS environment variable not set\n";
12	exit 0;
13	}
14
15	print "1..2\n";
16
17	my $cv = AnyEvent->condvar;
18
19	my $rbytes;
20
21	my $hdl; $hdl =
22	AnyEvent::Handle->new (
23	connect => ['www.google.com', 80],
24	on_error => sub {
25	warn "handle error: $_[2]";
26	$cv->broadcast;
27	},
28	on_eof => sub {
29	my ($hdl) = @_;
30
31	if ($rbytes !~ /<\/html>/i) {
32	print "not ";
33	}
34
35	print "ok 2 - received HTML page\n";
36
37	$cv->broadcast;
38	}
39	);
40
41	$hdl->push_read (chunk => 10, sub {
42	my ($hdl, $data) = @_;
43
44	unless (substr ($data, 0, 4) eq 'HTTP') {
45	print "not ";
46	}
47
48	print "ok 1 - received 'HTTP'\n";
49
50	$hdl->on_read (sub {
51	my ($hdl) = @_;
52	$rbytes .= $hdl->rbuf;
53	$hdl->rbuf = '';
54	return 1;
55	});
56	});
57
58	$hdl->push_write ("GET http://www.google.com/ HTTP/1.0\015\012\015\012");
59
60	$cv->wait;