This file is indexed.

/usr/share/perl5/Command/Shell.pm is in libur-perl 0.430-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
package Command::Shell;
use strict;
use warnings;
use Command::V2;

class Command::Shell {
    is => 'Command::V2',
    is_abstract => 1,
    subclassify_by => "_shell_command_subclass", 
    has_input => [
        delegate_type   => { is => 'Text', shell_args_position => 1,
                            doc => 'the class name of the command to be executed' },

        argv            => { is => 'Text', is_many => 1, is_optional => 1, shell_args_position => 2, 
                            doc => 'list of command-line arguments to be translated into parameters' },
    ],
    has_transient => [
        delegate        => { is => 'Command',
                            doc => 'the command which this adaptor wraps' },
        _shell_command_subclass => {    calculate_from => ['delegate_type'], 
                                        calculate => 
                                            sub {
                                                my $delegate_type = shift; 
                                                my $subclass = $delegate_type . "::Shell";
                                                eval "$subclass->class";
                                                if ($@) {
                                                    my $new_subclass = UR::Object::Type->define(
                                                        class_name => $subclass,
                                                        is => __PACKAGE__
                                                    );
                                                    die "Failed to fabricate subclass $subclass!" unless $new_subclass;
                                                }
                                                return $subclass;
                                            }, 
                                    },
    ],
    has_output => [
        exit_code =>    => { is => 'Number',
                            doc => 'the exit code to be returned to the shell', }
    ],
    doc => 'an adaptor to create and run commands as specified from a standard command-line shell (bash)'
};

sub help_synopsis {
    return <<EOS

    In the "foo" executable:

    #!/usr/bin/env perl
    use Foo;
    exit Command::Shell->run("Foo",@ARGV);

    The run() static method will construct the appropriate Command::Shell object, have it build its delegate,
    run the delegate's execution method in an in-memory transaction sandbox, and capture an exit code.

    If the correct environment variables are set, it will respond to a bash tab-completion request, such that
    the "foo" script can be used as a self-completer.

EOS

}

sub run {
    my $class = shift;
    my $delegate_type = shift;
    my @argv = @_;
    my $cmd = $class->create(delegate_type => $delegate_type, argv => \@argv);
    #print STDERR "created $cmd\n";
    $cmd->execute;
    my $exit_code = $cmd->exit_code;
    $cmd->delete;
    return $exit_code;
}

sub execute {
    my $self = shift;
    my $delegate_type = $self->delegate_type;
    eval "use above '$delegate_type'";
    if ($@) {
        my $t = UR::Object::Type->get($delegate_type);
        unless ($t) {
            die "Failure to use delegate class $delegate_type!:\n$@";
        }
    }
    my @argv = $self->argv;

    my $exit_code = $delegate_type->_cmdline_run(@argv);
    $self->exit_code($exit_code);
    return 1;
}

# TODO: migrate all methods in Command::V2 which live in the Command::Dispatch::Shell module to this package
# Methods which address $self to get to shell-specific things still call $self
# Methods which address $self to get to the underlying command should instead call $self->delegate

1;