view release on metacpan or  search on metacpan

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

=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');

=item id_count

A running count of internal request IDs to use
B<id_count> will only accept NUMERIC type values.

=cut
my @id_count		:Field
					:All('id_count')
					:Type('NUMERIC' );
#
#=item requests
#
#A hash collection of requests that are in progress
#
#=cut
#my @requests		:Field
#					:All('requests');
=back

=head2 METHODS

Most of these methods are for internal use within the TCLI system and may
be of interest only to developers trying to enhance TCLI.

=over

=item new ( hash of attributes )

Usually the only attributes that are useful on creation are the
verbose and do_verbose attrbiutes that are inherited from Agent::TCLI::Base.

=cut

sub _preinit :PreInit {
	my ($self,$args) = @_;

	$args->{'name'} = 'tcli_http';

	$args->{'session'} = POE::Session->create(
      object_states => [
          $self => [qw(
          	_start
          	_stop
          	_shutdown
          	_default
          	_child

			establish_context
			get
			ProcessResponse
			ResponseProgress
			retry
			)],
      ],
	);

}

sub _init :Init {
	my $self = shift;

	$self->set(\@user_agents, [
		'TCLI Test Agent'
	]);

	$self->LoadYaml(<<'...');
---
Agent::TCLI::Parameter:
  name: user_agents
  help: An array of user_agents to be used, at random.
  manual: >
    Currently not supported. :(
  type: Param
---
Agent::TCLI::Parameter:
  name: url
  constraints:
    - HTTP_URL
  help: The full http url to send to the webserver
  manual: >
    This is the full http://www.example.com url that is to be sent to the
    server. Currently only http is supported. DNS will be resolved from the
    TCLI agent system.
  type: Param
---
Agent::TCLI::Parameter:
  name: id
  help: An id to tag the request with.
  manual: >
    This is sort of deprecated. It allows one to set an id to tag a request
    so that one can properly match up the response. With full RPC support
    this does not seem necessary any more, so if it seems useful let the
    author know.
  type: Param
---
Agent::TCLI::Parameter:
  name: response_code
  aliases: resp
  constraints:
    - UINT
  class: numeric
  help: The desired response code.

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

  name: http
  call_style: session
  command: tcli_http
  contexts:
    ROOT: http
  handler: establish_context
  help: http web cient environment
  manual: >
    Currently the http commands available only support limited capabilities.
    One can request a url and verify that a desired response code was
    received, but HTML content is not processed.
  topic: net
  usage: http tget url=http:\example.com\request resp=404
---
Agent::TCLI::Command:
  name: tget
  call_style: session
  command: tcli_http
  contexts:
    http: tget
  handler: get
  help: makes a requests and expects a specific response code
  manual: >
    Tget makes an http request for the supplied url and checks to see that the
    supplied response code is returned by the http server. This is useful in
    test scripts to ensure that a request has been responeded to properly.
  parameters:
    url:
    response_code:
    retry_interval:
    retry_count:
  required:
    url:
  topic: net
  usage: tget tget url=http:\example.com\request resp=404
---
Agent::TCLI::Command:
  call_style: session
  command: tcli_http
  contexts:
    http: cget
  handler: get
  help: makes a requests and returns response code
  manual: >
    Cget makes an http request for the supplied url and returns the
    response code that is returned by the http server. This is useful in
    checking what responses a server may be sending back.
  name: cget
  parameters:
    url:
    retry_interval:
    retry_count:
  required:
    url:
  topic: net
  usage: http cget url=http:\example.com\request
...

}

sub _start {
	my ($kernel,  $self,  $session) =
      @_[KERNEL, OBJECT,   SESSION];
	$self->Verbose("_start: tcli http starting");

	# are we up before OIO has finished initializing object?
	if (!defined( $self->name ))
	{
		$kernel->yield('_start');
		return;
	}

	# There is only one command object per TCLI
    $kernel->alias_set($self->name);

	# Keep the cm session so we can shut it down
	$self->set(\@poco_cm , POE::Component::Client::Keepalive->new(
  		max_per_host => 4, 		# defaults to 4
  		max_open     => 128, 	# defaults to 128
  		keep_alive   => 15, 	# defaults to 15
  		timeout      => 120, 	# defaults to 120
	));

	$self->set(\@poco_http , POE::Component::Client::HTTP->spawn(
		Agent     => $self->user_agents,
		Alias     => 'http-client',                  # defaults to 'weeble'
		ConnectionManager => $poco_cm[$$self],
#		From      => 'spiffster@perl.org',  # defaults to undef (no header)
#		CookieJar => $cookie_jar,
#		Protocol  => 'HTTP/1.1',            # defaults to 'HTTP/1.1'
#		Timeout   => 180,                    # defaults to 180 seconds
#		MaxSize   => 16384,                 # defaults to entire response
#		Streaming => 4096,                  # defaults to 0 (off)
#		FollowRedirects => 2                # defaults to 0 (off)
#		Proxy     => "http://localhost:80", # defaults to HTTP_PROXY env. variable
# 		NoProxy   => [ "localhost", "127.0.0.1" ], # defs to NO_PROXY env. variable
	));

	$self->Verbose(" Dump ".$self->dump(1),3 );

}

sub _stop {
    my ($kernel,  $self,) =
      @_[KERNEL, OBJECT,];
	$self->Verbose("_stop: ".$self->name." stopping",2);
	$poco_cm[$$self]->shutdown;
  	$self->set(\@poco_cm, undef);
}

sub get {
    my ($kernel,  $self, $session, $request, ) =
      @_[KERNEL, OBJECT,  SESSION,     ARG0, ];

	my $txt = '';
	my $param;
	my $command = $request->command->[0];
	my $cmd = $self->commands->{$command};

	return unless ( $param = $cmd->Validate($kernel, $request, $self) );

	$self->Verbose("get: url(".$param->{'url'}.") ");
	$self->Verbose("get: $command  params",3,$param);

	$param->{'try_count'} = 1;
	$param->{'completed'} = 0;
	$param->{'start_time'} = time();

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

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

	$request->Respond($kernel, 'Trying '.$param->{'url'},100)
		if ( $param->{'http_verbose'} );
	return;
}

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

	my $http_request  = $request_packet->[0];
	my $http_response = $response_packet->[0];

	my $id		  = $request_packet->[1];
	my $request   = $self->requests->{$id}{'request'};
	my $param 	  = $self->requests->{$id}{'param'};

	my $txt;
	my $backtxt = '';

	$self->Verbose("ProcessResponse: for request id(".$id.")");
	$self->Verbose("ProcessResponse: request{".$id."}",3, $request );
	$self->Verbose("ProcessResponse: request{".$id."} param",2, $param );

	# Report only the rist response for the rtt.
	$param->{'end_time'} = time()  unless defined( $param->{'end_time'} );

#    my $response_string = $http_response->as_string();
#    $response_string =~ s/^/| /mg;

#  my $request_path = $http_request->uri->path . ''; # stringify

	if (!defined $http_response->code )
	{
		$self->Verbose("ProcessResponse: Bad HTTP response code id(".$id.") ",3);
		$request->Respond($kernel, "Error: ".$id." Bad HTTP response code",400);
		return;
	}

	#Push the response onto stack for later eval
#	push ( @{ $request->{'response_code'} },
#	  $http_response->code );

	# have we made all our requests?
	if (defined($param->{'retry_interval'} ) &&
		$param->{'retry_count'} > $param->{'try_count'}  )