lib/App/Rgit/Repository.pm

   1 package App::Rgit::Repository;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Cwd        (); # cwd, abs_path
   7 use File::Spec (); # canonpath, catdir, splitdir, abs2rel
   8 use POSIX      (); # WIFEXITED WEXITSTATUS WIFSIGNALED WTERMSIG SIGINT SIGQUIT
   9
  10 my ($WIFEXITED, $WEXITSTATUS, $WIFSIGNALED, $WTERMSIG);
  11
  12 BEGIN {
  13  $WIFEXITED   = eval { POSIX::WIFEXITED(0);   1 } ? \&POSIX::WIFEXITED
  14                                                   : sub { 1 };
  15  $WEXITSTATUS = eval { POSIX::WEXITSTATUS(0); 1 } ? \&POSIX::WEXITSTATUS
  16                                                   : sub { shift() >> 8 };
  17  $WIFSIGNALED = eval { POSIX::WIFSIGNALED(0); 1 } ? \&POSIX::WIFSIGNALED
  18                                                   : sub { shift() & 127 };
  19  $WTERMSIG    = eval { POSIX::WTERMSIG(0);    1 } ? \&POSIX::WTERMSIG
  20                                                   : sub { shift() & 127 };
  21 }
  22
  23 =head1 NAME
  24
  25 App::Rgit::Repository - Class representing a Git repository.
  26
  27 =head1 VERSION
  28
  29 Version 0.06
  30
  31 =cut
  32
  33 our $VERSION = '0.06';
  34
  35 =head1 DESCRIPTION
  36
  37 Class representing a Git repository.
  38
  39 This is an internal class to L<rgit>.
  40
  41 =head1 METHODS
  42
  43 =head2 C<< new dir => $dir [, fake => 1 ] >>
  44
  45 Creates a new repository starting from C<$dir>.
  46 If the C<fake> option is passed, C<$dir> isn't checked to be a valid C<git> repository.
  47
  48 =cut
  49
  50 sub new {
  51  my $class = shift;
  52  $class = ref $class || $class;
  53
  54  my %args = @_;
  55
  56  my $dir = $args{dir};
  57  if (defined $dir) {
  58   $dir = Cwd::abs_path($dir);
  59  } else {
  60   $dir = Cwd::cwd;
  61  }
  62  $dir = File::Spec->canonpath($dir);
  63
  64  my ($repo, $bare, $name, $work);
  65  if ($args{fake}) {
  66   $repo = $work = $dir;
  67  } else {
  68   return unless -d $dir
  69             and -d "$dir/refs"
  70             and -d "$dir/objects"
  71             and -e "$dir/HEAD";
  72
  73   my @chunks = File::Spec->splitdir($dir);
  74   my $last   = pop @chunks;
  75   return unless defined $last;
  76
  77   if (@chunks and $last eq '.git') {
  78    $bare = 0;
  79    $name = $chunks[-1];
  80    $work = File::Spec->catdir(@chunks);
  81   } elsif ($last =~ /(.+)\.git$/) {
  82    $bare = 1;
  83    $name = $1;
  84    $work = File::Spec->catdir(@chunks, $last);
  85   } else {
  86    return;
  87   }
  88
  89   $repo = $dir;
  90  }
  91
  92  bless {
  93   fake => !!$args{fake},
  94   repo => $repo,
  95   bare => $bare,
  96   name => $name,
  97   work => $work,
  98  }, $class;
  99 }
 100
 101 =head2 C<chdir>
 102
 103 C<chdir> into the repository's directory.
 104
 105 =cut
 106
 107 sub chdir {
 108  my $self = shift;
 109  my $dir = $self->work;
 110  chdir $dir or do {
 111   warn "Couldn't chdir into $dir: $!";
 112   return;
 113  };
 114  return 1;
 115 }
 116
 117 =head2 C<run $conf, @args>
 118
 119 Runs C<git @args> on the repository for the L<App::Rgit::Config> configuration C<$conf>.
 120 When the repository isn't fake, the format substitutions applies to C<@args> elements.
 121 Returns the exit code.
 122
 123 =cut
 124
 125 my $abs2rel = sub {
 126  my $a = File::Spec->abs2rel(@_);
 127  $a = $_[0] unless defined $a;
 128  $a;
 129 };
 130
 131 my %escapes = (
 132  '%' => sub { '%' },
 133  'n' => sub { shift->name },
 134  'g' => sub { $abs2rel->(shift->repo, shift->root) },
 135  'G' => sub { shift->repo },
 136  'w' => sub { $abs2rel->(shift->work, shift->root) },
 137  'W' => sub { shift->work },
 138  'b' => sub {
 139   my ($self, $conf) = @_;
 140   $abs2rel->(
 141    $self->bare ? $self->repo : $self->work . '.git',
 142    $conf->root
 143   );
 144  },
 145  'B' => sub { $_[0]->bare ? $_[0]->repo : $_[0]->work . '.git' },
 146  'R' => sub { $_[1]->root },
 147 );
 148 my $e = quotemeta join '', keys %escapes;
 149 $e = "[$e]";
 150
 151 sub run {
 152  my $self = shift;
 153  my $conf = shift;
 154  return unless $conf->isa('App::Rgit::Config');
 155
 156  my @args = @_;
 157
 158  unless ($self->fake) {
 159   s/%($e)/$escapes{$1}->($self, $conf)/eg for @args;
 160  }
 161
 162  unshift @args, $conf->git;
 163  $conf->info('Executing "', join(' ', @args), '" into ', $self->work, "\n");
 164
 165  {
 166   local $ENV{GIT_DIR} = $self->repo if exists $ENV{GIT_DIR};
 167   local $ENV{GIT_EXEC_PATH} = $conf->git if exists $ENV{GIT_EXEC_PATH};
 168   system { $args[0] } @args;
 169  }
 170
 171  if ($? == -1) {
 172   $conf->crit("Failed to execute git: $!\n");
 173   return;
 174  }
 175
 176  my $ret;
 177  $ret = $WEXITSTATUS->($?) if $WIFEXITED->($?);
 178  my $sig;
 179  if ($WIFSIGNALED->($?)) {
 180   $sig = $WTERMSIG->($?);
 181   $conf->warn("git died with signal $sig\n");
 182   if ($sig == POSIX::SIGINT || $sig == POSIX::SIGQUIT) {
 183    $conf->err("Aborting\n");
 184    exit $sig;
 185   }
 186  } elsif ($ret) {
 187   $conf->info("git returned $ret\n");
 188  }
 189
 190  return wantarray ? ($ret, $sig) : $ret;
 191 }
 192
 193 =head2 C<fake>
 194
 195 =head2 C<repo>
 196
 197 =head2 C<bare>
 198
 199 =head2 C<name>
 200
 201 =head2 C<work>
 202
 203 Read-only accessors.
 204
 205 =cut
 206
 207 BEGIN {
 208  eval "sub $_ { \$_[0]->{$_} }" for qw/fake repo bare name work/;
 209 }
 210
 211 =head1 SEE ALSO
 212
 213 L<rgit>.
 214
 215 =head1 AUTHOR
 216
 217 Vincent Pit, C<< <perl at profvince.com> >>, L<http://profvince.com>.
 218
 219 You can contact me by mail or on C<irc.perl.org> (vincent).
 220
 221 =head1 BUGS
 222
 223 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>.
 224 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
 225
 226 =head1 SUPPORT
 227
 228 You can find documentation for this module with the perldoc command.
 229
 230     perldoc App::Rgit::Repository
 231
 232 =head1 COPYRIGHT & LICENSE
 233
 234 Copyright 2008,2009,2010 Vincent Pit, all rights reserved.
 235
 236 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
 237
 238 =cut
 239
 240 1; # End of App::Rgit::Repository