Commits

Toby Inkster committed 4f27e40

Move async stuff into experimental directories.

  • Participants
  • Parent commits 0e61600

Comments (0)

Files changed (4)

File devel.examples/assert-async.pl

+use 5.010;
+#use Coro;
+use AnyEvent;
+#use Coro::AnyEvent;
+use Web::Magic::Async;
+
+my $w; $w = AE::timer 0, 1, sub { say "timer event" };
+
+my $a = Web::Magic::Async
+	->new(GET => 'http://www.google.co.uk/')
+	->assert_response(success => sub {$_->is_success})
+	->do_request;
+
+my $b = Web::Magic::Async
+	->new(GET => 'http://www.google.co.uk/adgawertgwretgwrtgw')
+	->assert_response(success => sub {$_->is_success})
+	->do_request;
+
+warn length($a->content);
+warn length($b->content);

File devel.lib/Web/Magic/Async.pm

+package Web::Magic::Async;
+
+use base 'Web::Magic';
+use AnyEvent::HTTP;
+use Carp qw/croak confess/;
+use Object::Stash qw/_async/;
+use Scalar::Util qw/blessed/;
+
+sub do_request
+{
+	my ($self, %extra_headers) = @_;
+
+	if ($self->is_cancelled)
+	{
+		croak "Need to perform HTTP request, but it is cancelled.";
+	}
+	
+	unless (exists $self->_async->{got_body})
+	{
+		my $req = $self->_final_request_object(
+			User_Agent => $self->_ua_string,
+			%extra_headers,
+			);
+		
+		$self->_async(
+			got_body         => AnyEvent->condvar,
+			partial_body     => '',
+			);
+		$self->_async->{got_body}->begin;
+		
+		http_request $req->method, $req->uri,
+			headers => { map { (lc $_, $req->header($_)) } $req->header_field_names },
+			body    => $req->content,
+			on_header => sub { $self->__header_callback(@_) },
+			on_body   => sub { $self->__body_callback(@_) },
+			sub { $self->__final_callback(@_); $self->_async->{got_body}->end; 1 };
+	}
+	
+	$self;
+}
+
+sub __header_callback
+{
+	my ($self, $headers) = @_;
+	my %h_clone = %$headers;
+	
+	warn $$self." -> __header_callback";
+	
+	$self->_async(
+		status      => delete $h_clone{Status},
+		reason      => delete $h_clone{Reason},
+		httpversion => delete $h_clone{HTTPVersion},
+		);
+	
+	$self->_async(
+		headers  => HTTP::Headers->new(%h_clone),
+		);
+	
+	$self;
+}
+
+sub __body_callback
+{
+	my ($self, $body) = @_;
+
+	warn $$self." -> __body_callback";
+
+	$self->_async->{partial_body} .= $body;
+	
+	$self;
+}
+
+sub __final_callback
+{
+	my ($self, $body, $hash) = @_;
+	
+	warn $$self." -> __final_callback";
+	
+	$self->_stash->{response} = HTTP::Response->new(
+		(delete $self->_async->{status}),
+		(delete $self->_async->{reason}),
+		(delete $self->_async->{headers}),
+		(delete $self->_async->{partial_body}).$body
+		);
+	
+	# TODO: Check assertions!
+
+	$self;
+}
+
+sub response
+{
+	my ($self, %extra_headers) = @_;
+	
+	return $self->_stash->{response}
+		if $self->_stash->{response};
+		
+	$self->do_request(%extra_headers)
+		unless exists $self->_async->{got_body};
+	
+	$self->_async->{got_body}->recv
+		unless $self->_stash->{response};
+	
+	$self->_stash->{response};
+}
+
+#sub headers
+#{
+#	my ($self) = @_;
+#
+#	return $self->_stash->{response}->headers
+#		if $self->_stash->{response};
+#
+#	$self->do_request
+#		unless exists $self->_async->{got_head};
+#		
+#	$self->_async->{got_head}->recv
+#		unless $self->_async->{headers};
+#	
+#	$self->_async->{headers};
+#}
+
+sub is_requested
+{
+	my ($self) = @_;
+	
+	if (exists $self->_async->{got_body})
+	{
+		$self->_async->{got_body}->recv;
+	}
+	
+	my $stash = $self->_stash;
+	if (exists $stash->{response})
+	{
+		return $stash->{response};
+	}
+	
+	return;
+}
+	
+sub is_in_progress
+{
+	my ($self) = @_;
+	my $stash  = $self->_async;
+	return (exists $stash->{got_body} && !$stash->{got_body}->ready);
+}
+
+1;
+

File examples/assert-async.pl

-use 5.010;
-#use Coro;
-use AnyEvent;
-#use Coro::AnyEvent;
-use Web::Magic::Async;
-
-my $w; $w = AE::timer 0, 1, sub { say "timer event" };
-
-my $a = Web::Magic::Async
-	->new(GET => 'http://www.google.co.uk/')
-	->assert_response(success => sub {$_->is_success})
-	->do_request;
-
-my $b = Web::Magic::Async
-	->new(GET => 'http://www.google.co.uk/adgawertgwretgwrtgw')
-	->assert_response(success => sub {$_->is_success})
-	->do_request;
-
-warn length($a->content);
-warn length($b->content);

File lib/Web/Magic/Async.pm

-package Web::Magic::Async;
-
-use base 'Web::Magic';
-use AnyEvent::HTTP;
-use Carp qw/croak confess/;
-use Object::Stash qw/_async/;
-use Scalar::Util qw/blessed/;
-
-sub do_request
-{
-	my ($self, %extra_headers) = @_;
-
-	if ($self->is_cancelled)
-	{
-		croak "Need to perform HTTP request, but it is cancelled.";
-	}
-	
-	unless (exists $self->_async->{got_body})
-	{
-		my $req = $self->_final_request_object(
-			User_Agent => $self->_ua_string,
-			%extra_headers,
-			);
-		
-		$self->_async(
-			got_body         => AnyEvent->condvar,
-			partial_body     => '',
-			);
-		$self->_async->{got_body}->begin;
-		
-		http_request $req->method, $req->uri,
-			headers => { map { (lc $_, $req->header($_)) } $req->header_field_names },
-			body    => $req->content,
-			on_header => sub { $self->__header_callback(@_) },
-			on_body   => sub { $self->__body_callback(@_) },
-			sub { $self->__final_callback(@_); $self->_async->{got_body}->end; 1 };
-	}
-	
-	$self;
-}
-
-sub __header_callback
-{
-	my ($self, $headers) = @_;
-	my %h_clone = %$headers;
-	
-	warn $$self." -> __header_callback";
-	
-	$self->_async(
-		status      => delete $h_clone{Status},
-		reason      => delete $h_clone{Reason},
-		httpversion => delete $h_clone{HTTPVersion},
-		);
-	
-	$self->_async(
-		headers  => HTTP::Headers->new(%h_clone),
-		);
-	
-	$self;
-}
-
-sub __body_callback
-{
-	my ($self, $body) = @_;
-
-	warn $$self." -> __body_callback";
-
-	$self->_async->{partial_body} .= $body;
-	
-	$self;
-}
-
-sub __final_callback
-{
-	my ($self, $body, $hash) = @_;
-	
-	warn $$self." -> __final_callback";
-	
-	$self->_stash->{response} = HTTP::Response->new(
-		(delete $self->_async->{status}),
-		(delete $self->_async->{reason}),
-		(delete $self->_async->{headers}),
-		(delete $self->_async->{partial_body}).$body
-		);
-	
-	# TODO: Check assertions!
-
-	$self;
-}
-
-sub response
-{
-	my ($self, %extra_headers) = @_;
-	
-	return $self->_stash->{response}
-		if $self->_stash->{response};
-		
-	$self->do_request(%extra_headers)
-		unless exists $self->_async->{got_body};
-	
-	$self->_async->{got_body}->recv
-		unless $self->_stash->{response};
-	
-	$self->_stash->{response};
-}
-
-#sub headers
-#{
-#	my ($self) = @_;
-#
-#	return $self->_stash->{response}->headers
-#		if $self->_stash->{response};
-#
-#	$self->do_request
-#		unless exists $self->_async->{got_head};
-#		
-#	$self->_async->{got_head}->recv
-#		unless $self->_async->{headers};
-#	
-#	$self->_async->{headers};
-#}
-
-sub is_requested
-{
-	my ($self) = @_;
-	
-	if (exists $self->_async->{got_body})
-	{
-		$self->_async->{got_body}->recv;
-	}
-	
-	my $stash = $self->_stash;
-	if (exists $stash->{response})
-	{
-		return $stash->{response};
-	}
-	
-	return;
-}
-	
-sub is_in_progress
-{
-	my ($self) = @_;
-	my $stash  = $self->_async;
-	return (exists $stash->{got_body} && !$stash->{got_body}->ready);
-}
-
-1;
-