File Coverage

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

linestmtbrancondsubpodtimecode
1package App::Rgit::Command;
2
3
5
5
5
5
36
16
41
use strict;
4
5
5
5
5
43
14
28
use warnings;
5
6
5
5
5
5
45
13
57
use Carp qw/croak/;
7
8
5
5
5
5
44
14
28
use Object::Tiny qw/cmd args policy/;
9
10
5
5
5
5
73
14
42
use App::Rgit::Utils qw/validate :codes/;
11
12 - 20
=head1 NAME

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

=head1 VERSION

Version 0.06

=cut
21
22our $VERSION = '0.06';
23
24 - 36
=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
37
38my %commands;
39__PACKAGE__->action($_ => 'Once') for qw/daemon gui help init version/, ' ';
40
41sub new {
42
17
17
1
165
 my ($class, %args) = &validate;
43
17
104
 my $cmd = $args{cmd};
44
17
100
68
 $cmd = ' ' unless defined $cmd;
45
17
128
 my $action = $class->action($cmd);
46
17
100
90
 if ($class eq __PACKAGE__) {
47
15
47
  $class = $action;
48 } else {
49
2
100
49
  croak "Command $cmd should be executed as a $action"
50                               unless $class->isa($action);
51 }
52
16
100
786
 eval "require $action; 1" or croak "Couldn't load $action: $@";
53
15
100
363
 $class->SUPER::new(
54  cmd => $cmd,
55  args => $args{args} || [ ],
56  policy => $args{policy},
57 );
58}
59
60 - 65
=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
66
67sub action {
68
54
54
1
423
 my ($self, $cmd, $pkg) = @_;
69
54
100
261
 if (not defined $cmd) {
70
4
100
100
106
  return unless defined $self and ref $self and $self->isa(__PACKAGE__);
71
1
10
  $cmd = $self->cmd;
72 }
73
51
100
186
 unless (defined $pkg) {
74
20
100
103
  return __PACKAGE__ . '::Each' unless defined $commands{$cmd};
75
15
86
  return $commands{$cmd}
76 }
77
31
100
164
 $pkg = __PACKAGE__ . '::' . $pkg unless $pkg =~ /:/;
78
31
250
 $commands{$cmd} = $pkg;
79}
80
81 - 86
=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 the policy callback returned, which should be one of the policy codes listed in C<App::Rgit::Utils>.

=cut
87
88sub report {
89
11
11
1
61
 my ($self) = @_;
90
11
113
 my $cb = $self->policy;
91
11
100
100
60
 return $_[3] ? LAST : NEXT unless $cb;
92
7
68
 my $code = $cb->(@_);
93
7
100
120
 return defined $code ? $code : NEXT;
94}
95
96 - 136
=head2 C<cmd>

=head2 C<args>

=head2 C<policy>

Accessors.

=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 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
137
1381; # End of App::Rgit::Command