view release on metacpan or  search on metacpan

lib/Agent/TCLI/Request.pm  view on Meta::CPAN

	$self->set(\@id, ( defined($args->{'id'}) && $args->{'id'} )
		? $args->{'id'}
		: $$self ) unless ($self->id);
}

=head2 METHODS

=over

=item MakeResponse ( <text>, <code> )

MakeResponse used internally by Respond to create the Response object
to send back to the requestor. The only reason to call MakeResponse
directly would be to add or remove attributes before the Response is
sent.

=cut

sub MakeResponse {
	my ($self, $txt, $code) = @_;

	# TODO better validation of code
	$code = 200 unless defined($code);

	my $response = Agent::TCLI::Response->new(
		'body'		=> $txt,
		'code'		=> $code,
		'id'		=> $self->id,
		'sender'	=> [@{$self->sender}],
		'postback'	=> [@{$self->postback}],
		'response_count'=>$self->response_count,
	);

	if ( $self->response_verbose )
	{
		$response->args($self->args);
		$response->input($self->input);
		$response->command($self->command);
		$response->response_verbose($self->response_verbose);

		# copy all the dynamically created fields
		$self->Verbose("MakeResponse: can",4, \@{$self->can} );
		foreach my $field ( @{ $self->can } )
		{
			if ( $field =~ s/^get_// )
			{
				my $acc = 'get_'.$field;
				my $mut = 'set_'.$field;
				$response->$mut( $self->$acc ) if (defined( $self->$acc ));
			}
		}
	}

	return $response;
}

=item Respond ( <poe_kernel>, <text> [, <code>]) or ( <poe_kernel>, <response obj> )

Respond is the proper way to return a response to a request. It requires a
reference to the poe_kernel as the first parameter. The second parameter
may be either some text for the response or a Response object. The third
parameter is the resposne code. If not provided, it defaults to 200. While not
required, it is best to always fill in the response code. The response code
will be ignored if a Response object is provided.

=cut

sub Respond {
	# using Respond to return anything. That way it will
	# be easier to change/override how to return later on,
	# and call from the middle of a method.
	my ($self, $kernel, $txt, $code) = @_;
	$self->Verbose("Respond: id(".$id[$$self].") dump(".$self->dump(1),5);

	if ( ref($kernel) !~ /Kernel/i  )
	{
		$self->Verbose("Respond needs kernel as first parameter",0,$kernel);
		die;
	}

	$response_count[$$self]++;

	my $response;
	if ( ref($txt) =~ /Response/ )
	{
		$response = $txt;
	}
	else
	{
		$response = $self->MakeResponse( $txt, $code);
	}

	# If we have a control, then we really need to post to it's id.
	# I could stringify control to avoid this, but that seems rather inobvious
	# and I'd probably create some bug somewhere else that would be horrific
	# to debug because of it.

	# TODO. Can't do multple replies like this.
	my $sender = $self->sender->[0];
	my $postback = $self->postback->[0];
	if ( ref($sender) =~ /Control/ )
	{
		$self->Verbose("Respond: control(".$sender->id.") pb(".$postback.
			") txt($txt)",2);
		$sender = $sender->id()
	}
	else
	{
		$self->Verbose("Respond: sender(".$sender.") pb(".$postback.
			") txt($txt)",2);
	}

	$self->Verbose("Respond: id(".$id[$$self].") count(".$response_count[$$self].
		")  code(".$response->code.")",1) if defined($id[$$self]);
	$self->Verbose("Respond: sender(".$sender.") pb(".$postback.")");
	$kernel->call( $sender => $postback => $response );
}

# Standard class utils are inherited