/usr/share/perl5/CLI/Framework/Command/Alias.pm is in libcli-framework-perl 0.05-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 | package CLI::Framework::Command::Alias;
use base qw( CLI::Framework::Command::Meta );
use strict;
use warnings;
our $VERSION = 0.01;
#-------
sub usage_text {
q{
alias [<cmd-name>]: show command aliases
[and subcommand aliases for <cmd-name>, if given]
ARGUMENTS
<cmd-name>: if specified, show aliases for this command only and show
its subcommand aliases
}
}
sub run {
my ($self, $opts, @args) = @_;
my $app = $self->get_app();
my %cmd_alias_to_name = $app->command_alias();
my $cmd = shift @args;
# Ignore non-interactive commands while in interactive mode...
if( $app->get_interactivity_mode() ) {
while( my ($k,$v) = each %cmd_alias_to_name ) {
if( ! $app->is_interactive_command( $v ) ) {
delete $cmd_alias_to_name{ $k };
}
}
}
# Alias command only recognizes one argument: a top-level command...
if( $cmd ) {
# Recognize alias requests by alias...
$cmd = $cmd_alias_to_name{$cmd} if exists $cmd_alias_to_name{$cmd};
# Silently pass if invalid command...
return unless $app->is_valid_command_name( $cmd );
# Formatted display of aliases to specific command...
my $summary = $self->_cmd_alias_hash_to_summary(
\%cmd_alias_to_name,
target => $cmd
);
# Formatted display of aliases to subcommand...
my $cmd_object = $app->registered_command_object( $cmd )
|| $app->register_command( $cmd );
my %subcommand_alias = $cmd_object->subcommand_alias();
my $subcommand_summary = $self->_cmd_alias_hash_to_summary(
\%subcommand_alias,
);
if( $subcommand_summary ) {
$summary .= sprintf( "\n%15s '%s':\n", 'SUBCOMMANDS of command', $cmd );
$summary .= sprintf( "\n%s", $subcommand_summary );
}
return $summary;
}
else {
# Formatted display of all aliases...
my $summary = $self->_cmd_alias_hash_to_summary(
\%cmd_alias_to_name,
);
return $summary;
}
}
sub _cmd_alias_hash_to_summary {
my ($self, $aliases, %param) = @_;
my $target = $param{target};
my %name_to_alias_set;
while( my ($alias, $name) = each %$aliases ) {
next if $alias =~ /^\d+$/; # ignore numerical aliases
next if $target && $name ne $target;
push @{ $name_to_alias_set{$name} }, $alias;
}
return $self->format_name_to_aliases_hash( \%name_to_alias_set );
}
sub format_name_to_aliases_hash {
my ($self, $h, $indent) = @_;
$indent ||= 10;
my $format = '%'.$indent."s: %s\n";
my @output;
for my $command (keys %$h) {
push @output, sprintf
$format, $command, join( ', ', @{$h->{$command}} );
}
my @output_sorted = sort {
my $name_a = substr( $a, index($a, ':') );
my $name_b = substr( $b, index($b, ':') );
$name_a cmp $name_b;
} @output;
return join( '', @output );
}
__END__
=pod
=head1 NAME
CLI::Framework::Command::Alias - CLIF built-in command to display the command
aliases that are in effect for the running application and its commands
=head1 SEE ALSO
L<command_alias|CLI::Framework::Application/command_alias()>
L<CLI::Framework::Command>
=cut
|