view release on metacpan or  search on metacpan

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

		{
			# This would allow hashes under *U which is not supported by Control.pm
			push( @aliases , @{$self->Aliases( $contexts[$$self]{ $c->[0] }{ '*U' } ) } );
		}
	}
	elsif ( @{$c} == 3 )
	{
		if ( defined( $contexts[$$self]{ $c->[0] }{ $c->[1] }{ $c->[2] } ) )
		{
			push( @aliases , @{ $self->Aliases( $contexts[$$self]{ $c->[0] }{ $c->[1] }{ $c->[2] } ) } );
		}

		if ( defined( $contexts[$$self]{ $c->[0] }{ $c->[1] }{ '*U' } ) )
		{
			# This would allow hashes under *U which is not supported by Control.pm
			push( @aliases , @{ $self->Aliases( $contexts[$$self]{ $c->[0] }{ $c->[1] }{ '*U' } ) } );
		}
	}
	elsif ( @{$c} == 4 )
	{
		# any hashes at this point are not supported by Control.pm
		if ( defined( $contexts[$$self]{ $c->[0] }{ $c->[1] }{ $c->[2] }{ $c->[3] } ) )
		{
			push( @aliases , @{ $self->Aliases( $contexts[$$self]{ $c->[0] }{ $c->[1] }{ $c->[2] }{ $c->[3] } ) } );
		}
		if ( defined( $contexts[$$self]{ $c->[0] }{ $c->[1] }{ $c->[2] }{ '*U' } ) )
		{
			# This would allow hashes under *U which is not supported by Control.pm
			push( @aliases , @{ $self->Aliases( $contexts[$$self]{ $c->[0] }{ $c->[1] }{ $c->[2] }{ '*U' } ) } );
		}
	}

	$self->Verbose("Usages: out \$c dump",4,$c);
	$self->Verbose("Usages: out aliases dump",4,\@aliases);
	$self->Verbose("Usages: contexts dump",3, $contexts[$$self] ) unless @aliases;
	return ( \@aliases );
} # End Usages

=item Aliases (  context_hash_key  )

Return aliases for specific context hash key.

An internal method that takes a context hash key and returns all the
aliases for that specific key. The aliases could be an array, hash
or scalar and this function simplifies that logic. It returns a
hash keyed on aliases of the command object.

If one has only a context, then use Usages which will call
Aliases correctly.

=cut

sub Aliases {
	my ($self, $context_hash_key) = @_;
	$self->Verbose("Aliases: context_hash_key dump",3,$context_hash_key);
	my @aliases;
	if ( ref( $context_hash_key ) =~ /ARRAY/ )
	{
		# There is a list of aliases to add.
		push( @aliases ,  @{$context_hash_key} );
#		%aliases = map { $_ => $self }  @{$context_hash_key} };
	}
	elsif ( ref( $context_hash_key ) =~ /HASH/ )
	{
		# There are context shifts to add.
		foreach my $key (keys %{$context_hash_key} )
		{
			push( @aliases , $key  ) unless ( $key =~ qr(\*U) );
		}
#		%aliases = map { $_ => $self }  keys %{$context_hash_key};
	}
	else
	{
		# There is a single alias to add.
		push( @aliases , $context_hash_key );
#		%aliases = ( $context_hash_key => $self );
	}
	return (\@aliases);
} # End Aliases

#sub RawCommand {
#	my $self = shift;
##    my %cmd = validate( @_, {
##        help_text => { 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
##        context	  => { optional => 1, type => Params::Validate::ARRAYREF },
##        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 },
##    } );
#
#	my %cmdhash = (
#		'name'		=> $name[$$self],
#        'help'		=> $help[$$self],
#        'usage'		=> $usage[$$self],
#        'command' 	=> $command[$$self],
#	);
#	$cmdhash{'topic'} 	= $topic[$$self] 	if (defined($topic[$$self]));
#	$cmdhash{'contexts'}	= $contexts[$$self] if (defined($contexts[$$self]));
#	$cmdhash{'call_style'}	= $call_style[$$self] if (defined($call_style[$$self]));
#	$cmdhash{'handler'}	= $handler[$$self] 	if (defined($handler[$$self]));
#	$cmdhash{'start'}	= $start[$$self] 	if (defined($start[$$self]));
#	$cmdhash{'stop'}	= $stop[$$self] 	if (defined($stop[$$self]));
#
#  	return ( \%cmdhash );
#}

=item GetoptLucid( $kernel, $request)

Returns an option hash keyed on parameter after the arguments have bee parsed
by Getopt::Lucid. Will respond itself if there is an error and return nothing.

Takes the POE Kernel and the request as args.

=cut

sub GetoptLucid {
	my ($self, $kernel, $request, $package) = @_;

	my (@options, $func);

	# Creat an array for Getopt::Lucid
	foreach my $param ( values %{ $self->parameters }  )
	{
#		my $name = defined($param->aliases)
#			? $param->name.'|'.$param->aliases