view release on metacpan or  search on metacpan

lib/Agent/TCLI/Transport/Base.pm  view on Meta::CPAN

sub _child {
  my ($kernel,  $self, $session, $id, $error) =
    @_[KERNEL, OBJECT,  SESSION, ARG1, ARG2 ];

   $self->Verbose("child: id($id) error($error)") if (defined($error));
}

=item _shutdown

Forcibly shutdown

=cut

sub _shutdown :Cumulative {
    my ($kernel,  $self, $session) =
    @_[KERNEL, OBJECT,  SESSION];
	# TODO, do some proper signal handling
	# especially reconnect on HUP and something on INT

	$self->Verbose('_shutdown: dropping controls',1, $self->controls);

	if ( defined( $self->controls ) )
	{
		foreach my $control ( values %{$self->controls} )
		{
			$kernel->post( $control->id() => '_shutdown' );
			delete(  $self->controls->{ $control->id }  );
		}
	}

	$self->Verbose("_shutdown: removing alarms",1,$kernel->alarm_remove_all() );

    $kernel->alias_remove( $self->alias );

    return("_shutdown ".$self->alias  );
}

sub ControlExecute {
	my ($kernel,  $self, $control, $request ) =
	  @_[KERNEL, OBJECT,     ARG0,     ARG1 ];
	$self->Verbose("ControlExecute: control(".$control->id.") req(".$request->id.") ");

	# Sometimes, control has not started, so we wiat if we have to.
	if ( defined($control->start_time) )
	{
		$kernel->post( $control->id() => 'Execute' => $request );
	}
	else
	{
		$kernel->delay('ControlExecute' => 1 => $control, $request );
	}
}

=item PackRequest

This object method is used by transports to prepare a request for transmssion.

Currently the code is taking a lazy approach and using Perl's YAML and OIO->dump to
safely freeze and thaw the request/responses for Internet transport.
By standardizing these routines in the Base class, more elegant methods
may be transparently enabled in the future.

=cut
# TODO review XEP on this, esp version numbers and best practices.

sub PackRequest {
	my ($self, $request) = @_;
	my $dump = $request->dump();

	# Take out the Base to save space since we're ignore this at the other end.
	delete $dump->[1]{'Agent::TCLI::Base'};

	my $packed_request = freeze($dump);
	return($packed_request);
}

=item PackResponse

This object method is used by transports to prepare a reseponse for transmssion.
See PackRequest for more details.

=cut

sub PackResponse {
	my ($self, $response) = @_;
	my $dump = $response->dump();

	# Take out the Base to save space since we're ignore this at the other end.
	delete $dump->[1]{'Agent::TCLI::Base'};

	# freeze does not terminate the yaml
	my $packed_response = freeze($dump);
	return($packed_response);
}

=item UnpackRequest

This object method is used by transports to unpack a request from transmssion.
See PackRequest for more details.

=cut

sub UnpackRequest {
	my ($self, $packed_request) = @_;
	$self->Verbose("UnpackRequest: $packed_request");

	my $request_array = thaw($packed_request);
	my %automethod_fields;

	foreach my $field ( keys %{ $request_array->[1]{'Agent::TCLI::Request'} } )
	{
		if ( $field =~ s/^get_// )
		{
			my $acc = 'get_'.$field;
			my $mut = 'set_'.$field;
			$automethod_fields{$mut} = $request_array->[1]{'Agent::TCLI::Request'}{ $acc }
				if (defined( $request_array->[1]{'Agent::TCLI::Request'}{ $acc } ));
			delete $request_array->[1]{'Agent::TCLI::Request'}{ $acc };
		}
	}