view release on metacpan or  search on metacpan

lib/POE/Component/Client/HTTP/RequestFactory.pm  view on Meta::CPAN

=item

Protocol

=item

From

=item

CookieJar

=item

NoProxy

=item

Proxy

=item

FollowRedirects

=item

Timeout

=back

=cut


sub new {
  my ($class, $params) = @_;

  croak __PACKAGE__ . "expects its arguments in a hashref"
    unless (!defined ($params) or ref($params) eq 'HASH');

  # Accept an agent, or a reference to a list of agents.
  my $agent = delete $params->{Agent};
  $agent = [] unless defined $agent;
  $agent = [ $agent ] unless ref($agent);
  unless (ref($agent) eq "ARRAY") {
    croak "Agent must be a scalar or a reference to a list of agent strings";
  }

  my $v = $POE::Component::Client::HTTP::VERSION;
  $v = "0.000" unless defined $v;

  push(
    @$agent,
    sprintf(
      'POE-Component-Client-HTTP/%s (perl; N; POE; en; rv:%f)',
      $v, $v
    )
  ) unless @$agent;

  my $max_size = delete $params->{MaxSize};

  my $streaming = delete $params->{Streaming};

  my $protocol = delete $params->{Protocol};
  $protocol = 'HTTP/1.1' unless defined $protocol and length $protocol;

  my $cookie_jar       = delete $params->{CookieJar};
  my $from             = delete $params->{From};
  my $no_proxy         = delete $params->{NoProxy};
  my $proxy            = delete $params->{Proxy};
  my $follow_redirects = delete $params->{FollowRedirects} || 0;
  my $timeout          = delete $params->{Timeout};

  # Process HTTP_PROXY and NO_PROXY environment variables.

  $proxy    = $ENV{HTTP_PROXY} || $ENV{http_proxy} unless defined $proxy;
  $no_proxy = $ENV{NO_PROXY}   || $ENV{no_proxy}   unless defined $no_proxy;

  # Translate environment variable formats into internal versions.

  $class->parse_proxy($proxy) if defined $proxy;

  if (defined $no_proxy) {
    unless (ref($no_proxy) eq 'ARRAY') {
      $no_proxy = [ split(/\s*\,\s*/, $no_proxy) ];
    }
  }

  $timeout = 180 unless (defined $timeout and $timeout > 0);

  my $self = [
    $agent,            # FCT_AGENT
    $streaming,        # FCT_STREAMING
    $max_size,         # FCT_MAXSIZE
    $protocol,         # FCT_PROTOCOL
    $cookie_jar,       # FCT_COOKIEJAR
    $from,             # FCT_FROM
    $no_proxy,         # FCT_NOPROXY
    $proxy,            # FCT_HTTP_PROXY
    $follow_redirects, # FCT_FOLLOWREDIRECTS
    $timeout,          # FCT_TIMEOUT
  ];

  return bless $self, $class;
}


=head1 METHODS

=head2 timeout [$timeout]

Method that lets you query and/or change the timeout value for requests
created by this factory.

=cut


sub timeout {
  my ($self, $timeout) = @_;

  if (defined $timeout) {
    $self->[FCT_TIMEOUT] = $timeout;
  }
  return $self->[FCT_TIMEOUT];
}


=head2 is_streaming

Accessor for the Streaming parameter

=cut


sub is_streaming {
  my ($self) = @_;

  DEBUG and warn(
    "FCT: this is "
    . ($self->[FCT_STREAMING] ? "" : "not ")
    . "streaming"
  );
  return $self->[FCT_STREAMING];
}


=head2 agent

Accessor to the Agent parameter

=cut


sub agent {
  my ($self) = @_;

  return $self->[FCT_AGENT]->[rand @{$self->[FCT_AGENT]}];
}


=head2 from

getter/setter for the From parameter

=cut


sub from {
  my ($self) = @_;

  if (defined $self->[FCT_FROM] and length $self->[FCT_FROM]) {
    return $self->[FCT_FROM];
  }
  return undef;
}


=head2 create_request

Creates a new L<POE::Component::Client::HTTP::Request>

=cut


sub create_request {
  my ($self, $http_request, $response_event, $tag,
      $progress_event, $proxy_override, $sender) =  @_;

  # Add a protocol if one isn't included.
  $http_request->protocol( $self->[FCT_PROTOCOL] ) unless (
    defined $http_request->protocol()
    and length $http_request->protocol()
  );

  # Add the User-Agent: header if one isn't included.
  unless (defined $http_request->user_agent()) {
    $http_request->user_agent($self->agent);
  }

  # Add a From: header if one isn't included.
  if (defined $self->from) {
    my $req_from = $http_request->from();
    unless (defined $req_from and length $req_from) {
      $http_request->from( $self->from );
    }
  }

  # Add a Content-Length header if this request has content but
  # doesn't have a Content-Length header already.  Also, don't do it
  # if the content is a reference, as this means we're streaming via
  # callback.
  if (
    length($http_request->content()) and
    !ref($http_request->content()) and
    !$http_request->content_length()
  ) {
    use bytes;
    $http_request->content_length(length($http_request->content()));
  }

  my ($last_request, $postback);
  if (ref($response_event) eq 'POE::Component::Client::HTTP::Request') {
    $last_request = $response_event;
    $postback = $last_request->postback;
  }
  else {
    $postback = $sender->postback( $response_event, $http_request, $tag );
  }
  # Create a progress postback if requested.
  my $progress_postback;
  if (defined $progress_event) {
    if (ref $progress_event) {
      # The given progress event appears to already
      # be a postback, so use it.  This is needed to
      # propagate the postback through redirects.
      $progress_postback = $progress_event;
    }
    else {
      $progress_postback = $sender->postback(
        $progress_event,
        $http_request,
        $tag
      );
    }
  }

  # If we have a cookie jar, have it add the appropriate headers.
  # LWP rocks!

  if (defined $self->[FCT_COOKIEJAR]) {
    $self->[FCT_COOKIEJAR]->add_cookie_header($http_request);
  }

  # MEXNIX 2002-06-01: If we have a proxy set, and the request URI is
  # not in our no_proxy, then use the proxy.  Otherwise use the
  # request URI.
  #
  # RCAPUTO 2006-03-23: We only support http proxying right now.
  # Avoid proxying if this isn't an http request.

  # TODO CONNECT - Create a PCCH::Request object in https-CONNECT mode
  # if we're using https and there's an appropriate proxy.

  my $proxy = $proxy_override;
  if ($http_request->uri->scheme() eq "http") {
    $proxy ||= $self->[FCT_HTTP_PROXY];
  }

  if (defined $proxy) {
  # This request qualifies for proxying.  Replace the host and port