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 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.03
  19
  20 =cut
  21
  22 our $VERSION = '0.03';
  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 =cut
  84
  85 sub report {
  86  my ($self) = @_;
  87  my $cb = $self->policy;
  88  return $_[3] ? LAST : NEXT unless $cb;
  89  my $code = $cb->(@_);
  90  return defined $code ? $code : NEXT;
  91 }
  92
  93 =head2 C<cmd>
  94
  95 =head2 C<args>
  96
  97 =head2 C<policy>
  98
  99 Accessors.
 100
 101 =head2 C<run $conf>
 102
 103 Runs the command with a L<App::Rgit::Config> configuration object.
 104 Stops as soon as one of the executed commands fails, and returns the corresponding exit code.
 105 Returns zero when all went fine.
 106 Implemented in subclasses.
 107
 108 =head1 SEE ALSO
 109
 110 L<rgit>.
 111
 112 =head1 AUTHOR
 113
 114 Vincent Pit, C<< <perl at profvince.com> >>, L<http://profvince.com>.
 115
 116 You can contact me by mail or on C<irc.perl.org> (vincent).
 117
 118 =head1 BUGS
 119
 120 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.
 121
 122 =head1 SUPPORT
 123
 124 You can find documentation for this module with the perldoc command.
 125
 126     perldoc App::Rgit::Command
 127
 128 =head1 COPYRIGHT & LICENSE
 129
 130 Copyright 2008 Vincent Pit, all rights reserved.
 131
 132 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
 133
 134 =cut
 135
 136 1; # End of App::Rgit::Command