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/;
   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;
  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   push @tries, "$dir.git" unless $dir =~ /\.git$/;
  51   push @tries, catdir($dir, '.git') unless $dir eq '.git';
  52   for (@tries) {
  53    if (-d $_ && -d "$_/refs" and -d "$_/objects" and -e "$_/HEAD") {
  54     $repo = $_;
  55     last;
  56    }
  57   }
  58   return unless defined $repo;
  59   my @chunks = splitdir($repo);
  60   my $last = pop @chunks;
  61   if ($last eq '.git') {
  62    $bare = 0;
  63    $name = $chunks[-1];
  64    $work = catdir(@chunks);
  65   } else {
  66    $bare = 1;
  67    ($name) = $last =~ /(.*)\.git$/;
  68    $work = $repo;
  69   }
  70  }
  71  $class->SUPER::new(
  72   fake => !!$args{fake},
  73   repo => $repo,
  74   bare => $bare,
  75   name => $name,
  76   work => $work,
  77  );
  78 }
  79
  80 =head2 C<chdir>
  81
  82 C<chdir> into the repository's directory.
  83
  84 =cut
  85
  86 sub chdir {
  87  my $self = shift;
  88  my $dir = $self->work;
  89  chdir $dir or do {
  90   warn "Couldn't chdir into $dir: $!";
  91   return;
  92  };
  93  return 1;
  94 }
  95
  96 =head2 C<run $conf, @args>
  97
  98 Runs C<git @args> on the repository for the L<App::Rgit::Config> configuration C<$conf>.
  99 When the repository isn't fake, the format substitutions applies to C<@args> elements.
 100 Returns the exit code.
 101
 102 =cut
 103
 104 sub _abs2rel {
 105  my $a = &abs2rel;
 106  $a = $_[0] unless defined $a;
 107  $a;
 108 }
 109
 110 sub run {
 111  my $self = shift;
 112  my $conf = shift;
 113  return unless $conf->isa('App::Rgit::Config');
 114  my @args = @_;
 115  unless ($self->fake) {
 116   my %escapes = (
 117    '^' => sub { '^' },
 118    'n' => sub { $self->name },
 119    'g' => sub { _abs2rel($self->repo, $conf->root) },
 120    'G' => sub { $self->repo },
 121    'w' => sub { _abs2rel($self->work, $conf->root) },
 122    'W' => sub { $self->work },
 123    'b' => sub { _abs2rel($self->bare ? $self->repo : $self->work . '.git', $conf->root) },
 124    'B' => sub { $self->bare ? $self->repo : $self->work . '.git' },
 125    'R' => sub { $conf->root },
 126   );
 127   s/\^([\^ngGwWbBR])/$escapes{$1}->()/eg for @args;
 128  }
 129  system { $conf->git } $conf->git, @args;
 130 }
 131
 132 =head2 C<fake>
 133
 134 =head2 C<repo>
 135
 136 =head2 C<bare>
 137
 138 =head2 C<name>
 139
 140 =head2 C<work>
 141
 142 Accessors.
 143
 144 =head1 SEE ALSO
 145
 146 L<rgit>.
 147
 148 =head1 AUTHOR
 149
 150 Vincent Pit, C<< <perl at profvince.com> >>, L<http://profvince.com>.
 151
 152 You can contact me by mail or on C<irc.perl.org> (vincent).
 153
 154 =head1 BUGS
 155
 156 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.
 157
 158 =head1 SUPPORT
 159
 160 You can find documentation for this module with the perldoc command.
 161
 162     perldoc App::Rgit::Repository
 163
 164 =head1 COPYRIGHT & LICENSE
 165
 166 Copyright 2008 Vincent Pit, all rights reserved.
 167
 168 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
 169
 170 =cut
 171
 172 1; # End of App::Rgit::Repository