]> git.vpit.fr Git - perl/modules/rgit.git/blob - App/Rgit/Command.pm
Update VPIT::TestHelpers to 15e8aee3
[perl/modules/rgit.git] / App / Rgit / Command.pm
1 package App::Rgit::Command;
2
3 use strict;
4 use warnings;
5
6 use Carp qw/croak/;
7
8 use Object::Tiny qw/cmd args policy/;
9
10 use App::Rgit::Utils qw/validate :codes/;
11
12 =head1 NAME
13
14 App::Rgit::Command - Base class for App::Rgit commands.
15
16 =head1 VERSION
17
18 Version 0.05
19
20 =cut
21
22 our $VERSION = '0.05';
23
24 =head1 DESCRIPTION
25
26 Base class for L<App::Rgit> commands.
27
28 This is an internal class to L<rgit>.
29
30 =head1 METHODS
31
32 =head2 C<< new cmd => $cmd, args => \@args >>
33
34 Creates a new command object for C<$cmd> that is bound to be called with arguments C<@args>.
35
36 =cut
37
38 my %commands;
39 __PACKAGE__->action($_ => 'Once') for qw/daemon gui help init version/, ' ';
40
41 sub new {
42  my ($class, %args) = &validate;
43  my $cmd = $args{cmd};
44  $cmd = ' ' unless defined $cmd;
45  my $action = $class->action($cmd);
46  if ($class eq __PACKAGE__) {
47   $class = $action;
48  } else {
49   croak "Command $cmd should be executed as a $action"
50                                unless $class->isa($action);
51  }
52  eval "require $action; 1" or croak "Couldn't load $action: $@";
53  $class->SUPER::new(
54   cmd    => $cmd,
55   args   => $args{args} || [ ],
56   policy => $args{policy},
57  );
58 }
59
60 =head2 C<< action $cmd [ => $pkg ] >>
61
62 If C<$pkg> is supplied, handles command C<$cmd> with C<$pkg> objects.
63 Otherwise, returns the current class for C<$cmd>.
64
65 =cut
66
67 sub action {
68  my ($self, $cmd, $pkg) = @_;
69  if (not defined $cmd) {
70   return unless defined $self and ref $self and $self->isa(__PACKAGE__);
71   $cmd = $self->cmd;
72  }
73  unless (defined $pkg) {
74   return __PACKAGE__ . '::Each' unless defined $commands{$cmd};
75   return $commands{$cmd}
76  }
77  $pkg = __PACKAGE__ . '::' . $pkg unless $pkg =~ /:/;
78  $commands{$cmd} = $pkg;
79 }
80
81 =head2 C<report $conf, $repo, $status>
82
83 Reports that the execution of the command in C<$repo> exited with C<status> to the current command's policy.
84 Returns what the policy callback returned, which should be one of the policy codes listed in C<App::Rgit::Utils>.
85
86 =cut
87
88 sub report {
89  my ($self) = @_;
90  my $cb = $self->policy;
91  return $_[3] ? LAST : NEXT unless $cb;
92  my $code = $cb->(@_);
93  return defined $code ? $code : NEXT;
94 }
95
96 =head2 C<cmd>
97
98 =head2 C<args>
99
100 =head2 C<policy>
101
102 Accessors.
103
104 =head2 C<run $conf>
105
106 Runs the command with a L<App::Rgit::Config> configuration object.
107 Handles back the code to return to the system and the last policy.
108 Implemented in subclasses.
109
110 =head1 SEE ALSO
111
112 L<rgit>.
113
114 =head1 AUTHOR
115
116 Vincent Pit, C<< <perl at profvince.com> >>, L<http://profvince.com>.
117    
118 You can contact me by mail or on C<irc.perl.org> (vincent).
119
120 =head1 BUGS
121
122 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.
123
124 =head1 SUPPORT
125
126 You can find documentation for this module with the perldoc command.
127
128     perldoc App::Rgit::Command
129
130 =head1 COPYRIGHT & LICENSE
131
132 Copyright 2008 Vincent Pit, all rights reserved.
133
134 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
135
136 =cut
137
138 1; # End of App::Rgit::Command