X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FApp%2FRgit%2FConfig.pm;h=0442966b805d058f8bb7b27c639c228cbb0c5d12;hb=511d4fe4b46173353cd1fdcac0d26ac067868280;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..0442966 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 (); # abs_path +use File::Spec (); # canonpath -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,88 @@ Creates a new configuration object based on the root directory C<$root> and usin =cut sub new { - my ($class, %args) = &validate; + my $class = shift; + $class = ref $class || $class; + + my %args = @_; + 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}; + $root = File::Spec->canonpath(Cwd::abs_path($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; + } + $git = File::Spec->canonpath(Cwd::abs_path($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}, - ); + 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 +129,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 +145,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.