[libcode-tidyall-perl] 05/374: various
Jonas Smedegaard
js at alioth.debian.org
Sun Sep 29 22:25:39 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 01bb45f3e908e65e73872fe6fab823ed91cff089
Author: Jonathan Swartz <swartz at pobox.com>
Date: Fri May 25 01:00:10 2012 -0700
various
---
dist.ini | 3 +
lib/Code/TidyAll.pm | 196 +++++++++++++++++++++++----------
lib/Code/TidyAll/Cache.pm | 41 +++++++
lib/Code/TidyAll/Plugin.pm | 43 +++++---
lib/Code/TidyAll/Plugin/PerlTidy.pm | 12 +-
lib/Code/TidyAll/Plugin/perlcritic.pm | 15 +--
lib/Code/TidyAll/Util.pm | 6 +-
t/use.t | 15 ++-
xt/author/tidy-and-critic.t | 30 +++++
9 files changed, 267 insertions(+), 94 deletions(-)
diff --git a/dist.ini b/dist.ini
index 3247fb0..71fe659 100644
--- a/dist.ini
+++ b/dist.ini
@@ -36,7 +36,10 @@ file = lib/Code/TidyAll/Util.pm
[Prereqs / RuntimeRequires]
[Prereqs / TestRequires]
+Hash::MoreUtils = 0
Test::More = 0
+JSON::XS = 0
+Digest::SHA1 = 0
; These need to be at the bottom
[InstallGuide]
diff --git a/lib/Code/TidyAll.pm b/lib/Code/TidyAll.pm
index a7f7bd0..99a062a 100644
--- a/lib/Code/TidyAll.pm
+++ b/lib/Code/TidyAll.pm
@@ -1,50 +1,76 @@
package Code::TidyAll;
-use CHI;
-use Moose;
-use File::Find qw(find);
+use Cwd qw(realpath);
+use Code::TidyAll::Cache;
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 File::Find qw(find);
use JSON::XS qw(encode_json);
-
-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;
- 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) );
+use strict;
+use warnings;
+
+# Incoming parameters
+use Object::Tiny qw(
+ backup_dir
+ cache
+ cache_dir
+ conf_file
+ data_dir
+ plugins
+ recursive
+);
+
+# Internal
+use Object::Tiny qw(
+ base_sig
+ plugin_objects
+);
+
+sub new {
+ my $class = shift;
+ my %params = @_;
+
+ # Read params from conf file, if provided; handle .../ upward search syntax
+ #
+ if ( my $conf_file = delete( $params{conf_file} ) ) {
+ if ( my ( $start_dir, $search_file ) = ( $conf_file =~ m{^(.*)\.\.\./(.*)$} ) ) {
+ $start_dir = '.' if !$start_dir;
+ $start_dir = realpath($start_dir);
+ if ( my $found_file = $class->_find_file_upwards( $start_dir, $search_file ) ) {
+ $conf_file = $found_file;
+ }
+ else {
+ die "cound not find '$search_file' upwards from '$start_dir'";
}
}
+
+ my $conf_params = Load($conf_file);
+ if ( ref($conf_params) ne 'HASH' ) {
+ die "'$conf_file' did not evaluate to a hash";
+ }
+ %params = ( %$conf_params, %params );
}
-}
-method _build_cache () {
- return CHI->new( driver => 'File', root_dir => $self->cache_dir );
-}
+ my $self = $class->SUPER::new(%params);
+ die "plugins required" unless $self->{plugins};
-method _build_cache_dir () {
- return $self->root_dir . "/.tidyall_cache";
-}
+ if ( defined( $self->data_dir ) ) {
+ $self->{backup_dir} ||= $self->data_dir . "/backup";
+ $self->{cache_dir} ||= $self->data_dir . "/cache";
+ }
+ if ( defined( $self->cache_dir ) ) {
+ $self->{cache} ||= Code::TidyAll::Cache->new( cache_dir => $self->cache_dir );
+ }
+ $self->{base_sig} = $self->_sig( [ $Code::TidyAll::VERSION, $self->plugins ] );
-method _build_base_sig () {
- return $self->_sig( [ $Code::TidyAll::VERSION, $self->plugins ] );
-}
+ my $plugins = $self->plugins;
+ $self->{plugin_objects} =
+ [ map { $self->load_plugin( $_, $plugins->{$_} ) } keys( %{ $self->plugins } ) ];
-method _build_plugin_objects () {
- return [ mapp { $self->load_plugin( $a, $b ) } %{ $self->plugins } ];
+ return $self;
}
-method load_plugin ($plugin_name, $plugin_conf) {
+sub load_plugin {
+ my ( $self, $plugin_name, $plugin_conf ) = @_;
my $class_name = (
$plugin_name =~ /^\+/
? substr( $plugin_name, 1 )
@@ -52,9 +78,8 @@ method load_plugin ($plugin_name, $plugin_conf) {
);
if ( can_load($class_name) ) {
return $class_name->new(
- conf => $plugin_conf,
- name => $plugin_name,
- root_dir => $self->root_dir
+ conf => $plugin_conf,
+ name => $plugin_name
);
}
else {
@@ -62,28 +87,72 @@ method load_plugin ($plugin_name, $plugin_conf) {
}
}
-method process_file ($file) {
- my $matched = 0;
- foreach my $plugin ( @{ $self->plugin_objects } ) {
- if ( $plugin->matcher->($file) ) {
- print "$file\n" if !$matched++;
- eval { $plugin->process_file($file) };
- if ( my $error = $@ ) {
- printf( "*** '%s': %s", $plugin->name, $error );
- return 0;
+sub process_path {
+ my ( $self, $path ) = @_;
+
+ ( -f $path ) ? $self->process_file($path)
+ : ( -d $path ) ? $self->process_dir($path)
+ : printf( "%s: not a file or directory\n", $path );
+}
+
+sub process_dir {
+ my ( $self, $dir ) = @_;
+ printf( "%s: skipping dir, not in recursive mode\n", $dir ) unless $self->recursive;
+ my @files;
+ find( { wanted => sub { push @files, $_ if -f }, no_chdir => 1 }, $dir );
+ foreach my $file (@files) {
+ $self->process_file($file);
+ }
+}
+
+sub process_file {
+ my ( $self, $file ) = @_;
+ my $cache = $self->cache;
+ if ( !$cache || ( ( $cache->get($file) || '' ) ne $self->_file_sig($file) ) ) {
+ my $matched = 0;
+ foreach my $plugin ( @{ $self->plugin_objects } ) {
+ if ( $plugin->matcher->($file) ) {
+ print "$file\n" if !$matched++;
+ eval { $plugin->process_file($file) };
+ if ( my $error = $@ ) {
+ printf( "*** '%s': %s\n", $plugin->name, $error );
+ return;
+ }
}
}
+ $cache->set( $file, $self->_file_sig($file) ) if $cache;
}
- return 1;
}
-method _file_sig ($file) {
+sub _find_file_upwards {
+ my ( $class, $search_dir, $search_file ) = @_;
+
+ $search_dir =~ s{/+$}{};
+ $search_file =~ s{^/+}{};
+
+ while (1) {
+ my $try_path = "$search_dir/$search_file";
+ if ( -f $try_path ) {
+ return $try_path;
+ }
+ elsif ( $search_dir eq '/' ) {
+ return undef;
+ }
+ else {
+ $search_dir = dirname($search_dir);
+ }
+ }
+}
+
+sub _file_sig {
+ my ( $self, $file ) = @_;
my $last_mod = ( stat($file) )[9];
my $contents = read_file($file);
return $self->_sig( [ $self->base_sig, $last_mod, $contents ] );
}
-method _sig ($data) {
+sub _sig {
+ my ( $self, $data ) = @_;
return sha1_hex( encode_json($data) );
}
@@ -95,14 +164,15 @@ __END__
=head1 NAME
-Code::TidyAll - Tidy and validate code in many ways at once
+Code::TidyAll - Tidy and validate code in multiple ways
=head1 SYNOPSIS
use Code::TidyAll;
my $ct = Code::TidyAll->new(
- root_dir => '...',
+ data_dir => '/tmp/.tidyall',
+ recursive => 1,
plugins => {
perltidy => {
include => qr/\.(pl|pm|t)$/,
@@ -129,7 +199,7 @@ Code::TidyAll - Tidy and validate code in many ways at once
},
}
);
- $ct->tidyall;
+ $ct->process_path($path1, $path2);
=head1 DESCRIPTION
@@ -137,11 +207,6 @@ Code::TidyAll - Tidy and validate code in many ways at once
=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.
@@ -176,10 +241,21 @@ only processed if it did not change since the last time it was processed.
=back
-=over
+=item backup_dir
+
+Where to backup files before processing. Defaults to C<data_dir>/backup.
+
+=item cache_dir
+
+A cache directory, used to ensure that files are only processed when they or
+the configuration has changed. Defaults to C<data_dir>/cache.
+
+=item data_dir
+
+Default parent directory for C<backup_dir> and C<cache_dir>.
-=item
+=item recursive
-=item
+Indcates whether L</process> will follow directories. Defaults to false.
=back
diff --git a/lib/Code/TidyAll/Cache.pm b/lib/Code/TidyAll/Cache.pm
new file mode 100644
index 0000000..cfe2a7a
--- /dev/null
+++ b/lib/Code/TidyAll/Cache.pm
@@ -0,0 +1,41 @@
+package Code::TidyAll::Cache;
+use Object::Tiny qw(cache_dir);
+use Digest::SHA1 qw(sha1_hex);
+use Code::TidyAll::Util qw(dirname mkpath read_file write_file);
+use strict;
+use warnings;
+
+sub new {
+ my $class = shift;
+ my $self = $class->SUPER::new(@_);
+ die "cache_dir required" unless $self->{cache_dir};
+ return $self;
+}
+
+sub path_to_key {
+ my ( $self, $key ) = @_;
+ my $sig = sha1_hex($key);
+ return join( "/", $self->cache_dir, substr( $sig, 0, 1 ), "$sig.dat" );
+}
+
+sub get {
+ my ( $self, $key ) = @_;
+
+ my $file = $self->path_to_key($key);
+ if ( defined $file && -f $file ) {
+ return read_file($file);
+ }
+ else {
+ return undef;
+ }
+}
+
+sub set {
+ my ( $self, $key, $value ) = @_;
+
+ my $file = $self->path_to_key($key);
+ mkpath( dirname($file), 0, 0775 );
+ write_file( $file, $value );
+}
+
+1;
diff --git a/lib/Code/TidyAll/Plugin.pm b/lib/Code/TidyAll/Plugin.pm
index 7a6228d..d3f171f 100644
--- a/lib/Code/TidyAll/Plugin.pm
+++ b/lib/Code/TidyAll/Plugin.pm
@@ -1,25 +1,32 @@
package Code::TidyAll::Plugin;
+use Object::Tiny qw(conf exclude include matcher name options root_dir);
use Code::TidyAll::Util qw(read_file write_file);
-use Moose;
-use Method::Signatures::Simple;
-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' );
+sub new {
+ my $class = shift;
+ my $self = $class->SUPER::new(@_);
+ die "conf required" unless $self->{conf};
+ die "name required" unless $self->{name};
-method defaults () { return {} }
+ $self->{include} = $self->_build_include();
+ $self->{exclude} = $self->_build_exclude();
+ $self->{matcher} = $self->_build_matcher();
+ $self->{options} = $self->_build_options();
-method process_file ($file) {
+ return $self;
+}
+
+sub defaults { return {} }
+
+sub process_file {
+ my ( $self, $file ) = @_;
my $source = read_file($file);
my $dest = $self->process_source($source);
write_file( $file, $dest );
}
-method _build_matcher () {
+sub _build_matcher {
+ my $self = shift;
my $conf = $self->conf;
my $include = $self->_match_spec_to_coderef( 'include', $self->include );
@@ -28,24 +35,28 @@ method _build_matcher () {
return sub { my $file = shift; return $include->($file) && !$exclude->($file) };
}
-method _build_include () {
+sub _build_include {
+ my $self = shift;
return
$self->conf->{include}
|| $self->defaults->{include}
|| die sprintf( "cannot determine include condition for plugin '%s'", $self->name );
}
-method _build_exclude () {
+sub _build_exclude {
+ my $self = shift;
return $self->conf->{exclude} || $self->defaults->{exclude} || sub { 0 };
}
-method _build_options () {
+sub _build_options {
+ my $self = shift;
my %options = %{ $self->{conf} };
delete( @options{qw(include exclude)} );
return \%options;
}
-method _match_spec_to_coderef ($type, $spec) {
+sub _match_spec_to_coderef {
+ my ( $self, $type, $spec ) = @_;
$spec = qr/$spec/ if ( !ref($spec) );
if ( ref($spec) eq 'Regexp' ) {
return sub { $_[0] =~ $spec };
diff --git a/lib/Code/TidyAll/Plugin/PerlTidy.pm b/lib/Code/TidyAll/Plugin/PerlTidy.pm
index 995d39b..acd63f9 100644
--- a/lib/Code/TidyAll/Plugin/PerlTidy.pm
+++ b/lib/Code/TidyAll/Plugin/PerlTidy.pm
@@ -1,8 +1,9 @@
package Code::TidyAll::Plugin::perltidy;
use Hash::MoreUtils qw(slice_exists);
use Perl::Tidy;
-use Moose;
-extends 'Code::TidyAll::Plugin';
+use strict;
+use warnings;
+use base qw(Code::TidyAll::Plugin);
sub defaults {
return { include => qr/\.(pl|pm|t)$/ };
@@ -10,7 +11,12 @@ sub defaults {
sub process_source {
my ( $self, $source ) = @_;
- my %params = slice_exists( $self->options, qw(argv prefilter postfilter) );
+ my $options = $self->options;
+
+ # Determine parameters
+ #
+ my %params = slice_exists( $self->options, qw(argv prefilter postfilter perltidyrc) );
+
Perl::Tidy::perltidy(
%params,
source => \$source,
diff --git a/lib/Code/TidyAll/Plugin/perlcritic.pm b/lib/Code/TidyAll/Plugin/perlcritic.pm
index 99dc8eb..8b9f863 100644
--- a/lib/Code/TidyAll/Plugin/perlcritic.pm
+++ b/lib/Code/TidyAll/Plugin/perlcritic.pm
@@ -1,9 +1,10 @@
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';
+use strict;
+use warnings;
+use base qw(Code::TidyAll::Plugin);
sub defaults {
return { include => qr/\.(pl|pm|t)$/ };
@@ -11,13 +12,11 @@ sub defaults {
sub process_file {
my ( $self, $file ) = @_;
+ my $options = $self->options;
# 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;
+ my @argv = split( /\s/, $options->{argv} || '' );
push( @argv, $file );
# Run perlcritic
@@ -25,10 +24,6 @@ sub process_file {
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
index fd5fdb2..6c35947 100644
--- a/lib/Code/TidyAll/Util.pm
+++ b/lib/Code/TidyAll/Util.pm
@@ -1,4 +1,6 @@
package Code::TidyAll::Util;
+use File::Basename;
+use File::Path;
use File::Slurp qw(read_file write_file);
use File::Temp qw(tempdir);
use Try::Tiny;
@@ -6,7 +8,7 @@ use strict;
use warnings;
use base qw(Exporter);
-our @EXPORT_OK = qw(can_load read_file tempdir_simple write_file );
+our @EXPORT_OK = qw(basename can_load dirname mkpath read_file tempdir_simple write_file );
sub can_load {
@@ -17,7 +19,7 @@ sub can_load {
my $result;
try {
- Class::MOP::load_class($class_name);
+ eval "require $class_name";
$result = 1;
}
catch {
diff --git a/t/use.t b/t/use.t
index 0a34989..cfefca3 100644
--- a/t/use.t
+++ b/t/use.t
@@ -1,5 +1,14 @@
#!perl
-use Test::More tests => 1;
-use File::Temp qw(tempdir);
+use Test::More;
+use Code::TidyAll;
+use Code::TidyAll::Util qw(tempdir_simple);
+use Capture::Tiny qw(capture_merged);
-use_ok('Code::TidyAll');
+my $root_dir = tempdir_simple('Code-TidyAll-XXXX');
+my $ct = Code::TidyAll->new(
+ root_dir => $root_dir,
+ plugins => {},
+);
+is( capture_merged { $ct->tidyall() }, '', 'no output' );
+
+done_testing();
diff --git a/xt/author/tidy-and-critic.t b/xt/author/tidy-and-critic.t
index fd7eccb..ca6c2e9 100644
--- a/xt/author/tidy-and-critic.t
+++ b/xt/author/tidy-and-critic.t
@@ -65,4 +65,34 @@ 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');
+$ct = Code::TidyAll->new(
+ root_dir => $root_dir,
+ plugins => {
+ perltidy => {},
+ perlcritic => {},
+ }
+);
+$output = capture_merged { $ct->tidyall() };
+is($output, '', 'no output');
+
+sleep(1);
+utime(time, time, "$root_dir/bin/bar.pl");
+$output = capture_merged { $ct->tidyall() };
+like( $output, qr/.*bar\.pl/ );
+$output = capture_merged { $ct->tidyall() };
+is($output, '', 'no output');
+
+$ct = Code::TidyAll->new(
+ root_dir => $root_dir,
+ plugins => {
+ perltidy => {argv => '-noll'},
+ perlcritic => {},
+ }
+);
+$output = capture_merged { $ct->tidyall() };
+like( $output, qr/.*Foo\.pm/ );
+like( $output, qr/.*bar\.pl/ );
+$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