view release on metacpan or  search on metacpan

lib/Agent/TCLI/Package/Net/HTTP.pm  view on Meta::CPAN

package Agent::TCLI::Package::Net::HTTP;
#
# $Id: HTTP.pm 74 2007-06-08 00:42:53Z hacker $
#
=pod

=head1 NAME

Agent::TCLI::Package::Net::HTTP

=head1 SYNOPSIS

From within a TCLI Agent session:

tget url=http://example.com/bad_request resp=404

=head1 DESCRIPTION

This module provides a package of commands for the TCLI environment. Currently
one must use the TCLI environment (or browse the source) to see documentation
for the commands it supports within the TCLI Agent.

Makes standard http requests, either testing that a response code was given
or receive the response code back.

=head1 INTERFACE

This module must be loaded into a Agent::TCLI::Control by an
Agent::TCLI::Transport in order for a user to interface with it.

=cut

use warnings;
use strict;

use Object::InsideOut qw(Agent::TCLI::Package::Base);

use POE;
use POE::Component::Client::HTTP;
use POE::Component::Client::Keepalive;
use HTTP::Request::Common qw(GET POST);
use Agent::TCLI::Command;
use Agent::TCLI::Parameter;
use Getopt::Lucid qw(:all);

our $VERSION = '0.030.'.sprintf "%04d", (qw($Id: HTTP.pm 74 2007-06-08 00:42:53Z hacker $))[2];

=head2 ATTRIBUTES

The following attributes are accessible through standard <attribute>
methods unless otherwise noted.

These attrbiutes are generally internal and are probably only useful to
someone trying to enhance the functionality of this Package module.

=over

=cut

#my @session 	:Field
#				:Weak
#				:Type('POE::Session');

=item poco_cm

A POE connection manager session.
B<cm> will only accept POE::Component::Client::Keepalive type values.

=cut

my @poco_cm			:Field
					:All('poco_cm')
					:Type('POE::Component::Client::KeepaliveRaw' );

=item poco_http

The POE http client.
B<poco_http> will only accept POE::Component::Client::HTTP type values.

=cut
my @poco_http		:Field
					:All('poco_http')
					:Type('POE::Component::Client::HTTPRaw' );

=item user_agents

An array of user_agents to use.
B<user_agents> will only accept ARRAY type values.

=cut
my @user_agents		:Field
					:All('user_agents')
					:Type('ARRAY' );

=item cookie_jar

An place to keep cookies

=cut
my @cookie_jar		:Field
					:All('cookie_jar');

lib/Agent/TCLI/Package/Net/HTTP.pm  view on Meta::CPAN

		}

		$self->Verbose("ProcessResponse: tget code txt(".$txt.$backtxt.") ",3);
		$request->Respond($kernel,  $txt.$backtxt );
		return;
	}
	# if not done, then do nothing and wait until we are.
	elsif ( $request->command->[0] eq 'tget' && not $param->{'completed'} )
	{
		$self->Verbose("ProcessResponse: tget tries(".$param->{'try_count'}.
			") rc(".$param->{'retry_count'}.") ",3);
		return;
	}
    # cget will report for every try.
	elsif ( $request->command->[0] eq 'cget' )
	{
		$txt = $param->{'url'}." ".
		"resp=".$http_response->code()." ";

		if ($param->{'retry_count'} > 1 )
		{
			$txt .= "try=".$param->{'try_count'}." ";
		}

		$self->Verbose("ProcessResponse: get txt(".$txt.$backtxt.") ",3);
		$request->Respond($kernel, $txt.$backtxt);
		return;
	}

	$self->Verbose("ProcessResponse: WHOOPS! id{".$id."}  ",1,$request);
}

sub retry {
  my ($kernel,  $self,  $id ) =
	@_[KERNEL, OBJECT, ARG0 ];

	my $txt;
	$self->Verbose("retry: id(".$id.") ");

	my $request   = $self->requests->{$id}{'request'};
	my $param 	  = $self->requests->{$id}{'param'};

	$param->{'try_count'}++ ;

		# execution
		$kernel->post( 'http-client' => 'request' => 'ProcessResponse' =>
			GET($param->{'url'},
				Connection => "Keep-Alive",
				),
			$id,
			'ResponseProgress', #progress callback
			'', #proxy override
  		);
}

sub ResponseProgress {
  my ($kernel,  $self, $gen_args, $call_args) =
	@_[KERNEL, OBJECT,      ARG0,       ARG1 ];
	$self->Verbose("ResponseProgress: \tEntering ".$self->name." " );

    my $req = $gen_args->[0];    # HTTP::Request object being serviced
    my $tag = $gen_args->[1];    # Request ID tag from.
    my $got = $call_args->[0];   # Number of bytes retrieved so far.
    my $tot = $call_args->[1];   # Total bytes to be retrieved.
    my $oct = $call_args->[2];   # Chunk of raw octets received this time.

    my $percent = $got / $tot * 100;

#    printf(
#      "-- %.0f%% [%d/%d]: %s\n", $percent, $got, $tot, $req->uri()
#    );

	my $request   = $self->requests->{$tag}{'request'};

#	Not doing anything yet.
}

=item show

This POE event handler executes the show commands.

=back

=cut

1;
#__END__

=head3 INHERITED METHODS

This module is an Object::InsideOut object that inherits from Agent::TCLI::Package::Base. It
inherits methods from both. Please refer to their documentation for more
details.

=head1 AUTHOR

Eric Hacker	 E<lt>hacker at cpan.orgE<gt>

=head1 BUGS

SHOULDS and MUSTS are currently not enforced.

Test scripts not thorough enough.

Probably many others.

=head1 LICENSE

Copyright (c) 2007, Alcatel Lucent, All rights resevred.

This package is free software; you may redistribute it
and/or modify it under the same terms as Perl itself.

=cut