Repository.pm

   1 package App::Rgit::Repository;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Cwd qw/cwd abs_path/;
   7 use File::Spec::Functions qw/canonpath catdir splitdir abs2rel file_name_is_absolute/;
   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  $dir    = abs_path $dir if defined $dir and not file_name_is_absolute $dir;
  52  $dir    = cwd       unless defined $dir;
  53  $dir    = canonpath $dir;
  54
  55  my ($repo, $bare, $name, $work);
  56  if ($args{fake}) {
  57   $repo = $work = $dir;
  58  } else {
  59   return unless -d $dir
  60             and -d "$dir/refs"
  61             and -d "$dir/objects"
  62             and -e "$dir/HEAD";
  63
  64   my @chunks = splitdir $dir;
  65   my $last   = pop @chunks;
  66   return unless defined $last;
  67
  68   if ($last eq '.git') {
  69    $bare = 0;
  70    $name = $chunks[-1];
  71    $work = catdir @chunks;
  72   } elsif ($last =~ /(.+)\.git$/) {
  73    $bare = 1;
  74    $name = $1;
  75    $work = catdir @chunks, $last;
  76   } else {
  77    return;
  78   }
  79
  80   $repo = $dir;
  81  }
  82
  83  bless {
  84   fake => !!$args{fake},
  85   repo => $repo,
  86   bare => $bare,
  87   name => $name,
  88   work => $work,
  89  }, $class;
  90 }
  91
  92 =head2 C<chdir>
  93
  94 C<chdir> into the repository's directory.
  95
  96 =cut
  97
  98 sub chdir {
  99  my $self = shift;
 100  my $dir = $self->work;
 101  chdir $dir or do {
 102   warn "Couldn't chdir into $dir: $!";
 103   return;
 104  };
 105  return 1;
 106 }
 107
 108 =head2 C<run $conf, @args>
 109
 110 Runs C<git @args> on the repository for the L<App::Rgit::Config> configuration C<$conf>.
 111 When the repository isn't fake, the format substitutions applies to C<@args> elements.
 112 Returns the exit code.
 113
 114 =cut
 115
 116 sub _abs2rel {
 117  my $a = &abs2rel;
 118  $a = $_[0] unless defined $a;
 119  $a;
 120 }
 121
 122 my %escapes = (
 123  '%' => sub { '%' },
 124  'n' => sub { shift->name },
 125  'g' => sub { _abs2rel(shift->repo, shift->root) },
 126  'G' => sub { shift->repo },
 127  'w' => sub { _abs2rel(shift->work, shift->root) },
 128  'W' => sub { shift->work },
 129  'b' => sub {
 130   my ($self, $conf) = @_;
 131   _abs2rel($self->bare ? $self->repo : $self->work . '.git', $conf->root)
 132  },
 133  'B' => sub { $_[0]->bare ? $_[0]->repo : $_[0]->work . '.git' },
 134  'R' => sub { $_[1]->root },
 135 );
 136 my $e = quotemeta join '', keys %escapes;
 137 $e = "[$e]";
 138
 139 sub run {
 140  my $self = shift;
 141  my $conf = shift;
 142  return unless $conf->isa('App::Rgit::Config');
 143  my @args = @_;
 144  unless ($self->fake) {
 145   s/%($e)/$escapes{$1}->($self, $conf)/eg for @args;
 146  }
 147  unshift @args, $conf->git;
 148  $conf->info('Executing "', join(' ', @args), '" into ', $self->work, "\n");
 149  {
 150   local $ENV{GIT_DIR} = $self->repo if exists $ENV{GIT_DIR};
 151   local $ENV{GIT_EXEC_PATH} = $conf->git if exists $ENV{GIT_EXEC_PATH};
 152   system { $args[0] } @args;
 153  }
 154  if ($? == -1) {
 155   $conf->crit("Failed to execute git: $!\n");
 156   return;
 157  }
 158  my $ret;
 159  $ret = WEXITSTATUS($?) if WIFEXITED($?);
 160  my $sig;
 161  if (WIFSIGNALED($?)) {
 162   $sig = WTERMSIG($?);
 163   $conf->warn("git died with signal $sig\n");
 164   if ($sig == SIGINT || $sig == SIGQUIT) {
 165    $conf->err("Aborting\n");
 166    exit $sig;
 167   }
 168  } elsif ($ret) {
 169   $conf->info("git returned $ret\n");
 170  }
 171  return wantarray ? ($ret, $sig) : $ret;
 172 }
 173
 174 =head2 C<fake>
 175
 176 =head2 C<repo>
 177
 178 =head2 C<bare>
 179
 180 =head2 C<name>
 181
 182 =head2 C<work>
 183
 184 Read-only accessors.
 185
 186 =cut
 187
 188 BEGIN {
 189  eval "sub $_ { \$_[0]->{$_} }" for qw/fake repo bare name work/;
 190 }
 191
 192 =head1 SEE ALSO
 193
 194 L<rgit>.
 195
 196 =head1 AUTHOR
 197
 198 Vincent Pit, C<< <perl at profvince.com> >>, L<http://profvince.com>.
 199
 200 You can contact me by mail or on C<irc.perl.org> (vincent).
 201
 202 =head1 BUGS
 203
 204 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.
 205
 206 =head1 SUPPORT
 207
 208 You can find documentation for this module with the perldoc command.
 209
 210     perldoc App::Rgit::Repository
 211
 212 =head1 COPYRIGHT & LICENSE
 213
 214 Copyright 2008-2009 Vincent Pit, all rights reserved.
 215
 216 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
 217
 218 =cut
 219
 220 1; # End of App::Rgit::Repository