X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FApp%2FRgit%2FConfig.pm;h=23874c5f0784a94c8d19508f1459d7011ac477c6;hb=a2a9110d666dcd61af2573a7ad977cf441587d21;hp=ae850758197bd429fa540b8341ded6db55f187e0;hpb=f00c02ec880d4c182584fc4f046df634df67401f;p=perl%2Fmodules%2Frgit.git diff --git a/lib/App/Rgit/Config.pm b/lib/App/Rgit/Config.pm index ae85075..23874c5 100644 --- a/lib/App/Rgit/Config.pm +++ b/lib/App/Rgit/Config.pm @@ -3,14 +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 Object::Tiny qw/root git cwd_repo/; +use Carp (); # confess +use Cwd (); # cwd +use File::Spec (); # canonpath, catfile, path use App::Rgit::Repository; -use App::Rgit::Utils qw/validate/; +use App::Rgit::Utils qw/:levels/; # :levels, abs_path + +use constant IS_WIN32 => $^O eq 'MSWin32'; =head1 NAME @@ -18,11 +18,11 @@ App::Rgit::Config - Base class for App::Rgit configurations. =head1 VERSION -Version 0.02 +Version 0.07 =cut -our $VERSION = '0.02'; +our $VERSION = '0.07'; =head1 DESCRIPTION @@ -39,22 +39,87 @@ 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 $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(App::Rgit::Utils::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(App::Rgit::Utils::abs_path($git)); + my $conf = 'App::Rgit::Config::Default'; - eval "require $conf; 1" or croak "Couldn't load $conf: $@"; + eval "require $conf; 1" or Carp::confess("Couldn't load $conf: $@"); + my $r = App::Rgit::Repository->new(fake => 1); return unless defined $r; - $conf->SUPER::new( + + bless { root => $root, - git => $args{git}, + 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 @@ -63,7 +128,15 @@ sub new { =head2 C -Accessors. +=head2 C + +Read-only accessors. + +=cut + +BEGIN { + eval "sub $_ { \$_[0]->{$_} }" for qw/root git cwd_repo debug/; +} =head1 SEE ALSO @@ -72,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 @@ -87,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.