view release on metacpan or  search on metacpan

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

    $self->Verbose("Show: $attr ",1);

	my $txt = '';
	my ($code, $value);

	if ($attr eq 'peers')
	{
		# loop over the users
		foreach my $peer ( @{$self->peers} )
		{
			$txt .= "\nid: ".$peer->id."\nprotocol: ".$peer->protocol.
				"\nauth: ".$peer->auth."\npassword: ******\n";
			$code = 200;
		}
	}
	elsif ($attr eq 'controls')
	{
		# loop over the controls
		foreach my $control ( keys %{$self->controls} )
		{
			$txt .= "\nid: ".$control->id."\n";
			$code = 200;
		}
	}
	else
	{
		# lets see how it goes....
		eval { $value = $self->$attr };

		if( $@ )
		{
			$self->Verbose("Show: self->$attr got (".$@.') ');
			$txt = "Invalid $attr : $@ !";
			$code = 400;
		}
		elsif ( ref($value) )
		{
			$txt = "$attr is not a scalar. Dumping: \n";
			$txt .= pp($value);
			$code = 200;
		}
		else
		{
			$txt = "$attr => $value ";
			$code = 200;
		}
	}

	if ($request)
	{
		$self->Verbose('Show: responding txt('.$txt.') code('.$code." )",3);
		$request->Respond($kernel, $txt, $code);
		return;
	}
	# What do we do if there is no request?
}

=item _default

This POE event handler is used to catch wayard calls to unavailable states. If
verbose is on, it makes it rather obvious in the logs that an event was not
handled.

=cut

sub _default {
  my ($kernel,  $self, ) =
    @_[KERNEL, OBJECT, ];
 	my $oops = "\n\n\n".
	"\t  OOOO      OOOO    PPPPPP    SSSSSS    ##  \n".
	"\t OO  OO    OO  OO   PP   PP  SS         ##  \n".
	"\tOO    OO  OO    OO  PP   PP  SS         ##  \n".
	"\tOO    OO  OO    OO  PPPPPP    SSSSSS    ##  \n".
	"\tOO    OO  OO    OO  PP             SS   ##  \n".
	"\t OO  OO    OO  OO   PP             SS       \n".
	"\t  OOOO      OOOO    PP        SSSSSS    ##  \n";
	$self->Verbose($oops);
	$self->Verbose("\n\nDefault caught an unhandled $_[ARG0] event.\n");
	$self->Verbose("The $_[ARG0] event was given these parameters:");
	$self->Verbose("ARG1 dumped",1,$_[ARG1]) if defined($_[ARG1]);
	$self->Verbose("ARG2 dumped",1,$_[ARG2]) if defined($_[ARG2]);

	return (0);
}

1;

#__END__

=back

=head1 AUTHOR

Eric Hacker	 hacker can be emailed at cpan.org

=head1 BUGS

SHOULDS and MUSTS are currently not enforced.

New commands could clobber old ones under certain circumstances.

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