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