[libcode-tidyall-perl] 101/374: document, add tests, fix error handling
Jonas Smedegaard
js at alioth.debian.org
Sun Sep 29 22:25:56 UTC 2013
This is an automated email from the git hooks/post-receive script.
js pushed a commit to branch master
in repository libcode-tidyall-perl.
commit 7f006e1dc0b1effb67e1618d0c1addb7d6dab9df
Author: Jonathan Swartz <swartz at pobox.com>
Date: Wed Jul 18 09:56:04 2012 -0700
document, add tests, fix error handling
---
dist.ini | 1 +
lib/Code/TidyAll.pm | 1 +
lib/Code/TidyAll/Plugin/PerlCritic.pm | 2 +-
lib/Code/TidyAll/SVN/Precommit.pm | 245 ++++++++++++++++++++++++---------
lib/Code/TidyAll/Util.pm | 2 +-
lib/Code/TidyAll/t/SVN.pm | 19 ++-
6 files changed, 200 insertions(+), 70 deletions(-)
diff --git a/dist.ini b/dist.ini
index 0269325..b40cc4b 100644
--- a/dist.ini
+++ b/dist.ini
@@ -45,6 +45,7 @@ File::Slurp = 0
File::Temp = 0
File::Zglob = 0
Hash::MoreUtils = 0
+Log::Any = 0
List::MoreUtils = 0
List::Pairwise = 0
Moo = 0.0091010
diff --git a/lib/Code/TidyAll.pm b/lib/Code/TidyAll.pm
index e403730..ccc1514 100644
--- a/lib/Code/TidyAll.pm
+++ b/lib/Code/TidyAll.pm
@@ -209,6 +209,7 @@ sub process_source {
}
}
catch {
+ chomp;
$error = sprintf( "*** '%s': %s", $plugin->name, $_ );
};
last if $error;
diff --git a/lib/Code/TidyAll/Plugin/PerlCritic.pm b/lib/Code/TidyAll/Plugin/PerlCritic.pm
index 269452a..37ba639 100644
--- a/lib/Code/TidyAll/Plugin/PerlCritic.pm
+++ b/lib/Code/TidyAll/Plugin/PerlCritic.pm
@@ -18,7 +18,7 @@ sub validate_file {
#
local @ARGV = @argv;
my $output = capture_merged { Perl::Critic::Command::run() };
- die $output if $output !~ /^.* source OK\n/;
+ die "$output\n" if $output !~ /^.* source OK\n/;
}
1;
diff --git a/lib/Code/TidyAll/SVN/Precommit.pm b/lib/Code/TidyAll/SVN/Precommit.pm
index 8e09365..a540cbd 100644
--- a/lib/Code/TidyAll/SVN/Precommit.pm
+++ b/lib/Code/TidyAll/SVN/Precommit.pm
@@ -12,6 +12,7 @@ use warnings;
# Public
has 'conf_file' => ( is => 'ro', default => sub { "tidyall.ini" } );
has 'extra_conf_files' => ( is => 'ro', default => sub { [] } );
+has 'reject_on_error' => ( is => 'ro' );
has 'repos' => ( is => 'ro', default => sub { $ARGV[0] } );
has 'tidyall_class' => ( is => 'ro', default => sub { 'Code::TidyAll' } );
has 'tidyall_options' => ( is => 'ro', default => sub { {} } );
@@ -27,72 +28,81 @@ sub _build_revlook {
}
sub check {
- my $class = shift;
- $class->_check(@_);
-}
-
-sub _check {
my ( $class, %params ) = @_;
- my $self = $class->new(%params);
-
- my @files = ( $self->revlook->added(), $self->revlook->updated() );
- msg("----------------------------");
- msg(
- "%s [%s] repos = %s; txn = %s",
- scalar(localtime), $$, scalar( getpwuid($<) ),
- $self->repos, $self->txn
- );
- msg( "looking at files: %s", join( ", ", @files ) );
-
- my %root_files;
- foreach my $file (@files) {
- if ( my $root = $self->find_root_for_file($file) ) {
- my $rel_file = substr( $file, length($root) + 1 );
- $root_files{$root}->{$rel_file}++;
- }
- else {
- msg( "** could not find '%s' upwards from '%s'", $self->conf_file, $file );
- }
- }
- my @results;
- while ( my ( $root, $file_map ) = each(%root_files) ) {
- my $tempdir = tempdir_simple();
- my @files = keys(%$file_map);
- foreach my $rel_file ( $self->conf_file, @{ $self->extra_conf_files }, @files ) {
-
- # TODO: what if cat fails
- my $contents = $self->cat_file("$root/$rel_file");
- my $full_path = "$tempdir/$rel_file";
- mkpath( dirname($full_path), 0, 0775 );
- write_file( $full_path, $contents );
- }
- my $tidyall = $self->tidyall_class->new(
- conf_file => join( "/", $tempdir, $self->conf_file ),
- no_cache => 1,
- check_only => 1,
- %{ $self->tidyall_options },
+ my $fail_msg;
+
+ try {
+ my $self = $class->new(%params);
+
+ my @files = ( $self->revlook->added(), $self->revlook->updated() );
+ $log->info("----------------------------");
+ $log->infof(
+ "%s [%s] repos = %s; txn = %s",
+ scalar(localtime), $$, scalar( getpwuid($<) ),
+ $self->repos, $self->txn
);
- my $stdout = capture_stdout {
- push( @results, $tidyall->process_files( map { "$tempdir/$_" } @files ) );
- };
- if ($stdout) {
- chomp($stdout);
- msg( "%s", $stdout );
+ $log->infof( "looking at files: %s", join( ", ", @files ) );
+
+ my %root_files;
+ foreach my $file (@files) {
+ if ( my $root = $self->find_root_for_file($file) ) {
+ my $rel_file = substr( $file, length($root) + 1 );
+ $root_files{$root}->{$rel_file}++;
+ }
+ else {
+ my $msg =
+ sprintf( "** could not find '%s' upwards from '%s'", $self->conf_file, $file );
+ $log->error($msg);
+ die $msg if $self->reject_on_error;
+ }
}
- }
- if ( my @error_results = grep { $_->error } @results ) {
- my $error_count = scalar(@error_results);
- die join(
- "\n",
- sprintf(
- "%d file%s did not pass tidyall check",
- $error_count, $error_count > 1 ? "s" : ""
- ),
- map { $_->msg } @error_results
- );
+ my @results;
+ while ( my ( $root, $file_map ) = each(%root_files) ) {
+ my $tempdir = tempdir_simple();
+ my @files = keys(%$file_map);
+ foreach my $rel_file ( $self->conf_file, @{ $self->extra_conf_files }, @files ) {
+
+ # TODO: what if cat fails
+ my $contents = $self->cat_file("$root/$rel_file");
+ my $full_path = "$tempdir/$rel_file";
+ mkpath( dirname($full_path), 0, 0775 );
+ write_file( $full_path, $contents );
+ }
+ my $tidyall = $self->tidyall_class->new(
+ conf_file => join( "/", $tempdir, $self->conf_file ),
+ no_cache => 1,
+ check_only => 1,
+ %{ $self->tidyall_options },
+ );
+ my $stdout = capture_stdout {
+ push( @results, $tidyall->process_files( map { "$tempdir/$_" } @files ) );
+ };
+ if ($stdout) {
+ chomp($stdout);
+ $log->info($stdout);
+ }
+ }
+
+ if ( my @error_results = grep { $_->error } @results ) {
+ my $error_count = scalar(@error_results);
+ $fail_msg = join(
+ "\n",
+ sprintf(
+ "%d file%s did not pass tidyall check",
+ $error_count, $error_count > 1 ? "s" : ""
+ ),
+ map { join( ": ", $_->path, $_->msg ) } @error_results
+ );
+ }
}
+ catch {
+ my $error = $_;
+ $log->error($error);
+ die $error if $params{reject_on_error};
+ };
+ die $fail_msg if $fail_msg;
}
sub find_root_for_file {
@@ -134,10 +144,115 @@ sub cat_file {
return $contents;
}
-sub msg {
- my ( $fmt, @params ) = @_;
+1;
- $log->infof( $fmt, @params );
-}
+__END__
-1;
+=pod
+
+=head1 NAME
+
+Code::TidyAll::SVN::Precommit - Subversion precommit hook that requires files
+to be tidyall'd
+
+=head1 SYNOPSIS
+
+ In /usr/local/repos/hooks/pre-commit in your svn repo:
+
+ #!/usr/bin/perl
+ use Code::TidyAll::SVN::Precommit;
+ use Log::Any::Adapter (File => "/path/to/hooks/logs/tidyall.log");
+ use strict;
+ use warnings;
+
+ Code::TidyAll::SVN::Precommit->check();
+
+=head1 DESCRIPTION
+
+This module implements a L<Subversion pre-commit
+hook|http://svnbook.red-bean.com/en/1.7/svn.ref.reposhooks.pre-commit.html>
+that checks if all files are tidied and valid according to L<tidyall|tidyall>>,
+and rejects the commit if not.
+
+=head1 METHODS
+
+=over
+
+=item check (key/value params...)
+
+Class method. Check that all files being added or modified in this commit are
+tidied and valid according to L<tidyall|tidyall>. If not, then the entire
+commit is rejected and the reason(s) are output to the client. e.g.
+
+ % svn commit -m "fixups" CHI.pm CHI/Driver.pm
+ Sending CHI/Driver.pm
+ Sending CHI.pm
+ Transmitting file data ..svn: Commit failed (details follow):
+ svn: Commit blocked by pre-commit hook (exit code 255) with output:
+ 2 files did not pass tidyall check
+ lib/CHI.pm: *** 'PerlTidy': needs tidying
+ lib/CHI/Driver.pm: *** 'PerlCritic': Code before strictures are enabled
+ at /tmp/Code-TidyAll-0e6K/Driver.pm line 2
+ [TestingAndDebugging::RequireUseStrict]
+
+The configuration file (C<tidyall.ini> by default) must be checked into svn.
+For each file, the hook will look upwards from the file's repo location and use
+the first configuration file it finds.
+
+By default, if C<tidyall.ini> cannot be found, or if a runtime error occurs, a
+warning is logged (see below) but the commit is allowed to proceed. This is so
+that unexpected problems do not prevent a team from committing code.
+
+Key/value parameters:
+
+=over
+
+=item conf_file
+
+Name of configuration file, defaults to C<tidyall.ini>
+
+=item extra_conf_files
+
+A listref of configuration files referred to from C<tidyall.ini>, e.g.
+
+ extra_conf_files => ['perlcriticrc', 'perltidyrc']
+
+=item reject_on_error
+
+If C<tidyall.ini> cannot be found for some/all the files, or if a runtime error
+occurs, reject the commit.
+
+=item repos
+
+Repository path being committed; defaults to C<< $ARGV[0] >>
+
+=item tidyall_class
+
+Subclass to use instead of L<Code::TidyAll|Code::TidyAll>
+
+=item tidyall_options
+
+Options to pass to the L<Code::TidyAll|Code::TidyAll> constructor
+
+=item txn
+
+Commit transaction; defaults to C<< $ARGV[1] >>
+
+=back
+
+=back
+
+=head1 LOGGING
+
+This module uses L<Log::Any|Log::Any> to log its activity, including all files
+that were checked, an inability to find C<tidyall.ini>, and any runtime errors
+that occur. You can create a simple datestamped log file with
+
+ use Log::Any::Adapter (File => "/path/to/hooks/logs/tidyall.log");
+
+or do something fancier with one of the other Log::Any adapters.
+
+Having a log file is especially useful with precommit hooks since there is no
+way for the hook to send back output on a successful commit.
+
+=cut
diff --git a/lib/Code/TidyAll/Util.pm b/lib/Code/TidyAll/Util.pm
index d0670cb..d707c09 100644
--- a/lib/Code/TidyAll/Util.pm
+++ b/lib/Code/TidyAll/Util.pm
@@ -41,7 +41,7 @@ sub can_load {
sub tempdir_simple {
my $template = shift || 'Code-TidyAll-XXXX';
- return tempdir( $template, TMPDIR => 1, CLEANUP => 1 );
+ return tempdir( $template, TMPDIR => 1, CLEANUP => 0 );
}
sub dump_one_line {
diff --git a/lib/Code/TidyAll/t/SVN.pm b/lib/Code/TidyAll/t/SVN.pm
index c8bc642..d951696 100644
--- a/lib/Code/TidyAll/t/SVN.pm
+++ b/lib/Code/TidyAll/t/SVN.pm
@@ -30,6 +30,16 @@ sub test_svn_precommit_hook : Tests {
run("cat /dev/null > $hook_log");
};
+ my $committed = sub {
+ $stdout = capture_stdout { system( sprintf( 'svn status %s', $work_dir ) ) };
+ unlike( $stdout, qr/\S/, "committed" );
+ };
+
+ my $uncommitted = sub {
+ $stdout = capture_stdout { system( sprintf( 'svn status %s', $work_dir ) ) };
+ like( $stdout, qr/^M/, "uncommitted" );
+ };
+
run("svnadmin create $repo_dir");
my $hooks_dir = "$repo_dir/hooks";
ok( -d $hooks_dir, "$hooks_dir exists" );
@@ -48,9 +58,12 @@ sub test_svn_precommit_hook : Tests {
chmod( 0775, $precommit_hook_file );
write_file( "$work_dir/foo.txt", "abc " );
- run( sprintf( 'svn -q commit -m "changed" %s/foo.txt', $work_dir ) );
+ $stderr =
+ capture_stderr { run( sprintf( 'svn -q commit -m "changed" %s/foo.txt', $work_dir ) ) };
+ unlike( $stderr, qr/\S/ );
$log_contains->(qr|could not find 'tidyall.ini' upwards from 'myapp/trunk/foo.txt'|);
$clear_log->();
+ $committed->();
write_file( "$work_dir/tidyall.ini", sprintf($tidyall_ini_template) );
run( sprintf( 'svn -q add %s/tidyall.ini', $work_dir ) );
@@ -61,6 +74,7 @@ sub test_svn_precommit_hook : Tests {
capture_stderr { system( sprintf( 'svn -q commit -m "changed" %s/foo.txt', $work_dir ) ) };
like( $stderr, qr/1 file did not pass tidyall check/ );
like( $stderr, qr/UpperText.*needs tidying/ );
+ $uncommitted->();
write_file( "$work_dir/foo.txt", "ABC" );
write_file( "$work_dir/bar.dat", "123" );
@@ -70,8 +84,7 @@ sub test_svn_precommit_hook : Tests {
sprintf( 'svn -q commit -m "changed" %s/foo.txt %s/bar.dat', $work_dir, $work_dir ) );
};
unlike( $stderr, qr/\S/ );
- $stdout = capture_stdout { system( sprintf( 'svn status %s', $work_dir ) ) };
- unlike( $stdout, qr/\S/ );
+ $committed->();
}
$precommit_hook_template = '#!/usr/bin/perl
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libcode-tidyall-perl.git
More information about the Pkg-perl-cvs-commits
mailing list