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