| File: | blib/lib/App/Rgit/Config.pm |
| Coverage: | 96.5% |
| line | stmt | bran | cond | sub | pod | time | code |
|---|---|---|---|---|---|---|---|
| 1 | package App::Rgit::Config; | ||||||
| 2 | |||||||
| 3 | 6 6 6 | 22159 27 253 | use strict; | ||||
| 4 | 6 6 6 | 45 14 331 | use warnings; | ||||
| 5 | |||||||
| 6 | 6 6 6 | 50 16 144 | use Carp (); # confess | ||||
| 7 | 6 6 6 | 60 17 144 | use Cwd (); # cwd | ||||
| 8 | 6 6 6 | 46 14 148 | use File::Spec (); # canonpath, catfile, path | ||||
| 9 | |||||||
| 10 | 6 6 6 | 2137 21 389 | use App::Rgit::Repository; | ||||
| 11 | 6 6 6 | 61 14 1445 | use App::Rgit::Utils qw/:levels/; # :levels, abs_path | ||||
| 12 | |||||||
| 13 | 6 6 6 | 58 14 6375 | use constant IS_WIN32 => $^O eq 'MSWin32'; | ||||
| 14 | |||||||
| 15 - 23 | =head1 NAME App::Rgit::Config - Base class for App::Rgit configurations. =head1 VERSION Version 0.08 =cut | ||||||
| 24 | |||||||
| 25 | our $VERSION = '0.08'; | ||||||
| 26 | |||||||
| 27 - 39 | =head1 DESCRIPTION Base class for L<App::Rgit> configurations. This is an internal class to L<rgit>. =head1 METHODS =head2 C<< new root => $root, git => $git >> Creates a new configuration object based on the root directory C<$root> and using C<$git> as F<git> executable. =cut | ||||||
| 40 | |||||||
| 41 | sub new { | ||||||
| 42 | 23 | 1 | 323365 | my $class = shift; | |||
| 43 | 23 | 548 | $class = ref $class || $class; | ||||
| 44 | |||||||
| 45 | 23 | 340 | my %args = @_; | ||||
| 46 | |||||||
| 47 | 23 | 2352 | my $root = defined $args{root} | ||||
| 48 | ? $args{root} | ||||||
| 49 | : defined $ENV{GIT_DIR} | ||||||
| 50 | ? $ENV{GIT_DIR} | ||||||
| 51 | : Cwd::cwd; | ||||||
| 52 | 23 | 1018 | Carp::confess("Invalid root directory") unless -d $root; | ||||
| 53 | 22 | 669 | $root = File::Spec->canonpath(App::Rgit::Utils::abs_path($root)); | ||||
| 54 | |||||||
| 55 | 22 | 106 | my $git; | ||||
| 56 | 22 | 369 | my @candidates = ( | ||||
| 57 | defined $args{git} | ||||||
| 58 | ? $args{git} | ||||||
| 59 | : defined $ENV{GIT_EXEC_PATH} | ||||||
| 60 | ? $ENV{GIT_EXEC_PATH} | ||||||
| 61 | : map File::Spec->catfile($_, 'git'), File::Spec->path | ||||||
| 62 | ); | ||||||
| 63 | 22 | 120 | if (IS_WIN32) { | ||||
| 64 | my @acc; | ||||||
| 65 | for my $c (@candidates) { | ||||||
| 66 | push @acc, $c, map "$c.$_", qw/exe com bat cmd/; | ||||||
| 67 | } | ||||||
| 68 | @candidates = @acc; | ||||||
| 69 | } | ||||||
| 70 | 22 | 176 | for my $c (@candidates) { | ||||
| 71 | 22 | 361 | if (-x $c) { | ||||
| 72 | 21 | 94 | $git = $c; | ||||
| 73 | 21 | 99 | last; | ||||
| 74 | } | ||||||
| 75 | } | ||||||
| 76 | 22 | 681 | Carp::confess("Couldn't find a proper git executable") unless defined $git; | ||||
| 77 | 21 | 406 | $git = File::Spec->canonpath(App::Rgit::Utils::abs_path($git)); | ||||
| 78 | |||||||
| 79 | 21 | 493 | my $conf = 'App::Rgit::Config::Default'; | ||||
| 80 | 21 | 2204 | eval "require $conf; 1" or Carp::confess("Couldn't load $conf: $@"); | ||||
| 81 | |||||||
| 82 | 21 | 494 | my $r = App::Rgit::Repository->new(fake => 1); | ||||
| 83 | 21 | 146 | return unless defined $r; | ||||
| 84 | |||||||
| 85 | 21 | 1306 | bless { | ||||
| 86 | root => $root, | ||||||
| 87 | git => $git, | ||||||
| 88 | cwd_repo => $r, | ||||||
| 89 | debug => defined $args{debug} ? int $args{debug} : WARN, | ||||||
| 90 | }, $conf; | ||||||
| 91 | } | ||||||
| 92 | |||||||
| 93 - 103 | =head2 C<info $msg> =head2 C<warn $msg> =head2 C<err $msg> =head2 C<crit $msg> Notifies a message C<$msg> of the corresponding level. =cut | ||||||
| 104 | |||||||
| 105 | sub _notify { | ||||||
| 106 | 44 | 158 | my $self = shift; | ||||
| 107 | 44 | 107 | my $level = shift; | ||||
| 108 | 44 | 1336 | if ($self->debug >= $level) { | ||||
| 109 | 10 | 64 | print STDERR @_; | ||||
| 110 | 10 | 182 | return 1; | ||||
| 111 | } | ||||||
| 112 | 34 | 364 | return 0; | ||||
| 113 | } | ||||||
| 114 | |||||||
| 115 | 32 | 1 | 3405 | sub info { shift->_notify(INFO, @_) } | |||
| 116 | |||||||
| 117 | 4 | 1 | 31 | sub warn { shift->_notify(WARN, @_) } | |||
| 118 | |||||||
| 119 | 4 | 1 | 23 | sub err { shift->_notify(ERR, @_) } | |||
| 120 | |||||||
| 121 | 4 | 1 | 26 | sub crit { shift->_notify(CRIT, @_) } | |||
| 122 | |||||||
| 123 - 135 | =head2 C<root> =head2 C<git> =head2 C<repos> =head2 C<cwd_repo> =head2 C<debug> Read-only accessors. =cut | ||||||
| 136 | |||||||
| 137 | BEGIN { | ||||||
| 138 | 6 6 9 44 23 57 | 1 1 1 1 | 23 1672 167 778 396 2014 | eval "sub $_ { \$_[0]->{$_} }" for qw/root git cwd_repo debug/; | |||
| 139 | } | ||||||
| 140 | |||||||
| 141 - 168 | =head1 SEE ALSO
L<rgit>.
=head1 AUTHOR
Vincent Pit, C<< <perl at profvince.com> >>, L<http://profvince.com>.
You can contact me by mail or on C<irc.perl.org> (vincent).
=head1 BUGS
Please report any bugs or feature requests to C<bug-rgit at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=rgit>.
I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc App::Rgit::Config
=head1 COPYRIGHT & LICENSE
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.
=cut | ||||||
| 169 | |||||||
| 170 | 1; # End of App::Rgit::Config | ||||||