Add a diagnostics mode. Only print infos when this mode is enabled

diff --git a/MANIFEST b/MANIFEST
index 1a06343add5770158961c4d232a07233cb54ed99..984d939416d0b9999084f49522ed990c685b8a51 100644 (file)
--- 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 326d56edf3f4872485549e7702adc1bfc6ee5446..83bd219a1c0a35558b8fd6a926d0fcbaa6dcdbf1 100755 (executable)
--- 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 302d713ddbbd9b3b17250c484fe2a51b5c165337..e4436039f20b16c02d0972da1da542358032c976 100644 (file)
--- a/lib/App/Rgit.pm
+++ b/lib/App/Rgit.pm
@@ -38,8 +38,9 @@ Creates a new L<App::Rgit> 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 cf13d197a7420fe420186db7b974c767d528d628..0316634cee78daa9801460adb40f6b60f319d6c7 100644 (file)
--- 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<info $msg>
+
+=head2 C<warn $msg>
+
+=head2 C<err $msg>
+
+=head2 C<crit $msg>
+
+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<root>
 
 =head2 C<git>
@@ -63,6 +94,8 @@ sub new {
 
 =head2 C<cwd_repo>
 
+=head2 C<debug>
+
 Accessors.
 
 =head1 SEE ALSO

diff --git a/lib/App/Rgit/Repository.pm b/lib/App/Rgit/Repository.pm
index b8cd5eb7a6204cbcdd86c765db4a20bcb928a68f..19aca00f2a2393f4edd336ac49211a71d89df66f 100644 (file)
--- 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 606df56f722c8dbac9f1693a4aa6f16ae9717e18..cbcffd9108414a75a1f217fb7b44092c7b487b98 100644 (file)
--- a/lib/App/Rgit/Utils.pm
+++ b/lib/App/Rgit/Utils.pm
@@ -38,6 +38,19 @@ use constant {
  LAST => 0x8,
 };
 
+=head2 C<DIAG>, C<INFO>, C<WARN>, C<ERR> and C<CRIT>
+
+Message levels.
+
+=cut
+
+use constant {
+ INFO => 3,
+ WARN => 2,
+ ERR  => 1,
+ CRIT => 0,
+};
+
 =head1 FUNCTIONS
 
 =head2 C<validate @method_args>
@@ -60,14 +73,17 @@ C<validate> is only exported on request, either by its name or by the C<'funcs'>
 
 C<NEXT> C<REDO>, C<LAST> and C<SAVE> are only exported on request, either by their name or by the C<'codes'> tags.
 
+C<INFO>, C<WARN>, C<ERR> and C<CRIT> 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 (file)
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: $!";