package Padre::Task::LWP; =pod =head1 NAME Padre::Task::LWP - Generic HTTP client background processing task =head1 SYNOPSIS # Fire and forget HTTP request Padre::Task::LWP->new( request => HTTP::Request->new( GET => 'http://perlide.org', ), )->schedule; =head1 DESCRIPTION Sending and receiving data via HTTP. =head1 METHODS =cut use 5.008005; use strict; use warnings; use Padre::Constant (); use Params::Util (); use Padre::Task (); our $VERSION = '0.94'; our @ISA = 'Padre::Task'; use Class::XSAccessor { getters => { request => 'request', response => 'response', } }; ###################################################################### # Constructor =pod =head2 new my $task = Padre::Task::LWP->new( method => 'GET', url => 'http://perlide.org', ); The C constructor creates a L for a background HTTP request. It takes a single addition parameter C which is a fully-prepared L object for the request. Returns a new L object, or throws an exception on error. =cut sub new { my $self = shift->SUPER::new( @_, # Temporarily disable the ability to fully specify the request request => undef, response => undef, ); unless ( $self->{url} ) { Carp::croak("Missing or invalid 'request' for Padre::Task::LWP"); } return $self; } =pod =head2 request The C method returns the L object that was provided to the constructor. =head2 response Before the C method has been fired the C method returns C. After the C method has been fired the C method returns the L object for the L request. Typically, you would use this in the C method for the task, if you wish to take any further actions in L based on the result of the HTTP call. =cut ###################################################################### # Padre::Task Methods sub run { my $self = shift; # Generate the formal request my $method = $self->{method} || 'GET'; my $url = $self->{url}; my $query = $self->{query}; if ( Params::Util::_HASH0($query) ) { $query = join '&', map { my $value = $query->{$_} || ''; $value =~ s/(\W)/"%".uc(unpack("H*",$1))/ge; $value =~ s/\%20/\+/g; $_ . '=' . $value; } ( sort keys %$query ); } if ( $method eq 'GET' and defined $query ) { $url .= '?' . $query; } require HTTP::Request; my $request = HTTP::Request->new( $method, $url ); if ( $method eq 'POST' ) { $request->content_type( $self->{content_type} || 'application/x-www-form-urlencoded' ); $request->content( $query || '' ); } my $headers = Params::Util::_HASH0( $self->{headers} ) || {}; foreach my $name ( sort keys %$headers ) { $request->header( $name => $headers->{$name} ); } $self->{request} = $request; # Initialise the user agent require LWP::UserAgent; my $useragent = LWP::UserAgent->new( agent => "Padre/$VERSION", timeout => 60, ); $useragent->env_proxy unless Padre::Constant::WIN32; # Execute the request. # It's not up to us to judge success or failure at this point, # we just do the heavy lifting of the request itself. $self->tell_status( join ' ', $method, $url, '...', ); $self->{response} = $useragent->request($request); $self->tell_status( join ' ', $method, $url, '-->', $self->{response}->code, $self->{response}->message, ); # Remove the CODE references from the response. # They aren't needed any more, and they won't survive # the serialization back to the main thread. delete $self->{response}->{handlers}; return 1; } 1; __END__ =pod =head1 SEE ALSO This class inherits from C and its instances can be scheduled using C. The transfer of the objects to and from the worker threads is implemented with L. =head1 AUTHOR Steffen Mueller C =head1 COPYRIGHT AND LICENSE Copyright 2008-2012 The Padre development team as listed in Padre.pm. This program is free software; you can redistribute it and/or modify it under the same terms as Perl 5 itself. =cut # Copyright 2008-2012 The Padre development team as listed in Padre.pm. # LICENSE # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl 5 itself.