X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FApp%2FRgit%2FRepository.pm;h=0ca5e940a692537d136620776cecb421e42461bb;hb=a35a1fae17b8e75696ef1e5474aaa99222594a6a;hp=5476ad4c3268778d33ce2ab6e4ae9a3daff25262;hpb=76ba389e3711e8f254aea83f9b3b7b221c0517a8;p=perl%2Fmodules%2Frgit.git diff --git a/lib/App/Rgit/Repository.pm b/lib/App/Rgit/Repository.pm index 5476ad4..0ca5e94 100644 --- a/lib/App/Rgit/Repository.pm +++ b/lib/App/Rgit/Repository.pm @@ -3,8 +3,8 @@ package App::Rgit::Repository; use strict; use warnings; -use Cwd qw/cwd abs_path/; -use File::Spec::Functions qw/canonpath catdir splitdir abs2rel file_name_is_absolute/; +use Cwd qw/cwd abs_path/; +use File::Spec::Functions qw/canonpath catdir splitdir abs2rel/; use POSIX qw/WIFEXITED WEXITSTATUS WIFSIGNALED WTERMSIG SIGINT SIGQUIT/; BEGIN { @@ -14,8 +14,6 @@ BEGIN { *WIFSIGNALED = sub { shift() & 127 } unless eval { WIFSIGNALED(0); 1 }; } -use App::Rgit::Utils qw/validate/; - =head1 NAME App::Rgit::Repository - Class representing a Git repository. @@ -44,39 +42,47 @@ If the C option is passed, C<$dir> isn't checked to be a valid C repo =cut sub new { - my ($class, %args) = &validate; + my $class = shift; + $class = ref $class || $class; + + my %args = @_; + my $dir = $args{dir}; - $dir = abs_path $dir if defined $dir and not file_name_is_absolute $dir; - $dir = cwd unless defined $dir; + if (defined $dir) { + $dir = abs_path $dir; + } else { + $dir = cwd; + } + $dir = canonpath $dir; + my ($repo, $bare, $name, $work); if ($args{fake}) { $repo = $work = $dir; - } else { - my @tries = ($dir); + } else { + return unless -d $dir + and -d "$dir/refs" + and -d "$dir/objects" + and -e "$dir/HEAD"; + my @chunks = splitdir $dir; - my $last = pop @chunks; - push @tries, "$dir.git" unless $last =~ /\.git$/; - push @tries, catdir($dir, '.git') unless $last eq '.git'; - for (@tries) { - if (-d $_ && -d "$_/refs" and -d "$_/objects" and -e "$_/HEAD") { - $repo = $_; - last; - } - } - return unless defined $repo; - $repo = canonpath $repo; - @chunks = splitdir $repo; - $last = pop @chunks; + my $last = pop @chunks; + return unless defined $last; + if ($last eq '.git') { $bare = 0; $name = $chunks[-1]; $work = catdir @chunks; - } else { + } elsif ($last =~ /(.+)\.git$/) { $bare = 1; - ($name) = $last =~ /(.*)\.git$/; - $work = $repo; + $name = $1; + $work = catdir @chunks, $last; + } else { + return; } + + $repo = $dir; } + bless { fake => !!$args{fake}, repo => $repo, @@ -193,7 +199,7 @@ L. =head1 AUTHOR Vincent Pit, C<< >>, L. - + You can contact me by mail or on C (vincent). =head1 BUGS @@ -208,7 +214,7 @@ You can find documentation for this module with the perldoc command. =head1 COPYRIGHT & LICENSE -Copyright 2008-2009 Vincent Pit, all rights reserved. +Copyright 2008,2009,2010 Vincent Pit, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.