File Coverage

File:blib/lib/App/Rgit/Command.pm
Coverage:97.7%

linestmtbrancondsubpodtimecode
1package App::Rgit::Command;
2
3
5
5
5
5
53
15
228
use strict;
4
5
5
5
5
45
14
269
use warnings;
5
6
5
5
5
5
39
12
182
use Carp ();
7
8
5
5
5
5
1489
19
4751
use App::Rgit::Utils qw/:codes/;
9
10 - 18
=head1 NAME

App::Rgit::Command - Base class for App::Rgit commands.

=head1 VERSION

Version 0.08

=cut
19
20our $VERSION = '0.08';
21
22 - 34
=head1 DESCRIPTION

Base class for L<App::Rgit> commands.

This is an internal class to L<rgit>.

=head1 METHODS

=head2 C<< new cmd => $cmd, args => \@args >>

Creates a new command object for C<$cmd> that is bound to be called with arguments C<@args>.

=cut
35
36my %commands;
37__PACKAGE__->action($_ => 'Once') for qw/daemon gui help init version/, ' ';
38
39sub new {
40
20
20
1
7684
 my $class = shift;
41
20
33
225
 $class = ref $class || $class;
42
43
20
291
 my %args = @_;
44
45
20
90
 my $cmd = $args{cmd};
46
20
100
80
 $cmd = ' ' unless defined $cmd;
47
48
20
165
 my $action = $class->action($cmd);
49
50
20
100
81
 if ($class eq __PACKAGE__) {
51
18
43
  $class = $action;
52 } else {
53
2
100
538
  Carp::confess("Command $cmd should be executed as a $action")
54                                                    unless $class->isa($action);
55 }
56
57
19
100
2184
 eval "require $action; 1" or Carp::confess("Couldn't load $action: $@");
58
59
18
100
610
 bless {
60  cmd => $cmd,
61  args => $args{args} || [ ],
62  policy => $args{policy},
63 }, $class;
64}
65
66 - 71
=head2 C<< action $cmd [ => $pkg ] >>

If C<$pkg> is supplied, handles command C<$cmd> with C<$pkg> objects.
Otherwise, returns the current class for C<$cmd>.

=cut
72
73sub action {
74
57
57
1
12447
 my ($self, $cmd, $pkg) = @_;
75
57
100
240
 if (not defined $cmd) {
76
4
100
100
158
  return unless defined $self and ref $self and $self->isa(__PACKAGE__);
77
1
44
  $cmd = $self->cmd;
78 }
79
54
100
173
 unless (defined $pkg) {
80
23
100
118
  return __PACKAGE__ . '::Each' unless defined $commands{$cmd};
81
18
131
  return $commands{$cmd}
82 }
83
31
100
150
 $pkg = __PACKAGE__ . '::' . $pkg unless $pkg =~ /:/;
84
31
220
 $commands{$cmd} = $pkg;
85}
86
87 - 92
=head2 C<report $conf, $repo, $status>

Reports that the execution of the command in C<$repo> exited with C<$status> to the current command's policy.
Returns what policy C<report> method returned, which should be one of the policy codes listed in C<App::Rgit::Utils>.

=cut
93
94sub report {
95
11
11
1
42
 my ($self) = @_;
96
97
11
336
 my $code = $self->policy->handle(@_);
98
99
11
100
512
 return defined $code ? $code : NEXT;
100}
101
102 - 110
=head2 C<cmd>

=head2 C<args>

=head2 C<policy>

Read-only accessors.

=cut
111
112BEGIN {
113
5
5
18
1
11
5
18
1
11
1
1
1
23
1271
349
22
302
 eval "sub $_ { \$_[0]->{$_} }" for qw/cmd args policy/;
114}
115
116 - 149
=head2 C<run $conf>

Runs the command with a L<App::Rgit::Config> configuration object.
Handles back the code to return to the system and the last policy.
Implemented in subclasses.

=head1 SEE ALSO

L<rgit>.

=head1 AUTHOR

Vincent Pit, C<< <perl at profvince.com> >>, L<http://profvince.com>.

You can contact me by mail or on C<irc.perl.org> (vincent).

=head1 BUGS

Please report any bugs or feature requests to C<bug-rgit at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=rgit>.
I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc App::Rgit::Command

=head1 COPYRIGHT & LICENSE

Copyright 2008,2009,2010 Vincent Pit, all rights reserved.

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

=cut
150
1511; # End of App::Rgit::Command