1. Toby Inkster
  2. p5-web-magic

Commits

Toby Inkster  committed eda61b1

async stuff finally working

  • Participants
  • Parent commits ec8b378
  • Branches default

Comments (0)

Files changed (3)

File devel.examples/assert-async.pl

View file
  • Ignore whitespace
 use 5.010;
-#use Coro;
 use AnyEvent;
-#use Coro::AnyEvent;
+use Data::Dumper;
 use Web::Magic::Async;
 
-my $w; $w = AE::timer 0, 1, sub { say "timer event" };
-
+warn "A do_request";
 my $a = Web::Magic::Async
-	->new(GET => 'http://www.google.co.uk/')
-	->assert_response(success => sub {$_->is_success})
+	->new(GET => 'http://localhost/')
+	->assert_success
 	->do_request;
 
+warn "B do_request";
 my $b = Web::Magic::Async
-	->new(GET => 'http://www.google.co.uk/adgawertgwretgwrtgw')
-	->assert_response(success => sub {$_->is_success})
+	->new(GET => 'http://localhost/dfgsdgdf')
+	->assert_success
 	->do_request;
 
-warn length($a->content);
-warn length($b->content);
+warn sprintf("A is %d length", length $a->content);
+warn sprintf("B is %d length", length $b->content);

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

View file
  • Ignore whitespace
 package Web::Magic::Async;
 
-use base 'Web::Magic';
+use 5.010;
+use common::sense;
+use namespace::sweep; # namespace::autoclean breaks overloading
+use utf8;
+
+BEGIN {
+	$Web::Magic::Async::AUTHORITY = 'cpan:TOBYINK';
+	$Web::Magic::Async::VERSION   = '0.005';
+}
+
 use AnyEvent::HTTP;
 use Carp qw/croak confess/;
 use Object::Stash qw/_async/;
 use Scalar::Util qw/blessed/;
 
+use base 'Web::Magic';
+
 sub do_request
 {
 	my ($self, %extra_headers) = @_;
 			);
 		
 		$self->_async(
+			got_head         => AnyEvent->condvar,
 			got_body         => AnyEvent->condvar,
 			partial_body     => '',
 			);
+		$self->_async->{got_head}->begin;
 		$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 };
+			on_header => sub { $self->__header_callback(@_); 1 },
+			on_body   => sub { $self->__body_callback(@_); 1 },
+			sub { $self->__final_callback(@_); 1 };
 	}
 	
 	$self;
 	my ($self, $headers) = @_;
 	my %h_clone = %$headers;
 	
-	warn $$self." -> __header_callback";
-	
 	$self->_async(
 		status      => delete $h_clone{Status},
 		reason      => delete $h_clone{Reason},
 		);
 	
 	$self->_async(
-		headers  => HTTP::Headers->new(%h_clone),
+		headers => HTTP::Headers->new(%h_clone),
 		);
 	
+	$self->_async->{got_head}->send;
 	$self;
 }
 
 {
 	my ($self, $body) = @_;
 
-	warn $$self." -> __body_callback";
-
 	$self->_async->{partial_body} .= $body;
 	
 	$self;
 {
 	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
 		);
+
+	local $@ = undef;
+	eval {
+		$self->_check_assertions($self->_stash->{response}, @{ $self->_stash->{assert_response} // [] });
+	};
+	if (my $err = $@)
+	{
+		$err =~ s{at .+? line \d+$}{};
+		$self->_async->{failed_assertion} = $err;
+	}
 	
-	# TODO: Check assertions!
-
+	$self->_async->{got_body}->send;
 	$self;
 }
 
 	
 	return $self->_stash->{response}
 		if $self->_stash->{response};
-		
+	
 	$self->do_request(%extra_headers)
-		unless exists $self->_async->{got_body};
+		unless $self->_async->{got_body};
 	
 	$self->_async->{got_body}->recv
 		unless $self->_stash->{response};
 	
+	croak $self->_async->{failed_assertion}
+		if $self->_async->{failed_assertion};
+	
 	$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 headers
+{
+	my ($self) = @_;
+
+	return $self->_stash->{response}->headers
+		if $self->_stash->{response};
+
+	$self->do_request
+		unless $self->_async->{got_head};
+
+	$self->_async->{got_head}->recv
+		unless $self->_async->{headers};
+
+	croak $self->_async->{failed_assertion}
+		if $self->_async->{failed_assertion};
+
+	$self->_async->{headers};
+}
 
 sub is_requested
 {

File lib/Web/Magic.pm

View file
  • Ignore whitespace
 	foreach my $assertion (@assertions)
 	{
 		my ($name, $code) = @$assertion;
-		$_ = $response;
+		local $_ = $response;
 		croak "Response assertion '$name' failed for '$$self'" unless $code->($self);
 	}