File Coverage

blib/lib/App/Rgit/Command.pm
Criterion Covered Total %
statement 39 39 100.0
branch 20 20 100.0
condition 9 11 81.8
subroutine 11 11 100.0
pod 6 6 100.0
total 85 87 97.7


line stmt bran cond sub pod time code
1             package App::Rgit::Command;
2              
3 4     4   26 use strict;
  4         6  
  4         121  
4 4     4   18 use warnings;
  4         8  
  4         80  
5              
6 4     4   19 use Carp ();
  4         7  
  4         87  
7              
8 4     4   1415 use App::Rgit::Utils qw/:codes/;
  4         7  
  4         2356  
9              
10             =head1 NAME
11              
12             App::Rgit::Command - Base class for App::Rgit commands.
13              
14             =head1 VERSION
15              
16             Version 0.08
17              
18             =cut
19              
20             our $VERSION = '0.08';
21              
22             =head1 DESCRIPTION
23              
24             Base class for L commands.
25              
26             This is an internal class to L.
27              
28             =head1 METHODS
29              
30             =head2 C<< new cmd => $cmd, args => \@args >>
31              
32             Creates a new command object for C<$cmd> that is bound to be called with arguments C<@args>.
33              
34             =cut
35              
36             my %commands;
37             __PACKAGE__->action($_ => 'Once') for qw/daemon gui help init version/, ' ';
38              
39             sub new {
40 20     20 1 5886 my $class = shift;
41 20   33     267 $class = ref $class || $class;
42              
43 20         250 my %args = @_;
44              
45 20         70 my $cmd = $args{cmd};
46 20 100       75 $cmd = ' ' unless defined $cmd;
47              
48 20         284 my $action = $class->action($cmd);
49              
50 20 100       90 if ($class eq __PACKAGE__) {
51 18         40 $class = $action;
52             } else {
53 2 100       475 Carp::confess("Command $cmd should be executed as a $action")
54             unless $class->isa($action);
55             }
56              
57 19 100       2984 eval "require $action; 1" or Carp::confess("Couldn't load $action: $@");
58              
59 18   100     380 bless {
60             cmd => $cmd,
61             args => $args{args} || [ ],
62             policy => $args{policy},
63             }, $class;
64             }
65              
66             =head2 C<< action $cmd [ => $pkg ] >>
67              
68             If C<$pkg> is supplied, handles command C<$cmd> with C<$pkg> objects.
69             Otherwise, returns the current class for C<$cmd>.
70              
71             =cut
72              
73             sub action {
74 51     51 1 8105 my ($self, $cmd, $pkg) = @_;
75 51 100       139 if (not defined $cmd) {
76 4 100 100     77 return unless defined $self and ref $self and $self->isa(__PACKAGE__);
      100        
77 1         37 $cmd = $self->cmd;
78             }
79 48 100       125 unless (defined $pkg) {
80 23 100       203 return __PACKAGE__ . '::Each' unless defined $commands{$cmd};
81 18         115 return $commands{$cmd}
82             }
83 25 100       91 $pkg = __PACKAGE__ . '::' . $pkg unless $pkg =~ /:/;
84 25         108 $commands{$cmd} = $pkg;
85             }
86              
87             =head2 C
88              
89             Reports that the execution of the command in C<$repo> exited with C<$status> to the current command's policy.
90             Returns what policy C method returned, which should be one of the policy codes listed in C.
91              
92             =cut
93              
94             sub report {
95 11     11 1 76 my ($self) = @_;
96              
97 11         632 my $code = $self->policy->handle(@_);
98              
99 11 100       827 return defined $code ? $code : NEXT;
100             }
101              
102             =head2 C
103              
104             =head2 C
105              
106             =head2 C
107              
108             Read-only accessors.
109              
110             =cut
111              
112             BEGIN {
113 4     4 1 621 eval "sub $_ { \$_[0]->{$_} }" for qw/cmd args policy/;
  18     18 1 280  
  1     1 1 15  
  11     11   216  
114             }
115              
116             =head2 C
117              
118             Runs the command with a L configuration object.
119             Handles back the code to return to the system and the last policy.
120             Implemented in subclasses.
121              
122             =head1 SEE ALSO
123              
124             L.
125              
126             =head1 AUTHOR
127              
128             Vincent Pit, C<< >>, L.
129              
130             You can contact me by mail or on C (vincent).
131              
132             =head1 BUGS
133              
134             Please report any bugs or feature requests to C, or through the web interface at L.
135             I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
136              
137             =head1 SUPPORT
138              
139             You can find documentation for this module with the perldoc command.
140              
141             perldoc App::Rgit::Command
142              
143             =head1 COPYRIGHT & LICENSE
144              
145             Copyright 2008,2009,2010 Vincent Pit, all rights reserved.
146              
147             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
148              
149             =cut
150              
151             1; # End of App::Rgit::Command