1 package App::Rgit::Repository;
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/;
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 };
17 use Object::Tiny qw/fake repo bare name work/;
19 use App::Rgit::Utils qw/validate/;
23 App::Rgit::Repository - Class representing a Git repository.
31 our $VERSION = '0.06';
35 Class representing a Git repository.
37 This is an internal class to L<rgit>.
41 =head2 C<< new dir => $dir [, fake => 1 ] >>
43 Creates a new repository starting from C<$dir>.
44 If the C<fake> option is passed, C<$dir> isn't checked to be a valid C<git> repository.
49 my ($class, %args) = &validate;
51 $dir = abs_path $dir if defined $dir and not file_name_is_absolute $dir;
52 $dir = cwd unless defined $dir;
53 my ($repo, $bare, $name, $work);
58 my @chunks = splitdir $dir;
59 my $last = pop @chunks;
60 push @tries, "$dir.git" unless $last =~ /\.git$/;
61 push @tries, catdir($dir, '.git') unless $last eq '.git';
63 if (-d $_ && -d "$_/refs" and -d "$_/objects" and -e "$_/HEAD") {
68 return unless defined $repo;
69 $repo = canonpath $repo;
70 @chunks = splitdir $repo;
72 if ($last eq '.git') {
75 $work = catdir @chunks;
78 ($name) = $last =~ /(.*)\.git$/;
83 fake => !!$args{fake},
93 C<chdir> into the repository's directory.
99 my $dir = $self->work;
101 warn "Couldn't chdir into $dir: $!";
107 =head2 C<run $conf, @args>
109 Runs C<git @args> on the repository for the L<App::Rgit::Config> configuration C<$conf>.
110 When the repository isn't fake, the format substitutions applies to C<@args> elements.
111 Returns the exit code.
117 $a = $_[0] unless defined $a;
123 'n' => sub { shift->name },
124 'g' => sub { _abs2rel(shift->repo, shift->root) },
125 'G' => sub { shift->repo },
126 'w' => sub { _abs2rel(shift->work, shift->root) },
127 'W' => sub { shift->work },
129 my ($self, $conf) = @_;
130 _abs2rel($self->bare ? $self->repo : $self->work . '.git', $conf->root)
132 'B' => sub { $_[0]->bare ? $_[0]->repo : $_[0]->work . '.git' },
133 'R' => sub { $_[1]->root },
135 my $e = quotemeta join '', keys %escapes;
141 return unless $conf->isa('App::Rgit::Config');
143 unless ($self->fake) {
144 s/%($e)/$escapes{$1}->($self, $conf)/eg for @args;
146 unshift @args, $conf->git;
147 $conf->info('Executing "', join(' ', @args), '" into ', $self->work, "\n");
149 local $ENV{GIT_DIR} = $self->repo if exists $ENV{GIT_DIR};
150 local $ENV{GIT_EXEC_PATH} = $conf->git if exists $ENV{GIT_EXEC_PATH};
151 system { $args[0] } @args;
154 $conf->crit("Failed to execute git: $!\n");
158 $ret = WEXITSTATUS($?) if WIFEXITED($?);
160 if (WIFSIGNALED($?)) {
162 $conf->warn("git died with signal $sig\n");
163 if ($sig == SIGINT || $sig == SIGQUIT) {
164 $conf->err("Aborting\n");
168 $conf->info("git returned $ret\n");
170 return wantarray ? ($ret, $sig) : $ret;
191 Vincent Pit, C<< <perl at profvince.com> >>, L<http://profvince.com>.
193 You can contact me by mail or on C<irc.perl.org> (vincent).
197 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.
201 You can find documentation for this module with the perldoc command.
203 perldoc App::Rgit::Repository
205 =head1 COPYRIGHT & LICENSE
207 Copyright 2008-2009 Vincent Pit, all rights reserved.
209 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
213 1; # End of App::Rgit::Repository