]> git.vpit.fr Git - perl/modules/rgit.git/blob - App/Rgit/Repository.pm
Update VPIT::TestHelpers to 15e8aee3
[perl/modules/rgit.git] / 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