view release on metacpan or  search on metacpan

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

	# 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'}  )
	{
		$self->Verbose("ProcessResponse: id(".$id.") RETRY ri(".
			$param->{'retry_interval'}.") rc(".$param->{'retry_count'}.
			") tries(".$param->{'try_count'}.") ",2);
		$kernel->delay('retry' => $param->{'retry_interval'}, $id );

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

			$param->{'response_code'}  )  )
		{
			$txt = "failed ".$id." - response within (".
			  $param->{'response_code'}.")".
			 # " for url ".$request->{'request'}.
			  "\n#\texpected in the range (".$param->{'response_code'}.")".
			  " got (".$http_response->code().")".
			  " for url ".$param->{'url'}."\n".$txt;
		}
		else
		{
			$txt = "ok ".$id." - response within (".
			  $param->{'response_code'}.")".

			 " ";
		}

		$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.