]> git.vpit.fr Git - perl/modules/rgit.git/blob - lib/App/Rgit/Command.pm
Improve the class delegation mechanism in App::Rgit::Command, and test it
[perl/modules/rgit.git] / lib / 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 cwd_as_repo args repos/;
9
10 use App::Rgit::Utils qw/validate/;
11 use App::Rgit::Repository;
12
13 =head1 NAME
14
15 App::Rgit::Command - Base class for App::Rgit commands.
16
17 =head1 VERSION
18
19 Version 0.01
20
21 =cut
22
23 our $VERSION = '0.01';
24
25 =head1 DESCRIPTION
26
27 Base class for L<App::Rgit> commands.
28
29 This is an internal class to L<rgit>.
30
31 =head1 METHODS
32
33 =head2 C<< new cmd => $cmd, args => \@args, repos => \@repos >>
34
35 Creates a new command object for C<$cmd> that will called for all repositories C<@repos> with arguments C<@args>.
36
37 =cut
38
39 my %commands;
40 __PACKAGE__->action($_ => 'Once') for qw/version help daemon init/, ' ';
41
42 sub new {
43  my ($class, %args) = &validate;
44  my $cmd = $args{cmd};
45  $cmd = ' ' unless defined $cmd;
46  my $action = $class->action($cmd);
47  if ($class eq __PACKAGE__) {
48   $class = $action;
49  } else {
50   croak "Command $cmd should be executed as a $action"
51                                unless $class->isa($action);
52  }
53  eval "require $action; 1" or croak "Couldn't load $action: $@";
54  my $r = App::Rgit::Repository->new(fake => 1);
55  return unless defined $r;
56  $class->SUPER::new(
57   cmd         => $cmd,
58   args        => $args{args} || [ ],
59   repos       => $args{repos},
60   cwd_as_repo => $r,
61  );
62 }
63
64 =head2 C<< action $cmd [ => $pkg ] >>
65
66 If C<$pkg> is supplied, handles command C<$cmd> with C<$pkg> objects.
67 Otherwise, returns the current class for C<$cmd>.
68
69 =cut
70
71 sub action {
72  my ($self, $cmd, $pkg) = @_;
73  $cmd = $self->cmd if !defined $cmd
74                    and defined $self and $self->isa(__PACKAGE__);
75  return unless defined $cmd;
76  unless (defined $pkg) {
77   return __PACKAGE__ . '::Each' unless defined $commands{$cmd};
78   return $commands{$cmd}
79  }
80  $pkg = __PACKAGE__ . '::' . $pkg unless $pkg =~ /:/;
81  $commands{$cmd} = $pkg;
82 }
83
84 =head2 C<cmd>
85
86 =head2 C<cwd_as_repo>
87
88 =head2 C<args>
89
90 =head2 C<repos>
91
92 Accessors.
93
94 =head2 C<run $conf>
95
96 Runs the command with a L<App::Rgit::Config> configuration object.
97 Stops as soon as one of the executed commands fails, and returns the corresponding exit code.
98 Returns zero when all went fine.
99 Implemented in subclasses.
100
101 =head1 SEE ALSO
102
103 L<rgit>.
104
105 =head1 AUTHOR
106
107 Vincent Pit, C<< <perl at profvince.com> >>, L<http://profvince.com>.
108    
109 You can contact me by mail or on C<irc.perl.org> (vincent).
110
111 =head1 BUGS
112
113 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.
114
115 =head1 SUPPORT
116
117 You can find documentation for this module with the perldoc command.
118
119     perldoc App::Rgit::Command
120
121 =head1 COPYRIGHT & LICENSE
122
123 Copyright 2008 Vincent Pit, all rights reserved.
124
125 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
126
127 =cut
128
129 1; # End of App::Rgit::Command