File Coverage

lib/Spoon/Command.pm
Criterion Covered Total %
statement 12 54 22.2
branch 0 12 0.0
condition 0 9 0.0
subroutine 4 13 30.7
pod 0 5 0.0
total 16 93 17.2


line stmt bran cond sub pod time code
1             package Spoon::Command;
2 1     1   1841 use Spoon::Base -Base;
  1         2  
  1         11  
3 1     1   948  
  1     1   2  
  1         39  
  1         7  
  1         3  
  1         80  
4             field quiet => 0;
5              
6 0     0 0   sub process {
7 1     1   7 no warnings 'once';
  1         2  
  1         696  
8 0     0     local *boolean_arguments = sub { qw( -q -quiet ) };
  0            
9 0           my ($args, @values) = $self->parse_arguments(@_);
10 0 0 0       $self->quiet(1)
11             if $args->{-q} || $args->{-quiet};
12             my $action = $self->get_action(shift(@values)) ||
13 0   0 0     sub { $self->default_action(@_) };
  0            
14 0           $action->(@values);
15 0           return $self;
16             }
17              
18 0     0 0   sub get_action {
19 0 0         my $action = shift
20             or return;
21 0 0         $action =~ s/^-//
22             or return;
23 0           my $method = "handle_$action";
24             return sub {
25 0     0     $self->$method(@_);
26 0 0         } if $self->can($method);
27 0 0         my $array = $self->hub->registry->lookup->{command}{$action}
28             or return;
29 0           my $class_id = shift @$array;
30 0           my $object = $self->hub->$class_id;
31             return sub {
32 0     0     $object->$method(@_);
33 0           };
34             }
35              
36 0     0 0   sub default_action {
37 0           $self->usage;
38             }
39              
40 0     0 0   sub command_usage {
41 0           my $pattern = shift;
42 0           my $lookup = $self->hub->registry->lookup;
43 0   0       my $commands = $lookup->{command} || {};
44 0           my %descriptions = map {
45 0           my $array = $commands->{$_};
46 0           shift @$array;
47 0           my %hash = @$array;
48 0   0       my $description = $hash{description} || '';
49 0           ($_, $description);
50             } keys %$commands;
51 0           my $usage = '';
52 0           for my $plugin (@{$lookup->plugins}) {
  0            
53 0           my $class_id = $plugin->{id};
54 0           for my $command (@{$lookup->add_order->{$class_id}{command}}) {
  0            
55 0           $usage .= sprintf($pattern, $command, $descriptions{$command});
56             }
57             }
58 0           return $usage;
59             }
60              
61 0     0 0   sub msg {
62 0 0         warn @_ unless $self->quiet;
63             }
64              
65             __DATA__