view release on metacpan or  search on metacpan

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

not be set, but must added with the register method.

=cut

my @registered_commands 	:Field	:Get('registered_commands');

my @starts 		:Field	:Get('starts');

my @stops 		:Field	:Get('stops');

my @handlers 	:Field	:Get('handlers');

my @start_time	:Field
				:Get('start_time');

my @user		:Field  :All('user')
				:Type('Agent::TCLI::User');

my @packages	:Field	:All('packages');

#my @alias		:Field	:All('alias');

=item auth

Authorization for the user for this control. Must be separate from the
auth in the user object since that might not be the only factor at all times.

=cut
my @auth 		:Field
				:All('auth');

=item type

Type of conversation. MUST be one of these values:
  B<instant> =>  one time (or not specified)
  B<chat>  =>  peer to peer chat
  B<group>  =>  group chatroom

=cut
my @type 	:Field( 'All' => 'type' );

=item context

Contains the context of the current Command application for the control.

=cut
my @context 	:Field
				:Type('Array')
				:Arg('Name' => 'context', 'Default' => ['ROOT'] )
				:Acc('context');

=item owner

Contains the owning session of the control. This allows the control to be
passed around between sessions and whatever session that has it can
send back to the top level originating session.

=cut
my @owner 		:Field( 'All' => 'owner' );

=item prompt

The promt that the control is displaying, when appropriate.

=cut
my @prompt		:Field  :All('prompt');

=item local_address

The local IP address of the system

=cut
my @local_address	:Field
					:All('local_address');

=item hostname

The hostname being used by the control.

=cut
my @hostname		:Field
					:All('hostname');

=item poe_debug

A flag to set whether to enable poe debugging if installed

=cut
my @poe_debug		:Field
					:All('poe_debug');

# Holds our session data. Made weak per Merlyn
# http://poe.perl.org/?POE_Cookbook/Object_Methods.
# We also don't take session on init.
#my @session			:Field
#					:Get('session')
#					:Weak;

# Standard class utils are inherited
=back

=head2 METHODS

=over

=cut

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

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

         	AsYouWished
          	ChangeContext
          	Execute

			dumpcmd
			establish_context

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

  # Validate arguments
#  $self->Verbose( "spawn: Validating arguments \n" );

#  my %args = validate( @_, {
#	local_address  	=> { optional => 1 },
#	local_port     	=> { optional => 1, default => 42 },
#	hostname       	=> { optional => 1, default => hostname() },
#	poe_debug      => { optional => 1, default => 1 },
#                       # if not available, silenty fails to load debug
#    }
#  );

   	$self->LoadXMLFile();

	# Register default commands
	$self->Verbose( "init: Registering default commands \n".$self->dump(1),3 );

	foreach my $cmd ( values %{ $self->commands } )
	{
		$self->RegisterCommand($cmd);
	}

	# if available, register requested command packages
	$self->Verbose( "init: Registering user packages \n" );

	if ( defined($packages[$$self] ) )
	{
		my $txt;
		foreach my $package (@{ $packages[$$self] })
		{
			my $txt = $self->RegisterPackage($package);
        	croak ($txt) if ($txt); # Load fail on start MUST die.
		}
	} # end if packages

  # Register user commands, if requested #{{{
#  $self->Verbose( "init: Registering user commands \n" );
#
#  if( ref( $commands[$$self] ) =~ /ARRAY/i ) {
#
#	foreach my $cmd (@{ $commands[$$self] }) {
#    	if ( ref($cmd) eq 'HASH') {
#			$self->register($cmd);
#    	} elsif ( ref($cmd) =~ /Agent::TCLI::Command/ ) {
#			$self->register_command($cmd);
#    	} else {
#			$self->Verbose("init: Parameter 'commands' contains bad element");
#			$self->Verbose("init: Dump of commands ", 4, $commands[$$self]);
#  		}
#	} #end foreach
#
#  } else {
#
#	$self->Verbose("init: User commands not an array ref, not loaded");
#	$self->Verbose("init: Dump of commands ", 4, $commands[$$self]);
#
#  } #end if commands

	if ( defined( $hostname[$$self] ) )
	{
  		$self->set(\@prompt, $id[$$self]." [".$hostname[$$self]."]: ");
	}
}

=item Register

Register is an internal object method used to register commands with the Control.

=cut

sub Register {
    my $self = shift;
	$self->Verbose("Register: params",4,@_);
    my %cmd = validate( @_, {
        help => { type => Params::Validate::SCALAR },  #required
        usage     => { type => Params::Validate::SCALAR },  #required
        topic     => { optional => 1, type => Params::Validate::SCALAR },
        name      => { type => Params::Validate::SCALAR },  #required
        command   => { type => ( Params::Validate::SCALAR | Params::Validate::CODEREF ) }, #required
        contexts	  => { optional => 1, type => Params::Validate::HASHREF },
        call_style     => { optional => 1, type => Params::Validate::SCALAR },
#        start     => { optional => 1, type => Params::Validate::CODEREF },
        handler   => { optional => 1, type => Params::Validate::SCALAR },
#        stop      => { optional => 1, type => Params::Validate::CODEREF },
    } );

	# Set up a default contexts if one not provided.
    $cmd{'contexts'} = { 'ROOT' => $cmd{'name'} } unless (defined ( $cmd{'contexts'}) );

	$self->Verbose("Register: name ".$cmd{'name'} );

	$self->RegisterContexts(\%cmd);

#	# Don't want these in loop, since they only should get added once.
#    push ( @{ $starts[$$self] },   \%cmd )  if ( defined ( $cmd{'start'} ) );
#    push ( @{ $handlers[$$self] }, \%cmd )  if ( defined ( $cmd{'handler'} ) );
#    push ( @{ $stops[$$self] },    \%cmd )  if ( defined ( $cmd{'stop'} ) );

	$self->Verbose("Register: commands \n",5,$registered_commands[$$self]);

    return 1;
}

=item RegisterContexts

RegisterCotexts is an internal object method used to register contexts for
commands with the Control.

=cut

sub RegisterContexts {
	my ($self, $cmd ) = @_;
	$self->Verbose( "RegisterContext: (".$cmd->name.") ");

	# TODO Error catching
	# Loop over each context key to add command to list
   	foreach my $c1 ( keys %{ $cmd->contexts } )
   	{
   		my $v1 = $cmd->contexts->{$c1};
  		# Not warning on error if 'ROOT' and hash
   		if ( ( $c1 ne 'ROOT' ) && ( ref( $v1 ) =~ /HASH/ ) )