/usr/share/perl5/Perlbal/ManageCommand.pm is in libperlbal-perl 1.80-2.
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:
|