X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FApp%2FRgit%2FConfig.pm;h=b360dda01c2c0bd68be50d82f79e8a3e9431d834;hb=47ad8bd4ad6d9bbb04ff48c8948c71732077dbcc;hp=20ef2234d77f0c58b00ea268cc4f71776b619079;hpb=19bee8f647bfe6c94c5cb3cf6a60d7a43cbca222;p=perl%2Fmodules%2Frgit.git diff --git a/lib/App/Rgit/Config.pm b/lib/App/Rgit/Config.pm index 20ef223..b360dda 100644 --- a/lib/App/Rgit/Config.pm +++ b/lib/App/Rgit/Config.pm @@ -4,10 +4,15 @@ 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/; +use Object::Tiny qw/root git cwd_repo debug/; -use App::Rgit::Utils qw/validate/; +use App::Rgit::Repository; +use App::Rgit::Utils qw/validate :levels/; + +use constant IS_WIN32 => $^O eq 'MSWin32'; =head1 NAME @@ -15,7 +20,11 @@ App::Rgit::Config - Base class for App::Rgit configurations. =head1 VERSION -Version 0.01 +Version 0.05 + +=cut + +our $VERSION = '0.05'; =head1 DESCRIPTION @@ -33,20 +42,76 @@ Creates a new configuration object based on the root directory C<$root> and usin 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; + + my $git = $args{git}; + return unless defined $git; + if (IS_WIN32) { + unless (-x $git) { + $git .= '.bat'; + return unless -x $git; + } + } else { + return unless -x $git; + } + my $conf = 'App::Rgit::Config::Default'; eval "require $conf; 1" or croak "Couldn't load $conf: $@"; + + my $r = App::Rgit::Repository->new(fake => 1); + return unless defined $r; + $conf->SUPER::new( - root => $args{root}, - git => $args{git}, + root => $root, + git => $git, + cwd_repo => $r, + debug => defined $args{debug} ? int $args{debug} : WARN, ); } +=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 +=head2 C + +=head2 C + Accessors. =head1 SEE ALSO