X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FApp%2FRgit%2FConfig.pm;h=c384203a69d0cdac90ca12626ed0f3c4688b9b78;hb=e833c52a64e7aac9c18d7051285bf4d9906c4faf;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..c384203 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.08 =cut -our $VERSION = '0.02'; +our $VERSION = '0.08'; =head1 DESCRIPTION @@ -32,29 +32,107 @@ This is an internal class to L. =head1 METHODS -=head2 C<< new root => $root, git => $git >> +=head2 C + + my $arc = App::Rgit::Config->new( + root => $root, + git => $git, + ); Creates a new configuration object based on the root directory C<$root> and using C<$git> as F executable. =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 + + $arr->info($msg); + +=head2 C + + $arr->warn($msg); + +=head2 C + + $arr->err($msg); + +=head2 C + + $arr->crit($msg); + +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 +141,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 +158,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 +174,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.