From: Vincent Pit Date: Tue, 21 Oct 2008 17:52:01 +0000 (+0200) Subject: Add a diagnostics mode. Only print infos when this mode is enabled X-Git-Tag: v0.05~1 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=00f4d1f6016748f8b4623d8ff32546069f763a95;p=perl%2Fmodules%2Frgit.git Add a diagnostics mode. Only print infos when this mode is enabled --- diff --git a/MANIFEST b/MANIFEST index 1a06343..984d939 100644 --- a/MANIFEST +++ b/MANIFEST @@ -13,6 +13,7 @@ lib/App/Rgit/Repository.pm lib/App/Rgit/Utils.pm t/00-load.t t/15-failures.t +t/16-levels.t t/20-each.t t/21-once.t t/90-boilerplate.t diff --git a/bin/rgit b/bin/rgit index 326d56e..83bd219 100755 --- a/bin/rgit +++ b/bin/rgit @@ -8,7 +8,7 @@ use Config qw/%Config/; use Cwd qw/cwd/; use File::Spec::Functions qw/catfile path/; -use App::Rgit::Utils qw/:codes/; +use App::Rgit::Utils qw/:codes :levels/; use App::Rgit; our $VERSION; @@ -22,10 +22,9 @@ my $cmd; BEGIN { @ARGV = grep { defined $cmd ? $_ - : ( /^-([IKV]+)$/ ? do { $opts{$_} = 1 for split //, $1; () } - : do { $cmd = $_ unless /^-/; $_ } ) + : ( /^-([DIKV]+)$/ ? do { $opts{$_} = 1 for split //, $1; () } + : do { $cmd = $_ unless /^-/; $_ } ) } @ARGV; - warn "rgit $VERSION\n" if $opts{V}; $cmd = ' ' unless defined $cmd; } @@ -68,13 +67,18 @@ croak "Couldn't find any valid git executable" unless defined $git; my $root = $ENV{GIT_DIR}; $root = cwd unless defined $root; -exit App::Rgit->new( +my $ar = App::Rgit->new( git => $git, root => $root, cmd => $cmd, args => \@ARGV, policy => \&policy, -)->run; + debug => $opts{D} ? INFO : WARN, +); + +print STDOUT "rgit $VERSION\n" if $opts{V}; + +exit $ar->run; sub policy_default { my ($cmd, $conf, $repo, $status, $signal) = @_; @@ -95,28 +99,28 @@ sub policy_interactive { ); my $int = { GetControlChars() }->{INTERRUPT}; while (1) { - print STDERR "[a]bort, [i]gnore, [I]gnore all, [r]etry, open [s]hell ?"; + $conf->warn("[a]bort, [i]gnore, [I]gnore all, [r]etry, open [s]hell ?"); ReadMode(4); my $key = ReadKey(0); ReadMode(1); print STDERR "\n"; next unless defined $key; if ($key eq $int) { - print STDERR "Interrupted, aborting\n"; + $conf->warn("Interrupted, aborting\n"); return LAST; } elsif ($key eq 's') { if (defined $shell) { - print STDERR 'Opening shell in ', $repo->work, "\n"; + $conf->info('Opening shell in ', $repo->work, "\n"); my $cwd = cwd; $repo->chdir; system { $shell } $shell; chroot $cwd; } else { - print STDERR "Couldn't find any shell\n"; + $conf->err("Couldn't find any shell\n"); } } elsif (exists $codes{$key}) { my $code = $codes{$key}; - print STDERR 'Okay, ', $code->[1], "\n"; + $conf->info('Okay, ', $code->[1], "\n"); return $code->[0]; } } @@ -134,7 +138,7 @@ Version 0.04 =head1 SYNOPSIS - rgit [-K|-V|-I] [GIT_OPTIONS] COMMAND [COMMAND_ARGS] + rgit [-K|-I|-D|-V] [GIT_OPTIONS] COMMAND [COMMAND_ARGS] =head1 DESCRIPTION @@ -211,6 +215,12 @@ This lets you choose interactively what to do when one of the commands returns a =item * +C<-D> + +Outputs diagnostics. + +=item * + C<-V> Outputs the version. diff --git a/lib/App/Rgit.pm b/lib/App/Rgit.pm index 302d713..e443603 100644 --- a/lib/App/Rgit.pm +++ b/lib/App/Rgit.pm @@ -38,8 +38,9 @@ Creates a new L object that's bound to execute the command C<$cmd> on sub new { my ($class, %args) = &validate; my $config = App::Rgit::Config->new( - root => $args{root}, - git => $args{git}, + root => $args{root}, + git => $args{git}, + debug => $args{debug}, ); return unless defined $config; my $command = App::Rgit::Command->new( diff --git a/lib/App/Rgit/Config.pm b/lib/App/Rgit/Config.pm index cf13d19..0316634 100644 --- a/lib/App/Rgit/Config.pm +++ b/lib/App/Rgit/Config.pm @@ -7,10 +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 cwd_repo/; +use Object::Tiny qw/root git cwd_repo debug/; use App::Rgit::Repository; -use App::Rgit::Utils qw/validate/; +use App::Rgit::Utils qw/validate :levels/; =head1 NAME @@ -52,9 +52,40 @@ sub new { root => $root, git => $args{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 @@ -63,6 +94,8 @@ sub new { =head2 C +=head2 C + Accessors. =head1 SEE ALSO diff --git a/lib/App/Rgit/Repository.pm b/lib/App/Rgit/Repository.pm index b8cd5eb..19aca00 100644 --- a/lib/App/Rgit/Repository.pm +++ b/lib/App/Rgit/Repository.pm @@ -141,7 +141,7 @@ sub run { system { $conf->git } $conf->git, @args; } if ($? == -1) { - warn "Failed to execute git: $!\n"; + $conf->crit("Failed to execute git: $!\n"); return; } my $ret; @@ -149,13 +149,13 @@ sub run { my $sig; if (WIFSIGNALED($?)) { $sig = WTERMSIG($?); - warn "git died with signal $sig\n"; + $conf->warn("git died with signal $sig\n"); if ($sig == SIGINT || $sig == SIGQUIT) { - warn "Aborting.\n"; + $conf->err("Aborting\n"); exit $sig; } } elsif ($ret) { - warn "git returned $ret\n"; + $conf->info("git returned $ret\n"); } return wantarray ? ($ret, $sig) : $ret; } diff --git a/lib/App/Rgit/Utils.pm b/lib/App/Rgit/Utils.pm index 606df56..cbcffd9 100644 --- a/lib/App/Rgit/Utils.pm +++ b/lib/App/Rgit/Utils.pm @@ -38,6 +38,19 @@ use constant { LAST => 0x8, }; +=head2 C, C, C, C and C + +Message levels. + +=cut + +use constant { + INFO => 3, + WARN => 2, + ERR => 1, + CRIT => 0, +}; + =head1 FUNCTIONS =head2 C @@ -60,14 +73,17 @@ C is only exported on request, either by its name or by the C<'funcs'> C C, C and C are only exported on request, either by their name or by the C<'codes'> tags. +C, C, C and C are only exported on request, either by their name or by the C<'levels'> tags. + =cut use base qw/Exporter/; our @EXPORT = (); our %EXPORT_TAGS = ( - funcs => [ qw/validate/ ], - codes => [ qw/SAVE NEXT REDO LAST/ ], + funcs => [ qw/validate/ ], + codes => [ qw/SAVE NEXT REDO LAST/ ], + levels => [ qw/INFO WARN ERR CRIT/ ], ); our @EXPORT_OK = map { @$_ } values %EXPORT_TAGS; $EXPORT_TAGS{'all'} = [ @EXPORT_OK ]; diff --git a/t/16-levels.t b/t/16-levels.t new file mode 100644 index 0000000..9a4410d --- /dev/null +++ b/t/16-levels.t @@ -0,0 +1,39 @@ +#!perl + +use strict; +use warnings; + +use Test::More tests => 4; + +use App::Rgit::Config; +use App::Rgit::Utils qw/:levels/; + +local $SIG{__WARN__} = sub { diag @_ }; +local $SIG{__DIE__} = sub { diag @_ }; + +my %levels = ( + info => INFO, + warn => WARN, + err => ERR, + crit => CRIT, +); +my @levels = sort { $levels{$b} <=> $levels{$a} } keys %levels; + +my $olderr; +open $olderr, '>&', \*STDERR or die "Can't dup STDERR: $!"; + +for my $l (0 .. $#levels) { + my $arc = App::Rgit::Config->new( + root => 't', + git => 't/bin/git', + debug => $levels{$levels[$l]} + ); + my $buf = ''; + close STDERR; + open STDERR, '>', \$buf or die "open(STDERR, '>', \\\$buf): $!"; + $arc->$_($_) for qw/info warn err crit/; + is($buf, join('', @levels[$l .. $#levels]), "level $l ok"); +} + +close STDERR; +open STDERR, '>&', $olderr or die "Can't dup \$olderr: $!";