[libcode-tidyall-perl] 04/374: various
Jonas Smedegaard
js at alioth.debian.org
Sun Sep 29 22:25:38 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 5cfe6cebd91725383ee0e6c6c455ae5338eeb602
Author: Jonathan Swartz <swartz at pobox.com>
Date: Thu May 24 03:07:13 2012 -0700
various
---
.perltidyrc | 2 +-
lib/Code/TidyAll.pm | 163 ++++++++++++++++++++++++++++-----
lib/Code/TidyAll/Plugin.pm | 47 +++++++---
lib/Code/TidyAll/Plugin/PerlTidy.pm | 14 ++-
lib/Code/TidyAll/Plugin/perlcritic.pm | 34 +++++++
lib/Code/TidyAll/Util.pm | 40 ++++++++
t/02-tidy.t | 6 --
t/{01-use.t => use.t} | 1 +
xt/author/tidy-and-critic.t | 68 ++++++++++++++
9 files changed, 325 insertions(+), 50 deletions(-)
diff --git a/.perltidyrc b/.perltidyrc
index 5725109..656808d 100644
--- a/.perltidyrc
+++ b/.perltidyrc
@@ -1 +1 @@
--noll -l=100
+-noll -l=100
\ No newline at end of file
diff --git a/lib/Code/TidyAll.pm b/lib/Code/TidyAll.pm
index af3d197..a7f7bd0 100644
--- a/lib/Code/TidyAll.pm
+++ b/lib/Code/TidyAll.pm
@@ -1,42 +1,47 @@
package Code::TidyAll;
+use CHI;
use Moose;
+use File::Find qw(find);
+use Code::TidyAll::Util qw(can_load read_file);
use Method::Signatures::Simple;
use Digest::SHA1 qw(sha1_hex);
use List::Pairwise qw(mapp);
+use JSON::XS qw(encode_json);
-has 'base_sig' => ( is => 'ro', init_arg => undef, lazy_build => 1 );
-has 'cache' => ( is => 'ro', lazy_build => 1 );
-has 'conf' => ( is => 'ro', lazy_build => 1 );
-has 'files' => ( is => 'ro', lazy_build => 1 );
-has 'plugins' => ( is => 'ro', lazy_build => 1 );
-has 'root_dir' => ( is => 'ro', required => 1 );
+has 'base_sig' => ( is => 'ro', init_arg => undef, lazy_build => 1 );
+has 'cache' => ( is => 'ro', init_arg => undef, lazy_build => 1 );
+has 'cache_dir' => ( is => 'ro', lazy_build => 1 );
+has 'plugin_objects' => ( is => 'ro', init_arg => undef, lazy_build => 1 );
+has 'plugins' => ( is => 'ro', required => 1 );
+has 'root_dir' => ( is => 'ro', required => 1 );
method tidyall () {
my $cache = $self->cache;
- foreach my $file ( @{ $self->files } ) {
- if ( -f $file
- && ( $cache->get($file) || '' ) ne $self->_file_sig($file) )
- {
- $self->process_file($file);
- $cache->set( $file, $self->_file_sig($file) );
+ my @files;
+ find( { wanted => sub { push @files, $_ if -f }, no_chdir => 1 }, $self->root_dir );
+ foreach my $file (@files) {
+ if ( ( $cache->get($file) || '' ) ne $self->_file_sig($file) ) {
+ if ( $self->process_file($file) ) {
+ $cache->set( $file, $self->_file_sig($file) );
+ }
}
}
}
method _build_cache () {
- require CHI;
- return CHI->new(
- driver => 'File',
- root_dir => $self->root_dir . "/.tidyall_cache"
- );
+ return CHI->new( driver => 'File', root_dir => $self->cache_dir );
+}
+
+method _build_cache_dir () {
+ return $self->root_dir . "/.tidyall_cache";
}
method _build_base_sig () {
- return $self->_sig( [ $Code::TidyAll::VERSION, $self->conf ] );
+ return $self->_sig( [ $Code::TidyAll::VERSION, $self->plugins ] );
}
-method _build_plugins () {
- return mapp { $self->load_plugin( $a, $b ) } %{ $self->conf->{plugins} };
+method _build_plugin_objects () {
+ return [ mapp { $self->load_plugin( $a, $b ) } %{ $self->plugins } ];
}
method load_plugin ($plugin_name, $plugin_conf) {
@@ -45,16 +50,31 @@ method load_plugin ($plugin_name, $plugin_conf) {
? substr( $plugin_name, 1 )
: "Code::TidyAll::Plugin::$plugin_name"
);
- Class::MOP::load_class($class_name);
- return $class_name->new( conf => $plugin_conf, name => $plugin_name );
+ if ( can_load($class_name) ) {
+ return $class_name->new(
+ conf => $plugin_conf,
+ name => $plugin_name,
+ root_dir => $self->root_dir
+ );
+ }
+ else {
+ die "could not load plugin class '$class_name'";
+ }
}
method process_file ($file) {
- foreach my $plugin ( @{ $self->plugins } ) {
+ my $matched = 0;
+ foreach my $plugin ( @{ $self->plugin_objects } ) {
if ( $plugin->matcher->($file) ) {
- $plugin->process_file($file);
+ print "$file\n" if !$matched++;
+ eval { $plugin->process_file($file) };
+ if ( my $error = $@ ) {
+ printf( "*** '%s': %s", $plugin->name, $error );
+ return 0;
+ }
}
}
+ return 1;
}
method _file_sig ($file) {
@@ -68,3 +88,98 @@ method _sig ($data) {
}
1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Code::TidyAll - Tidy and validate code in many ways at once
+
+=head1 SYNOPSIS
+
+ use Code::TidyAll;
+
+ my $ct = Code::TidyAll->new(
+ root_dir => '...',
+ plugins => {
+ perltidy => {
+ include => qr/\.(pl|pm|t)$/,
+ options => { argv => '-noll -it=2' },
+ },
+ perlcritic => {
+ include => qr/\.(pl|pm|t)$/,
+ options => { '-include' => ['layout'], '-severity' => 3, }
+ },
+ podtidy => {
+ include => qr/\.(pl|pm|t)$/,
+ options => { columns => 80 }
+ },
+ htmltidy => {
+ include => qr/\.html$/,
+ options => {
+ output_xhtml => 1,
+ tidy_mark => 0,
+ }
+ },
+ '+My::Javascript::Tidier' => {
+ include => qr/\.js$/,
+ ...
+ },
+ }
+ );
+ $ct->tidyall;
+
+=head1 DESCRIPTION
+
+=head1 CONSTRUCTOR OPTIONS
+
+=over
+
+=item root_dir
+
+Required. All files under the root directory and its subdirectories will be
+considered for processing.
+
+=item plugins
+
+Required. A hash of one or more plugin specifications.
+
+Each key is the name of a plugin; it is automatically prefixed with
+C<TidyAll::Plugin::> unless it is a full classname preceded by a '+'.
+
+Each value is a configuration hash for the plugin. The configuration hash may
+contain:
+
+=over
+
+=item include
+
+A regex or code reference which is applied to each full pathname to determine
+whether it should be processed with this plugin.
+
+=item exclude
+
+A regex or code reference which is applied to each full pathname to determine
+whether it should be excluded. This overrides C<include> above.
+
+=item options
+
+Options specific to the plugin to be used for its tidying/validation.
+
+=item cache
+
+Optional. A cache object, or a hashref of parameters to pass to L<CHI|CHI> to
+construct a cache. If provided, this will be used to ensure that each file is
+only processed if it did not change since the last time it was processed.
+
+=back
+
+=over
+
+=item
+
+=item
+
+=back
diff --git a/lib/Code/TidyAll/Plugin.pm b/lib/Code/TidyAll/Plugin.pm
index 99bb678..7a6228d 100644
--- a/lib/Code/TidyAll/Plugin.pm
+++ b/lib/Code/TidyAll/Plugin.pm
@@ -1,10 +1,17 @@
package Code::TidyAll::Plugin;
+use Code::TidyAll::Util qw(read_file write_file);
use Moose;
use Method::Signatures::Simple;
-has 'conf' => ( is => 'ro', required => 1 );
-has 'matcher' => ( is => 'ro', init_arg => undef, lazy_build => 1 );
-has 'name' => ( is => 'ro', required => 1 );
+has 'conf' => ( is => 'ro', required => 1 );
+has 'exclude' => ( is => 'ro', init_arg => undef, lazy_build => 1 );
+has 'include' => ( is => 'ro', init_arg => undef, lazy_build => 1 );
+has 'matcher' => ( is => 'ro', init_arg => undef, lazy_build => 1 );
+has 'name' => ( is => 'ro', required => 1 );
+has 'options' => ( is => 'ro', init_arg => undef, lazy_build => 1 );
+has 'root_dir' => ( is => 'ro' );
+
+method defaults () { return {} }
method process_file ($file) {
my $source = read_file($file);
@@ -15,24 +22,36 @@ method process_file ($file) {
method _build_matcher () {
my $conf = $self->conf;
- my $include = $conf->{include}
- || die "no include configured for plugin " . $self->name;
- my $exclude = $conf->{include} || sub { 0 };
- $include = _match_spec_to_coderef( 'include', $include );
- $exclude = _match_spec_to_coderef( 'exclude', $exclude );
+ my $include = $self->_match_spec_to_coderef( 'include', $self->include );
+ my $exclude = $self->_match_spec_to_coderef( 'exclude', $self->exclude );
+
+ return sub { my $file = shift; return $include->($file) && !$exclude->($file) };
+}
+
+method _build_include () {
+ return
+ $self->conf->{include}
+ || $self->defaults->{include}
+ || die sprintf( "cannot determine include condition for plugin '%s'", $self->name );
+}
+
+method _build_exclude () {
+ return $self->conf->{exclude} || $self->defaults->{exclude} || sub { 0 };
+}
- return sub {
- $include->($file) && !$exclude->($file);
- };
+method _build_options () {
+ my %options = %{ $self->{conf} };
+ delete( @options{qw(include exclude)} );
+ return \%options;
}
-func _match_spec_to_coderef ($type, $spec) {
+method _match_spec_to_coderef ($type, $spec) {
$spec = qr/$spec/ if ( !ref($spec) );
if ( ref($spec) eq 'Regexp' ) {
- $coderef{$type} = sub { $_[0] =~ $spec };
+ return sub { $_[0] =~ $spec };
}
elsif ( ref($spec) eq 'CODE' ) {
- $coderef{$type} = $spec;
+ return $spec;
}
else {
die sprintf( "bad '%s' conf value for plugin '%s': '%s'", $type, $self->name, $spec );
diff --git a/lib/Code/TidyAll/Plugin/PerlTidy.pm b/lib/Code/TidyAll/Plugin/PerlTidy.pm
index 679a37c..995d39b 100644
--- a/lib/Code/TidyAll/Plugin/PerlTidy.pm
+++ b/lib/Code/TidyAll/Plugin/PerlTidy.pm
@@ -1,15 +1,19 @@
-package Code::TidyAll::Plugin::PerlTidy;
+package Code::TidyAll::Plugin::perltidy;
+use Hash::MoreUtils qw(slice_exists);
+use Perl::Tidy;
use Moose;
extends 'Code::TidyAll::Plugin';
-sub include_files { qr/\.(pl|pm|t)$/ }
+sub defaults {
+ return { include => qr/\.(pl|pm|t)$/ };
+}
sub process_source {
my ( $self, $source ) = @_;
- my $conf = $self->conf;
+ my %params = slice_exists( $self->options, qw(argv prefilter postfilter) );
Perl::Tidy::perltidy(
- %$conf,
- source => $source,
+ %params,
+ source => \$source,
destination => \my $destination,
stderr => \my $stderr,
);
diff --git a/lib/Code/TidyAll/Plugin/perlcritic.pm b/lib/Code/TidyAll/Plugin/perlcritic.pm
new file mode 100644
index 0000000..99dc8eb
--- /dev/null
+++ b/lib/Code/TidyAll/Plugin/perlcritic.pm
@@ -0,0 +1,34 @@
+package Code::TidyAll::Plugin::perlcritic;
+use Code::TidyAll::Util qw(write_file tempdir_simple);
+use Perl::Critic::Command qw();
+use Moose;
+use Capture::Tiny qw(capture_merged);
+extends 'Code::TidyAll::Plugin';
+
+sub defaults {
+ return { include => qr/\.(pl|pm|t)$/ };
+}
+
+sub process_file {
+ my ( $self, $file ) = @_;
+
+ # Determine arguments
+ #
+ my @argv = split( /\s/, $self->options->{argv} || '' );
+ my $default_profile = $self->root_dir . "/.perlcriticrc";
+ my $profile = $self->{options}->{profile} || ( -f $default_profile && $default_profile );
+ push( @argv, '--profile', $profile ) if $profile;
+ push( @argv, $file );
+
+ # Run perlcritic
+ #
+ local @ARGV = @argv;
+ my $output = capture_merged { Perl::Critic::Command::run() };
+ die $output if $output !~ /^.* source OK\n/;
+
+ # Validation only
+ #
+ return undef;
+}
+
+1;
diff --git a/lib/Code/TidyAll/Util.pm b/lib/Code/TidyAll/Util.pm
new file mode 100644
index 0000000..fd5fdb2
--- /dev/null
+++ b/lib/Code/TidyAll/Util.pm
@@ -0,0 +1,40 @@
+package Code::TidyAll::Util;
+use File::Slurp qw(read_file write_file);
+use File::Temp qw(tempdir);
+use Try::Tiny;
+use strict;
+use warnings;
+use base qw(Exporter);
+
+our @EXPORT_OK = qw(can_load read_file tempdir_simple write_file );
+
+sub can_load {
+
+ # Load $class_name if possible. Return 1 if successful, 0 if it could not be
+ # found, and rethrow load error (other than not found).
+ #
+ my ($class_name) = @_;
+
+ my $result;
+ try {
+ Class::MOP::load_class($class_name);
+ $result = 1;
+ }
+ catch {
+ if ( /Can\'t locate .* in \@INC/ && !/Compilation failed/ ) {
+ $result = 0;
+ }
+ else {
+ die $_;
+ }
+ };
+ return $result;
+}
+
+sub tempdir_simple {
+ my ($template) = @_;
+
+ return tempdir( $template, TMPDIR => 1, CLEANUP => 1 );
+}
+
+1;
diff --git a/t/02-tidy.t b/t/02-tidy.t
deleted file mode 100644
index 1b7c57b..0000000
--- a/t/02-tidy.t
+++ /dev/null
@@ -1,6 +0,0 @@
-#!perl
-use Test::More;
-
-use_ok('Code::TidyAll');
-ok(1);
-done_testing();
diff --git a/t/01-use.t b/t/use.t
similarity index 68%
rename from t/01-use.t
rename to t/use.t
index bcd527f..0a34989 100644
--- a/t/01-use.t
+++ b/t/use.t
@@ -1,4 +1,5 @@
#!perl
use Test::More tests => 1;
+use File::Temp qw(tempdir);
use_ok('Code::TidyAll');
diff --git a/xt/author/tidy-and-critic.t b/xt/author/tidy-and-critic.t
new file mode 100644
index 0000000..fd7eccb
--- /dev/null
+++ b/xt/author/tidy-and-critic.t
@@ -0,0 +1,68 @@
+#!perl
+use Code::TidyAll::Util qw(read_file tempdir_simple write_file);
+use Code::TidyAll;
+use File::Basename;
+use File::Path;
+use Test::More;
+use Capture::Tiny qw(capture_merged);
+
+my $root_dir = tempdir_simple('Code-TidyAll-XXXX');
+
+sub make {
+ my ( $file, $content ) = @_;
+ $file = "$root_dir/$file";
+ mkpath( dirname($file), 0, 0775 );
+ write_file( $file, $content );
+}
+
+sub got_errors {
+ my ($output) = @_;
+ like( $output, qr/\*\*\*/, 'has errors' );
+}
+
+sub got_no_errors {
+ my ($output) = @_;
+ unlike( $output, qr/\*\*\*/, 'has no errors' );
+}
+
+make(
+ "lib/Foo.pm",
+ 'package Foo;
+ use strict;
+1;
+'
+);
+make( "bin/bar.pl", "#!/usr/bin/perl\n $d = 5;" );
+make( "data/baz.txt", " 34" );
+make( ".perlcriticrc", "include = RequireUseStrict" );
+
+my $ct = Code::TidyAll->new(
+ root_dir => $root_dir,
+ plugins => {
+ perltidy => {},
+ perlcritic => {},
+ }
+);
+my $output;
+$output = capture_merged { $ct->tidyall() };
+like( $output, qr/.*bar\.pl\n.*Code before strictures are enabled.*/ );
+like( $output, qr/.*Foo\.pm/ );
+is( read_file("$root_dir/lib/Foo.pm"), "package Foo;\nuse strict;\n1;\n" );
+is( read_file("$root_dir/data/baz.txt"), " 34" );
+got_errors($output);
+
+$output = capture_merged { $ct->tidyall() };
+like( $output, qr/.*bar\.pl\n.*Code before strictures are enabled.*/ );
+unlike( $output, qr/Foo\.pm/ );
+got_errors($output);
+
+make( "bin/bar.pl", "#!/usr/bin/perl\nuse strict;\n \$d = 5;" );
+$output = capture_merged { $ct->tidyall() };
+like( $output, qr/.*bar\.pl/ );
+got_no_errors($output);
+is( read_file("$root_dir/bin/bar.pl"), "#!/usr/bin/perl\nuse strict;\n\$d = 5;\n" );
+
+$output = capture_merged { $ct->tidyall() };
+is($output, '', 'no output');
+
+done_testing();
--
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