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.04
  19
  20 =cut
  21
  22 our $VERSION = '0.04';
  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 Handles back the code to return to the system and the last policy.
 105 Implemented in subclasses.
 106
 107 =head1 SEE ALSO
 108
 109 L<rgit>.
 110
 111 =head1 AUTHOR
 112
 113 Vincent Pit, C<< <perl at profvince.com> >>, L<http://profvince.com>.
 114
 115 You can contact me by mail or on C<irc.perl.org> (vincent).
 116
 117 =head1 BUGS
 118
 119 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.
 120
 121 =head1 SUPPORT
 122
 123 You can find documentation for this module with the perldoc command.
 124
 125     perldoc App::Rgit::Command
 126
 127 =head1 COPYRIGHT & LICENSE
 128
 129 Copyright 2008 Vincent Pit, all rights reserved.
 130
 131 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
 132
 133 =cut
 134
 135 1; # End of App::Rgit::Command