/usr/share/perl5/CLI/Framework/Command/Tree.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 | package CLI::Framework::Command::Tree;
use base qw( CLI::Framework::Command::Meta );
use strict;
use warnings;
our $VERSION = 0.01;
#-------
sub usage_text {
q{
tree: tree view of the names of only those commands that are currently registered in the application
}
}
sub run {
my ($self, $opts, @args) = @_;
my $app = $self->get_app(); # metacommand is app-aware
my $tree = command_tree( $app );
$tree =~ s/^/\t/gm;
return $tree;
}
#-------
sub command_tree {
my ($app, $root, $indent, $tree) = @_;
$root ||= $app;
$indent ||= 0;
# (output object)
$tree = { text => '' } unless ref $tree;
$indent += 4 if( $root->isa( 'CLI::Framework::Command' ) );
# For every command registered into the root object (either a CLIF
# Application or a CLIF Command), append its tree representation to the
# output object...
# Use proper accessors for object type...
my $registered_command_names_accessor = 'registered_command_names';
my $registered_command_obj_accessor = 'registered_command_object';
if( $root->isa('CLI::Framework::Command') ) {
$registered_command_names_accessor = 'registered_subcommand_names';
$registered_command_obj_accessor = 'registered_subcommand_object';
}
my @command_names;
{ no strict 'refs';
@command_names = $root->$registered_command_names_accessor;
}
for my $command_name (@command_names) {
#XXX-ALTERNATIVE: show a tree of command names
# $tree->{text} .= ' 'x$indent . $command_name . "\n";
my $command_obj;
{ no strict 'refs';
$command_obj = $root->$registered_command_obj_accessor( $command_name );
}
#XXX-ALTERNATIVE: show a tree of Perl package names defining the commands (including
# source files they were defined in):
my $source = Class::Inspector->loaded_filename( ref $command_obj );
$source ||= 'defined inline';
my $x = ref ($command_obj) . " ($source)";
$tree->{text} .= ' 'x$indent . $x . "\n";
# Recursive call (NOTE: passing output object reference which will act
# as an accumulator)...
command_tree( $app, $command_obj, $indent, $tree );
}
return $tree->{text} . "\n";
}
#-------
1;
__END__
=pod
=head1 NAME
CLI::Framework::Command::Tree - CLIF built-in command to display a tree
representation of the commands that are currently registered with the running
application
=head1 SEE ALSO
L<CLI::Framework::Command>
=cut
|