]> git.vpit.fr Git - perl/modules/rgit.git/blob - Repository.pm
15cf6274b74a1641b610ac5bfd123897b81302fd
[perl/modules/rgit.git] / 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