Commits

Toby Inkster  committed 6aa7d88

Merging async development into distribution

  • Participants
  • Parent commits eda61b1

Comments (0)

Files changed (5)

File devel.examples/assert-async.pl

-use 5.010;
-use AnyEvent;
-use Data::Dumper;
-use Web::Magic::Async;
-
-warn "A do_request";
-my $a = Web::Magic::Async
-	->new(GET => 'http://localhost/')
-	->assert_success
-	->do_request;
-
-warn "B do_request";
-my $b = Web::Magic::Async
-	->new(GET => 'http://localhost/dfgsdgdf')
-	->assert_success
-	->do_request;
-
-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

-package Web::Magic::Async;
-
-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) = @_;
-
-	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_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(@_); 1 },
-			on_body   => sub { $self->__body_callback(@_); 1 },
-			sub { $self->__final_callback(@_); 1 };
-	}
-	
-	$self;
-}
-
-sub __header_callback
-{
-	my ($self, $headers) = @_;
-	my %h_clone = %$headers;
-	
-	$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->_async->{got_head}->send;
-	$self;
-}
-
-sub __body_callback
-{
-	my ($self, $body) = @_;
-
-	$self->_async->{partial_body} .= $body;
-	
-	$self;
-}
-
-sub __final_callback
-{
-	my ($self, $body, $hash) = @_;
-	
-	$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;
-	}
-	
-	$self->_async->{got_body}->send;
-	$self;
-}
-
-sub response
-{
-	my ($self, %extra_headers) = @_;
-	
-	return $self->_stash->{response}
-		if $self->_stash->{response};
-	
-	$self->do_request(%extra_headers)
-		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 $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
-{
-	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 AnyEvent;
+use Data::Dumper;
+use Web::Magic::Async;
+
+warn "A do_request";
+my $a = Web::Magic::Async
+	->new(GET => 'http://localhost/')
+	->assert_success
+	->do_request;
+
+warn "B do_request";
+my $b = Web::Magic::Async
+	->new(GET => 'http://localhost/dfgsdgdf')
+	->assert_success
+	->do_request;
+
+warn sprintf("A is %d length", length $a->content);
+warn sprintf("B is %d length", length $b->content);

File lib/Web/Magic.pm

 	my ($self, %extra_headers) = @_;
 	
 	my $req = $self->_request_object;
-#	return $req if $self->is_requested;
+	return $req if $self->is_requested;
 
 	if (%extra_headers)
 	{

File lib/Web/Magic/Async.pm

+package Web::Magic::Async;
+
+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) = @_;
+
+	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_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(@_); 1 },
+			on_body   => sub { $self->__body_callback(@_); 1 },
+			sub { $self->__final_callback(@_); 1 };
+	}
+	
+	$self;
+}
+
+sub __header_callback
+{
+	my ($self, $headers) = @_;
+	my %h_clone = %$headers;
+	
+	$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->_async->{got_head}->send;
+	$self;
+}
+
+sub __body_callback
+{
+	my ($self, $body) = @_;
+
+	$self->_async->{partial_body} .= $body;
+	
+	$self;
+}
+
+sub __final_callback
+{
+	my ($self, $body, $hash) = @_;
+	
+	$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;
+	}
+	
+	$self->_async->{got_body}->send;
+	$self;
+}
+
+sub response
+{
+	my ($self, %extra_headers) = @_;
+	
+	return $self->_stash->{response}
+		if $self->_stash->{response};
+	
+	$self->do_request(%extra_headers)
+		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 $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
+{
+	my ($self) = @_;
+	
+	if ($self->is_in_progress)
+	{
+		$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;
+