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