X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FApp%2FRgit%2FConfig.pm;h=1e822b4b0f2856ac561547fd29e13ecce91545f7;hb=76ba389e3711e8f254aea83f9b3b7b221c0517a8;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..1e822b4 100644 --- a/lib/App/Rgit/Config.pm +++ b/lib/App/Rgit/Config.pm @@ -7,9 +7,10 @@ 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 App::Rgit::Repository; +use App::Rgit::Utils qw/validate :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 @@ -35,25 +40,83 @@ 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; - return unless defined $args{git} and -x $args{git}; + + 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: $@"; - $conf->SUPER::new( - root => $args{root}, - git => $args{git}, - ); + + 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 @@ -77,7 +140,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 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.