/usr/share/perl5/Scrappy/Action.pm is in libscrappy-perl 0.94112090-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 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 | package Scrappy::Action;
BEGIN {
$Scrappy::Action::VERSION = '0.94112090';
}
use Moose;
use File::Find::Rule;
# return a list of installed actions
#has actions => (
# is => 'ro',
# isa => 'ArrayRef',
# default => sub {
# []
# }
#);
# a hash list of installed actions
has registry => (
is => 'ro',
isa => 'HashRef',
default => sub {
my $actions = {};
foreach my $action (@{shift->actions}) {
$actions->{$action} = $action;
$actions->{lc($action)} = $action;
}
return $actions;
}
);
sub actions {
my @actions = ();
my @files =
File::Find::Rule->file()->name('*.pm')
->in(map {"$_/Scrappy/Action"} @INC);
my %actions =
map { $_ => 1 }
map { s/.*(Scrappy[\\\/]Action[\\\/].*\.pm)/$1/; $_ } @files; #uniquenes
for my $action (keys %actions) {
my ($plug) = $action =~ /(Scrappy[\\\/]Action[\\\/].*)\.pm/;
if ($plug) {
$plug =~ s/\//::/g;
push @actions, $plug;
}
}
return [@actions];
}
sub load_action {
my $self = shift;
my $action = shift;
unless ($action =~ /^Scrappy::Action::/) {
# make fully-quaified action name
$action = ucfirst $action;
$action = join("::", map(ucfirst, split '-', $action))
if $action =~ /\-/;
$action = join("", map(ucfirst, split '_', $action))
if $action =~ /\_/;
$action = "Scrappy::Action::$action";
}
# check for a direct match
if ($self->registry->{$action}) {
return $self->registry->{$action};
}
# last resort seek
elsif ($self->registry->{lc($action)}) {
return $self->registry->{lc($action)};
}
return 0;
}
# execute an action from the cli
sub execute {
my ($class, $action_class, $action, @options) = @_;
my $self = ref $class ? $class : $class->new;
# show help on syntax error
if (!$action_class || $action_class eq 'help') {
with 'Scrappy::Action::Help';
print $self->menu;
print "\n";
exit;
}
else {
if ($action) {
if ( $action eq 'meta'
|| $action eq 'registry'
|| $action eq 'actions'
|| $action eq 'load_action'
|| $action eq 'execute')
{
with 'Scrappy::Action::Help';
print $self->menu;
print "\n";
exit;
}
}
}
# locate the action if installed
my $requested_action = $self->load_action($action_class);
if ($requested_action) {
# load the desired action class
with $requested_action;
# is actoin available
unless ($action) {
print $self->help($requested_action);
print "\n";
exit;
}
# run the requested action
print $self->meta->has_method($action)
? $self->$action(@options)
: $self->help($requested_action);
print "\n";
}
else {
# ... or display the help menu
with 'Scrappy::Action::Help';
print $self->menu;
print "\n";
}
}
1;
|