This file is indexed.

/usr/share/perl5/Perlbal/ManageCommand.pm is in libperlbal-perl 1.80-3.

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
# class representing a one-liner management command.  all the responses
# to a command should be done through this instance (out, err, ok, etc)
#
# Copyright 2005-2007, Six Apart, Ltd.
#

package Perlbal::ManageCommand;
use strict;
use warnings;
no  warnings qw(deprecated);

use fields (
            'base', # the base command name (like "proc")
            'cmd',
            'ok',
            'err',
            'out',
            'orig',
            'argn',
            'ctx',
            );

sub new {
    my ($class, $base, $cmd, $out, $ok, $err, $orig, $ctx) = @_;
    my $self = fields::new($class);

    $self->{base} = $base;
    $self->{cmd}  = $cmd;
    $self->{ok}   = $ok;
    $self->{err}  = $err;
    $self->{out}  = $out;
    $self->{orig} = $orig;
    $self->{ctx}  = $ctx;
    $self->{argn}    = [];
    return $self;
}

# returns an managecommand object for functions that need one, but
# this does nothing but explode if there any problems.
sub loud_crasher {
    use Carp qw(confess);
    __PACKAGE__->new(undef, undef, sub {}, sub {}, sub { confess "MC:err: @_" }, "", Perlbal::CommandContext->new);
}

sub out   { my $mc = shift; return @_ ? $mc->{out}->(@_) : $mc->{out}; }
sub ok    { my $mc = shift; return $mc->{ok}->(@_);  }

sub err   {
    my ($mc, $err) = @_;
    $err =~ s/\n$//;
    $mc->{err}->($err);
}

sub cmd   { my $mc = shift; return $mc->{cmd};       }
sub orig  { my $mc = shift; return $mc->{orig};      }
sub end   { my $mc = shift; $mc->{out}->(".");    1; }

sub parse {
    my $mc = shift;
    my $regexp = shift;
    my $usage = shift;

    my @ret = ($mc->{cmd} =~ /$regexp/);
    $mc->parse_error($usage) unless @ret;

    my $i = 0;
    foreach (@ret) {
        $mc->{argn}[$i++] = $_;
    }
    return $mc;
}

sub arg {
    my $mc = shift;
    my $n = shift;   # 1-based array, to correspond with $1, $2, $3
    return $mc->{argn}[$n - 1];
}

sub args {
    my $mc = shift;
    return @{$mc->{argn}};
}

sub parse_error {
    my $mc = shift;
    my $usage = shift;
    $usage .= "\n" if $usage && $usage !~ /\n$/;
    die $usage || "Invalid syntax to '$mc->{base}' command\n"
}

sub no_opts {
    my $mc = shift;
    die "The '$mc->{base}' command takes no arguments\n"
        unless $mc->{cmd} eq $mc->{base};
    return $mc;
}

1;

# Local Variables:
# mode: perl
# c-basic-indent: 4
# indent-tabs-mode: nil
# End: