view release on metacpan or  search on metacpan

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

		}
	}
	elsif ( @{$c} == 4 )
	{
		if ( defined( $registered_commands[$$self]{ $c->[0] }{ $c->[1] }{ $c->[2] }{ $c->[3] } ) )
		{
			push( @aliases , @{ $self->SortCommands( $registered_commands[$$self]{ $c->[0] }{ $c->[1] }{ $c->[2] }{ $c->[3] } ) } );
		}
		if ( defined( $registered_commands[$$self]{ $c->[0] }{ $c->[1] }{ $c->[2] }{ 'GROUP' } ) )
		{
			push( @aliases , @{ $self->SortCommands( $registered_commands[$$self]{ $c->[0] }{ $c->[1] }{ $c->[2] }{ 'GROUP' } ) } );
		}
	}

	$self->Verbose("ListCommands: Aliases dump",2,\@aliases);

	foreach my $command ( @aliases )
	{
		$cmds{ $command->[0] } = $command->[1];
	}

	$self->Verbose("ListCommands: cmds dump",2,\%cmds);

	if ( %cmds )
	{

		# always return something defined.
		$txt = '';
		$code = 200;
	}
	else
	{
		$txt .= "Commands not found";
		$code = 404;
#		%cmds = undef;
		$self->Verbose("ListCommands: Whoooops! \n",1,\@aliases);
	}

	$self->Verbose("ListCommand: cmds(".(scalar keys %cmds).") txt(".$txt.") \n",1);
	return(\%cmds, $txt, $code);
}

=item RegisterCommand

RegisterCommand is an internal object method used to Register
Agent::TCLI::Package::Command objects directly.

=cut

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

	# Set a default package if not defined.
	$package = defined($package) ? $package."::".$cmd->name :
		'Control'."::".$cmd->name;

	if ( defined( $registered_commands[$$self]{'registered'}{ $package }) )
	{
		# We could die here, but then one would have to iterate over each failure
		# Though it might be nice to make failure more apparent. A MOTD perhaps?
		$self->Verbose( "RegisterCommand: ".$cmd->name." already registered! ",0 );
		$self->Verbose( "RegisterCommand: registered_commands dump  ",1,$self->registered_commands );
	}
	else
	{
		# need to figure out a way to do a reverse lookup on the name...
		$registered_commands[$$self]{'registered'}{ $package } = $cmd;
		$self->RegisterContexts($cmd);
	}

    return 1;
}

=item RegisterPackage

RegisterPackage is an internal object method used to register and entire
package of commands. It calls the Package's RawCommands method
to get the list of commands that need to be registered.

=cut

sub RegisterPackage {
	my ($self, $package) = @_;
	my ($commands, $txt);
	$self->Verbose( "RegisterPackage: $package " );
#	eval { require "$package" };
#	if ($@) {
#		$txt = "Bad package $package $@";
#		return $txt
#		};

	$commands = $package->commands();

    if ( ref($commands) eq 'ARRAY')
    {
    	foreach my $cmd (@{ $commands } )
    	{
        	if(ref $cmd eq 'HASH') {
            	$self->Register($cmd);
	    	} elsif ( ref($cmd) =~ /Agent::TCLI::Command/ ) {
				$self->RegisterCommand($cmd, $package);
            } else {
                $txt = "Parameter 'commands' contains illegal element";
            }
        }
    }
    elsif ( ref($commands) eq 'HASH' )
    {
    	foreach my $cmd ( values %{ $commands } )
    	{
        	if(ref $cmd eq 'HASH') {
            	$self->Register($cmd);
	    	} elsif ( ref($cmd) =~ /Agent::TCLI::Command/ ) {
				$self->RegisterCommand($cmd, $package);
            } else {
                $txt = "Parameter 'commands' contains illegal element";
            }
        }
    }
    else