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