X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FApp%2FRgit%2FConfig.pm;h=903b3e4f9a433055274f96f511dfed03ed9039f1;hb=df425e04a0fe374b7e1906e417f8238af257742f;hp=212fa334628f79f93c14db637a76ceaf67b73c76;hpb=f5feb13a168183b64735058599b7fbc7c668fc43;p=perl%2Fmodules%2Frgit.git diff --git a/lib/App/Rgit/Config.pm b/lib/App/Rgit/Config.pm index 212fa33..903b3e4 100644 --- a/lib/App/Rgit/Config.pm +++ b/lib/App/Rgit/Config.pm @@ -3,13 +3,14 @@ package App::Rgit::Config; use strict; use warnings; -use Carp qw/croak/; -use Cwd qw/abs_path/; -use File::Spec::Functions qw/file_name_is_absolute/; +use Carp (); # confess +use Cwd (); # cwd, abs_path +use File::Spec (); # canonpath, catfile, path -use Object::Tiny qw/root git/; +use App::Rgit::Repository; +use App::Rgit::Utils qw/:levels/; -use App::Rgit::Utils qw/validate/; +use constant IS_WIN32 => $^O eq 'MSWin32'; =head1 NAME @@ -17,7 +18,11 @@ App::Rgit::Config - Base class for App::Rgit configurations. =head1 VERSION -Version 0.01 +Version 0.06 + +=cut + +our $VERSION = '0.06'; =head1 DESCRIPTION @@ -34,26 +39,104 @@ Creates a new configuration object based on the root directory C<$root> and usin =cut sub new { - my ($class, %args) = &validate; - my $root = $args{root}; - return unless defined $root and -d $root; - $root = abs_path $root unless file_name_is_absolute $root; - return unless defined $args{git} and -x $args{git}; - my $conf = 'App::Rgit::Config::Default'; - eval "require $conf; 1" or croak "Couldn't load $conf: $@"; - $conf->SUPER::new( - root => $args{root}, - git => $args{git}, + my $class = shift; + $class = ref $class || $class; + + my %args = @_; + + my $root = defined $args{root} + ? $args{root} + : defined $ENV{GIT_DIR} + ? $ENV{GIT_DIR} + : Cwd::cwd; + Carp::confess("Invalid root directory") unless -d $root; + $root = File::Spec->canonpath(Cwd::abs_path($root)); + + my $git; + my @candidates = ( + defined $args{git} + ? $args{git} + : defined $ENV{GIT_EXEC_PATH} + ? $ENV{GIT_EXEC_PATH} + : map File::Spec->catfile($_, 'git'), File::Spec->path ); + if (IS_WIN32) { + my @acc; + for my $c (@candidates) { + push @acc, $c, map "$c.$_", qw/exe com bat cmd/; + } + @candidates = @acc; + } + for my $c (@candidates) { + if (-x $c) { + $git = $c; + last; + } + } + Carp::confess("Couldn't find a proper git executable") unless defined $git; + $git = File::Spec->canonpath(Cwd::abs_path($git)); + + my $conf = 'App::Rgit::Config::Default'; + eval "require $conf; 1" or Carp::confess("Couldn't load $conf: $@"); + + my $r = App::Rgit::Repository->new(fake => 1); + return unless defined $r; + + bless { + root => $root, + git => $git, + cwd_repo => $r, + debug => defined $args{debug} ? int $args{debug} : WARN, + }, $conf; +} + +=head2 C + +=head2 C + +=head2 C + +=head2 C + +Notifies a message C<$msg> of the corresponding level. + +=cut + +sub _notify { + my $self = shift; + my $level = shift; + if ($self->debug >= $level) { + print STDERR @_; + return 1; + } + return 0; } +sub info { shift->_notify(INFO, @_) } + +sub warn { shift->_notify(WARN, @_) } + +sub err { shift->_notify(ERR, @_) } + +sub crit { shift->_notify(CRIT, @_) } + =head2 C =head2 C =head2 C -Accessors. +=head2 C + +=head2 C + +Read-only accessors. + +=cut + +BEGIN { + eval "sub $_ { \$_[0]->{$_} }" for qw/root git cwd_repo debug/; +} =head1 SEE ALSO @@ -62,12 +145,13 @@ L. =head1 AUTHOR Vincent Pit, C<< >>, L. - + You can contact me by mail or on C (vincent). =head1 BUGS -Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. +Please report any bugs or feature requests to C, or through the web interface at L. +I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT @@ -77,7 +161,7 @@ You can find documentation for this module with the perldoc command. =head1 COPYRIGHT & LICENSE -Copyright 2008 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.