[libcode-tidyall-perl] 17/374: ton of changes
Jonas Smedegaard
js at alioth.debian.org
Sun Sep 29 22:25:41 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 2fd46502363e543a22bfd372f52a201ae0153aeb
Author: Jonathan Swartz <swartz at pobox.com>
Date: Fri Jun 15 18:03:26 2012 -0500
ton of changes
---
bin/tidyall | 179 +++++++++----
lib/Code/TidyAll.pm | 270 ++++++++++----------
lib/Code/TidyAll/Plugin.pm | 65 +----
lib/Code/TidyAll/Plugin/PerlTidy.pm | 14 +-
lib/Code/TidyAll/Plugin/PodTidy.pm | 6 +-
lib/Code/TidyAll/Plugin/perlcritic.pm | 4 -
.../Test/Plugin/{RepeatBar.pm => RepeatFoo.pm} | 6 +-
lib/Code/TidyAll/Test/Plugin/ReverseFoo.pm | 4 -
lib/Code/TidyAll/Test/Plugin/UpperText.pm | 4 -
lib/Code/TidyAll/Util.pm | 6 +-
lib/Code/TidyAll/t/Basic.pm | 115 +++++----
11 files changed, 355 insertions(+), 318 deletions(-)
diff --git a/bin/tidyall b/bin/tidyall
index d6c34aa..a4ede36 100755
--- a/bin/tidyall
+++ b/bin/tidyall
@@ -1,7 +1,7 @@
#!/usr/bin/perl
use Getopt::Long;
use Pod::Usage;
-use Code::TidyAll::Util qw(can_load);
+use Code::TidyAll::Util qw(can_load dirname);
use Hash::MoreUtils qw(slice_def);
use strict;
use warnings;
@@ -10,10 +10,10 @@ sub usage {
my $msg = shift;
print "$msg\n" if $msg;
require Pod::Usage;
- Pod::Usage::pod2usage( { verbose => 2 } );
+ Pod::Usage::pod2usage( { verbose => 1 } );
}
-my ( %params, $help );
+my ( %params, $help, $all );
my $class = 'Code::TidyAll';
GetOptions(
@@ -22,22 +22,30 @@ GetOptions(
'data-dir=s' => \$params{data_dir},
'no-backups' => \$params{no_backups},
'no-cache' => \$params{no_cache},
- 'c|conf=s' => \$params{conf_file},
+ 'a|all' => \$all,
'h|help' => \$help,
- 'r|recursive' => \$params{recursive},
'v|verbose' => \$params{verbose},
) or usage();
-usage("") if $help;
-usage("-c|--conf required") if !defined( $params{conf_file} );
+Pod::Usage::pod2usage( { verbose => 2 } ) if $help;
+
die "cannot load '$class'" unless can_load($class);
%params = slice_def( \%params );
-my @paths = @ARGV or usage("path(s) required");
-
-my $ct = $class->new(%params);
-$ct->process_paths(@paths);
+if ($all) {
+ my $start_dir = shift(@ARGV) || cwd();
+ $params{conf_file} = $class->find_conf_file( $start_dir, "tidyall.ini" );
+ my $ct = $class->new(%params);
+ $ct->process_all();
+}
+else {
+ my @files = @ARGV or die "file(s) or -a required";
+ my $start_dir = dirname( $files[0] );
+ $params{conf_file} = $class->find_conf_file( $start_dir, "tidyall.ini" );
+ my $ct = $class->new(%params);
+ $ct->process_files(@files);
+}
1;
@@ -49,20 +57,29 @@ tidyall - Your all-in-one code tidier and validator
=head1 SYNOPSIS
- # Process one or more specific files
- tidyall -c /path/to/config file [file...]
+ # Create a tidyall.ini at the top of your project
+ [PerlTidy]
+ argv = -noll -it=2
+ select = **/*.{pl,pm,t}
+
+ [PerlCritic]
+ argv = -severity 3
+ select = lib/**/*.pm
+ ignore = lib/UtterHack.pm
+
+ # Process all files in the current project, look upwards from the cwd for tidyall.ini
+ % tidyall -a
- # Process all files under a directory
- tidyall -c /path/to/config -r dir
+ # Process one or more specific files, look upwards from the first file for tidyall.ini
+ % tidyall file [file...]
=head1 OPTIONS
- -c, --conf Required configuration file
+ -a, --all Process all files in the project
-h, --help Print help message
- -r, --recursive Descend into directories recursively
- --backup-ttl When backup files can be purged. Defaults to "1d"
+ --backup-ttl When backup files can be purged. Defaults to "1h"
--class Code::TidyAll subclass to use. Defaults to "Code::TidyAll"
- --data-dir Container for backups, cache, etc. Defaults to dir of conf file
+ --data-dir Contains data like backups and cache. Defaults to root_dir/.tidyall.d
--no-backup Don't backup files
--no-cache Don't cache last processed times; process all files every time
@@ -89,38 +106,80 @@ L<xmllint|http://xmlsoft.org/xmllint.html>.
Many tidiers are also validators, e.g. C<perltidy> will throw an error on badly
formed Perl.
-=head1 CONFIGURATION
+=head1 USING TIDYALL
+
+C<tidyall> works on a project basis, where a project is just a directory
+hierarchy of files. svn or git working directories are typical examples
+of projects.
+
+The top of the project is called the I<root directory>. In the root directory
+you'll need a C<tidyall.ini> config file. It defines how various tidiers
+and validators will be applied to the files in your project.
-An INI-style config file, specified with -c, is required to use C<tidyall>. If
-the path is of the form I<dir>/.../I<file>, it will look upwards from I<dir>
-for I<file>.
+C<tidyall> will find your root directory and config file automagically
+depending on how you call it:
-Here's a sample config file:
+=over
+
+=item tidyall file [file...]
+
+C<tidyall> will search upwards from the first I<file> for C<tidyall.ini>.
+
+=item tidyall -a dir
+
+C<tidyall> will search upwards from I<dir> for C<tidyall.ini>.
+
+=item tidyall -a
+
+C<tidyall> will search upwards from the current working directory for C<tidyall.ini>.
+
+=back
+
+=head2 Configuration format
+
+The config file is in L<Config::INI|Config::INI> format. Here's a sample:
[PerlTidy]
argv = -noll -it=2
- include = *.pl *.pm *.t
+ select = **/*.{pl,pm,t}
[PerlCritic]
argv = -severity 3
+ select = lib/**/*.pm
+ ignore = lib/UtterHack.pm
[PodTidy]
+ select = lib/**/*.{pm,pod}
[HTMLTidy]
argv = -wrap 70 -indent
+ select = docs/**/*.html
-Section 1 says to apply C<PerlTidy> with settings "-noll -it=2" to all Perl
-scripts, modules and test files.
+=over
-Section 2 says to apply C<PerlCritic> with severity 3. Since there is no
-C<include> clause, the default for C<PerlCritic> plugin is used, which happens
-to be the same as above: "*.pl *.pm *.t".
+In order, the four sections declare:
-Section 3 says to apply C<PodTidy> with default settings, to the same set of
-default files "*.pl *.pm *.t".
+=item *
-Section 4 says to apply C<HTMLTidy> with settings "-wrap 70 -indent" against
-the default set of files, in this case "*.html *.htm".
+Apply C<PerlTidy> with settings "-noll -it=2" to all *.pl, *.pm, and *.t
+files.
+
+=item *
+
+Apply C<PerlCritic> with severity 3 to all Perl modules somewhere underneath
+"lib/", except for anything matching "Tmp".
+
+=item *
+
+Apply C<PodTidy> with default settings to all .pm and .pod files underneath
+"lib/".
+
+=item *
+
+Apply C<HTMLTidy> with settings "-wrap 70 -indent" to all *.html files under
+"docs/".
+
+=back
=head2 Standard configuration elements
@@ -138,32 +197,59 @@ with a '+', e.g.
# Uses plugin My::TidyAll::Plugin
[+My::TidyAll::Plugin]
-=item include
+=item select
+
+A L<File::Zglob|File::Zglob> pattern indicating which files to select. The
+pattern is relative to the root directory and should have no leading slash.
+Special characters are:
+
+=over
+
+=item C<< * >>
-One or more glob patterns indicating which files to include, separated by
-whitespace. If not specified, use the default set for the plugin.
+At the beginning of a component, matches zero or more characters except a period (.). Otherwise matches zero or more sequence of any characters.
-=item exclude
+=item C<< ** >>
-One or more glob patterns indicating which files to exclude, separated by
-whitespace. This overrides C<include>.
+Matches zero or more components that match *. For example, src/**/*.h matches
+
+ src/*.h
+ src/*/*.h
+ src/*/*/*.h
+ ...
+
+=item C<< ? >>
+
+At the beginning of a component, matches a character except a period (.). Otherwise, it matches any single character.
+
+=item C<< [chars] >>
+
+Matches any one of the set.
+
+=item C<< {pm,pl} >>
+
+Matches any of the alternatives.
=back
-=head1 DATA DIRECTORY
+=item ignore
+
+A L<File::Zglob|File::Zglob> pattern indicating which files to ignore.
+This overrides C<select>.
-C<tidyall> keeps cache and backup files (below) under a data directory. It can
-be specified with C<--data-dir>; by default it is a directory named
-".tidyall.d" in the same path as the config file.
+=back
-=head1 LAST-PROCESSED CACHE
+=head1 OTHER FEATURES
+
+=head2 Last-processed cache
C<tidyall> keeps track of each file's signature after it was last processed. On
subsequent runs, it will only process a file if its signature has changed.
+The cache is kept in files under the data dir.
You can turn off this behavior with C<--no-cache>.
-=head1 BACKUPS
+=head2 Backups
C<tidyall> will backup each file before modifying it. The timestamped backups
are kept in a separate directory hierarchy under the data dir.
@@ -175,4 +261,3 @@ run. It may be specified as "30min" or "4h" or any string acceptable to
L<Time::Duration::Parse>. It defaults to "1h" (1 hour).
You can turn off backups with C<--no-backups>.
-
diff --git a/lib/Code/TidyAll.pm b/lib/Code/TidyAll.pm
index 27fe77c..a125a9f 100644
--- a/lib/Code/TidyAll.pm
+++ b/lib/Code/TidyAll.pm
@@ -2,11 +2,14 @@ package Code::TidyAll;
use Cwd qw(realpath);
use Config::INI::Reader;
use Code::TidyAll::Cache;
-use Code::TidyAll::Util qw(basename can_load dirname dump_one_line mkpath read_file write_file);
+use Code::TidyAll::Util
+ qw(abs2rel basename can_load dirname dump_one_line mkpath read_dir read_file uniq write_file);
use Date::Format;
use Digest::SHA1 qw(sha1_hex);
use File::Find qw(find);
+use File::Zglob;
use Time::Duration::Parse qw(parse_duration);
+use Try::Tiny;
use strict;
use warnings;
@@ -33,6 +36,7 @@ use Object::Tiny qw(
backup_dir
base_sig
cache
+ matched_files
plugin_objects
);
@@ -49,37 +53,27 @@ sub new {
join( ", ", sort map { "'$_'" } @bad_params ) );
}
- # Read params from conf file, if provided; handle .../ upward search syntax
+ # Read params from conf file
#
- 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 = Config::INI::Reader->read_file($conf_file);
- if ( ref($conf_params) ne 'HASH' ) {
- die "'$conf_file' did not evaluate to a hash";
- }
+ if ( my $conf_file = $params{conf_file} ) {
+ my $conf_params = $class->_read_conf_file($conf_file);
my $main_params = delete( $conf_params->{'_'} ) || {};
- %params = ( plugins => $conf_params, %$main_params, %params );
- $params{root_dir} ||= dirname($conf_file);
+ %params = (
+ plugins => $conf_params,
+ root_dir => realpath( dirname($conf_file) ),
+ %$main_params, %params
+ );
+ }
+ else {
+ die "conf_file or plugins required" unless $params{plugins};
+ die "conf_file or root_dir required" unless $params{root_dir};
}
- die "conf_file or plugins required" unless $params{plugins};
- die "conf_file or root_dir required" unless $params{root_dir};
$class->msg( "constructing %s with these params: %s", $class, \%params )
if ( $params{verbose} );
my $self = $class->SUPER::new(%params);
- $self->{root_dir} = realpath( $self->{root_dir} );
$self->{data_dir} ||= $self->root_dir . "/.tidyall.d";
unless ( $self->no_cache ) {
@@ -96,9 +90,11 @@ sub new {
}
my $plugins = $self->plugins;
+
$self->{base_sig} = $self->_sig( [ $Code::TidyAll::VERSION || 0, $plugins ] );
$self->{plugin_objects} =
- [ map { $self->load_plugin( $_, $plugins->{$_} ) } keys( %{ $self->plugins } ) ];
+ [ map { $self->load_plugin( $_, $plugins->{$_} ) } sort keys( %{ $self->plugins } ) ];
+ $self->{matched_files} = $self->_find_matched_files;
return $self;
}
@@ -110,46 +106,26 @@ sub load_plugin {
? substr( $plugin_name, 1 )
: "Code::TidyAll::Plugin::$plugin_name"
);
- if ( can_load($class_name) ) {
- return $class_name->new(
- conf => $plugin_conf,
- name => $plugin_name
- );
- }
- else {
- die "could not load plugin class '$class_name'";
- }
-}
-
-sub process_paths {
- my ( $self, @paths ) = @_;
- foreach my $path (@paths) {
- $self->process_path($path);
+ try {
+ can_load($class_name) || die "not found";
}
+ catch {
+ die "could not load plugin class '$class_name': $_";
+ };
+ return $class_name->new(
+ conf => $plugin_conf,
+ name => $plugin_name
+ );
}
-sub process_path {
- my ( $self, $path ) = @_;
- $path = realpath($path);
- unless ( index( $path, $self->root_dir ) == 0 ) {
- $self->msg( "%s: skipping, not underneath root dir '%s'", $path, $self->root_dir );
- return;
- }
+sub process_all {
+ my $self = shift;
- ( -f $path ) ? $self->_process_file($path)
- : ( -d $path ) ? $self->_process_dir($path)
- : $self->msg( "%s: not a file or directory", $path );
+ $self->process_files( keys( %{ $self->matched_files } ) );
}
-sub _process_dir {
- my ( $self, $dir ) = @_;
- unless ( $self->recursive ) {
- $self->msg( "%s: skipping dir, not in recursive mode", $self->_small_path($dir) );
- return;
- }
- return if basename($dir) eq '.tidyall.d';
- my @files;
- find( { follow => 0, wanted => sub { push @files, $_ if -f }, no_chdir => 1 }, $dir );
+sub process_files {
+ my ( $self, @files ) = @_;
foreach my $file (@files) {
$self->_process_file($file);
}
@@ -158,36 +134,62 @@ sub _process_dir {
sub _process_file {
my ( $self, $file ) = @_;
- my $cache = $self->cache;
+ my @plugins = @{ $self->matched_files->{$file} || [] };
my $small_path = $self->_small_path($file);
- if ( $self->no_cache
- || ( ( $cache->get("sig/$small_path") || '' ) ne $self->_file_sig($file) ) )
- {
- my $matched = 0;
- foreach my $plugin ( @{ $self->plugin_objects } ) {
- if ( $plugin->matcher->($small_path) ) {
- if ( !$matched++ ) {
- $self->msg( "%s", $small_path );
- $self->_backup_file($file);
- }
- $self->msg( " applying '%s'", $plugin->name ) if $self->verbose;
- eval { $plugin->process_file($file) };
- if ( my $error = $@ ) {
- $self->msg( "*** '%s': %s", $plugin->name, $error );
- return;
- }
- }
+ if ( !@plugins ) {
+ $self->msg( "[no plugins apply] %s", $small_path );
+ }
+
+ my $cache = $self->cache;
+ my $error;
+ my $orig_contents = read_file($file);
+ if ( $cache && ( my $sig = $cache->get("sig/$small_path") ) ) {
+ return if $sig eq $self->_file_sig( $file, $orig_contents );
+ }
+
+ foreach my $plugin (@plugins) {
+ try {
+ $plugin->process_file($file);
}
- $cache->set( "sig/$small_path", $self->_file_sig($file) ) unless $self->no_cache;
+ catch {
+ $error = sprintf( "*** '%s': %s", $plugin->name, $_ );
+ };
+ last if $error;
}
+
+ my $new_contents = read_file($file);
+ my $was_tidied = $orig_contents ne $new_contents;
+ my $status = $was_tidied ? "[tidied] " : "[checked] ";
+ my $plugin_names =
+ $self->verbose ? sprintf( " (%s)", join( ", ", map { $_->name } @plugins ) ) : "";
+ $self->msg( "%s%s%s", $status, $small_path, $plugin_names );
+ $self->_backup_file( $file, $orig_contents ) if $was_tidied;
+
+ if ($error) {
+ $self->msg( "%s", $error );
+ }
+ else {
+ $cache->set( "sig/$small_path", $self->_file_sig( $file, $new_contents ) ) if $cache;
+ }
+}
+
+sub _read_conf_file {
+ my ( $class, $conf_file ) = @_;
+ my $conf_string = read_file($conf_file);
+ my $root_dir = basename($conf_file);
+ $conf_string =~ s/\$ROOT/$root_dir/g;
+ my $conf_hash = Config::INI::Reader->read_string($conf_string);
+ die "'$conf_file' did not evaluate to a hash"
+ unless ( ref($conf_hash) eq 'HASH' );
+ return $conf_hash;
}
sub _backup_file {
- my ( $self, $file ) = @_;
+ my ( $self, $file, $contents ) = @_;
unless ( $self->no_backups ) {
my $backup_file = join( "/", $self->backup_dir, $self->_backup_filename($file) );
mkpath( dirname($backup_file), 0, 0775 );
- write_file( $backup_file, read_file($file) );
+ write_file( $backup_file, $contents );
}
}
@@ -223,7 +225,7 @@ sub _purge_backups {
);
}
-sub _find_file_upwards {
+sub find_conf_file {
my ( $class, $search_dir, $search_file ) = @_;
$search_dir =~ s{/+$}{};
@@ -243,16 +245,41 @@ sub _find_file_upwards {
}
}
+sub _find_matched_files {
+ my ($self) = @_;
+
+ my %matched_files;
+ foreach my $plugin ( @{ $self->plugin_objects } ) {
+ my @selected = $self->_zglob( $plugin->select );
+ if ( defined( $plugin->ignore ) ) {
+ my %is_ignored = map { ( $_, 1 ) } $self->_zglob( $plugin->ignore );
+ @selected = grep { !$is_ignored{$_} } @selected;
+ }
+ foreach my $file (@selected) {
+ $matched_files{$file} ||= [];
+ push( @{ $matched_files{$file} }, $plugin );
+ }
+ }
+ return \%matched_files;
+}
+
+sub _zglob {
+ my ( $self, $expr ) = @_;
+
+ return File::Zglob::zglob( join( "/", $self->root_dir, $expr ) );
+}
+
sub _small_path {
my ( $self, $path ) = @_;
- die "'%s' is not underneath root dir '%s'!" unless index( $path, $self->root_dir ) == 0;
+ die sprintf( "'%s' is not underneath root dir '%s'!", $path, $self->root_dir )
+ unless index( $path, $self->root_dir ) == 0;
return substr( $path, length( $self->root_dir ) + 1 );
}
sub _file_sig {
- my ( $self, $file ) = @_;
+ my ( $self, $file, $contents ) = @_;
my $last_mod = ( stat($file) )[9];
- my $contents = read_file($file);
+ $contents = read_file($file) if !defined($contents);
return $self->_sig( [ $self->base_sig, $last_mod, $contents ] );
}
@@ -282,81 +309,54 @@ Code::TidyAll - Engine for tidyall, your all-in-one code tidier and validator
use Code::TidyAll;
my $ct = Code::TidyAll->new(
- data_dir => '/tmp/.tidyall',
- recursive => 1,
+ conf_file => '/path/to/conf/file'
+ );
+
+ # or
+
+ my $ct = Code::TidyAll->new(
+ root_dir => '/path/to/root',
plugins => {
perltidy => {
- include => qr/\.(pl|pm|t)$/,
+ select => qr/\.(pl|pm|t)$/,
options => { argv => '-noll -it=2' },
},
perlcritic => {
- include => qr/\.(pl|pm|t)$/,
+ select => 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->process_path($path1, $path2);
+ $ct->process_paths($path1, $path2);
=head1 DESCRIPTION
-=head1 CONSTRUCTOR OPTIONS
-
-=over
-
-=item plugins
+This is the engine used by L<tidyall|tidyall>, which you can use from your
+own program instead of calling C<tidyall>.
-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 '+'.
+=head1 CONSTRUCTOR OPTIONS
-Each value is a configuration hash for the plugin. The configuration hash may
-contain:
+These options are the same as the equivalents in C<tidyall>, replacing dashes
+with underscore (e.g. the C<backup-ttl> option becomes C<backup_ttl> here).
=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
+=item backup_ttl
-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 conf_file
-=item options
-
-Options specific to the plugin to be used for its tidying/validation.
-
-=back
-
-=item cache
+=item data_dir
-A cache object, or a hashref of parameters to pass to L<CHI|CHI> to construct a
-cache. This overrides the default cache.
+=item no_backups
-=item data_dir
+=item no_cache
-Data directory for backups and cache.
+=item plugins
=item recursive
-Indcates whether L</process> will follow directories. Defaults to false.
+=item root_dir
+
+=item verbose
=back
diff --git a/lib/Code/TidyAll/Plugin.pm b/lib/Code/TidyAll/Plugin.pm
index 322b0f2..4014a29 100644
--- a/lib/Code/TidyAll/Plugin.pm
+++ b/lib/Code/TidyAll/Plugin.pm
@@ -1,6 +1,8 @@
package Code::TidyAll::Plugin;
-use Object::Tiny qw(conf exclude include matcher name options root_dir);
+use Object::Tiny qw(conf ignore matcher name options root_dir select);
use Code::TidyAll::Util qw(read_file write_file);
+use strict;
+use warnings;
sub new {
my $class = shift;
@@ -8,16 +10,17 @@ sub new {
die "conf required" unless $self->{conf};
die "name required" unless $self->{name};
- $self->{include} = $self->_build_include();
- $self->{exclude} = $self->_build_exclude();
- $self->{matcher} = $self->_build_matcher();
+ my $name = $self->{name};
+ $self->{select} = $self->{conf}->{select} or die "select required for '$name'";
+ die "select for '$name' should not begin with /" if substr( $self->{select}, 0, 1 ) eq '/';
+ $self->{ignore} = $self->{conf}->{ignore};
+ die "ignore for '$name' should not begin with /"
+ if defined( $self->{ignore} ) && substr( $self->{ignore}, 0, 1 ) eq '/';
$self->{options} = $self->_build_options();
return $self;
}
-sub defaults { return {} }
-
sub process_file {
my ( $self, $file ) = @_;
my $source = read_file($file);
@@ -25,58 +28,16 @@ sub process_file {
write_file( $file, $dest );
}
-sub _build_matcher {
- my $self = shift;
- my $conf = $self->conf;
-
- 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) };
-}
-
-sub _build_include {
- my $self = shift;
- return
- $self->conf->{include}
- || $self->defaults->{include}
- || die sprintf( "did not specify include for plugin '%s', and no default", $self->name );
-}
-
-sub _build_exclude {
- my $self = shift;
- return $self->conf->{exclude} || $self->defaults->{exclude} || sub { 0 };
+sub process_source {
+ my ( $self, $source ) = @_;
+ die sprintf( "plugin '%s' must implement either process_file or process_source", $self->name );
}
sub _build_options {
my $self = shift;
my %options = %{ $self->{conf} };
- delete( @options{qw(include exclude)} );
+ delete( @options{qw(select ignore)} );
return \%options;
}
-sub _match_spec_to_coderef {
- my ( $self, $type, $spec ) = @_;
-
- $spec = $self->_glob_to_regex($spec) if !ref($spec);
- if ( ref($spec) eq 'Regexp' ) {
- return sub { $_[0] =~ $spec };
- }
- elsif ( ref($spec) eq 'CODE' ) {
- return $spec;
- }
- else {
- die sprintf( "bad '%s' conf value for plugin '%s': '%s'", $type, $self->name, $spec );
- }
-}
-
-sub _glob_to_regex {
- my ( $self, $spec ) = @_;
-
- my @patterns = split( /\s+/, $spec );
- foreach (@patterns) { s/\./\\\./g; s/\*/.*/g }
- my $regex = join( '|', @patterns );
- return qr/$regex/;
-}
-
1;
diff --git a/lib/Code/TidyAll/Plugin/PerlTidy.pm b/lib/Code/TidyAll/Plugin/PerlTidy.pm
index 5fb431f..8c9fe83 100644
--- a/lib/Code/TidyAll/Plugin/PerlTidy.pm
+++ b/lib/Code/TidyAll/Plugin/PerlTidy.pm
@@ -1,23 +1,23 @@
package Code::TidyAll::Plugin::PerlTidy;
+use Code::TidyAll::Util qw(can_load);
use Hash::MoreUtils qw(slice_exists);
-use Perl::Tidy;
use strict;
use warnings;
use base qw(Code::TidyAll::Plugin);
-sub defaults {
- return { include => qr/\.(pl|pm|t)$/ };
-}
-
sub process_source {
my ( $self, $source ) = @_;
- my $options = $self->options;
+ my $options = $self->options;
+ my $perl_tidy_class = $self->options->{perl_tidy_class} || 'Perl::Tidy';
+ my $perl_tidy_function = $perl_tidy_class . "::perltidy";
+ die "cannot load '$perl_tidy_class'" unless can_load($perl_tidy_class);
# Determine parameters
#
my %params = slice_exists( $self->options, qw(argv prefilter postfilter perltidyrc) );
- Perl::Tidy::perltidy(
+ no strict 'refs';
+ &$perl_tidy_function(
%params,
source => \$source,
destination => \my $destination,
diff --git a/lib/Code/TidyAll/Plugin/PodTidy.pm b/lib/Code/TidyAll/Plugin/PodTidy.pm
index a133be9..72a55ea 100644
--- a/lib/Code/TidyAll/Plugin/PodTidy.pm
+++ b/lib/Code/TidyAll/Plugin/PodTidy.pm
@@ -6,10 +6,6 @@ use strict;
use warnings;
use base qw(Code::TidyAll::Plugin);
-sub defaults {
- return { include => qr/\.(pl|pm|t)$/ };
-}
-
sub process_file {
my ( $self, $file ) = @_;
my $options = $self->options;
@@ -24,7 +20,7 @@ sub process_file {
verbose => 1,
);
};
- die $output if $output =~ /\S/;
+ die $output if $output =~ /\S/ && $output !~ /does not contain Pod/;
}
1;
diff --git a/lib/Code/TidyAll/Plugin/perlcritic.pm b/lib/Code/TidyAll/Plugin/perlcritic.pm
index 98d6443..48e9987 100644
--- a/lib/Code/TidyAll/Plugin/perlcritic.pm
+++ b/lib/Code/TidyAll/Plugin/perlcritic.pm
@@ -6,10 +6,6 @@ use strict;
use warnings;
use base qw(Code::TidyAll::Plugin);
-sub defaults {
- return { include => qr/\.(pl|pm|t)$/ };
-}
-
sub process_file {
my ( $self, $file ) = @_;
my $options = $self->options;
diff --git a/lib/Code/TidyAll/Test/Plugin/RepeatBar.pm b/lib/Code/TidyAll/Test/Plugin/RepeatFoo.pm
similarity index 71%
rename from lib/Code/TidyAll/Test/Plugin/RepeatBar.pm
rename to lib/Code/TidyAll/Test/Plugin/RepeatFoo.pm
index 10f5a5c..98d952c 100644
--- a/lib/Code/TidyAll/Test/Plugin/RepeatBar.pm
+++ b/lib/Code/TidyAll/Test/Plugin/RepeatFoo.pm
@@ -1,13 +1,9 @@
-package Code::TidyAll::Test::Plugin::RepeatBar;
+package Code::TidyAll::Test::Plugin::RepeatFoo;
use Code::TidyAll::Util qw(read_file write_file);
use base qw(Code::TidyAll::Plugin);
use strict;
use warnings;
-sub defaults {
- return { include => qr/foo[^\/]+$/ };
-}
-
sub process_source {
my ( $self, $source ) = @_;
my $times = $self->options->{times} || die "no times specified";
diff --git a/lib/Code/TidyAll/Test/Plugin/ReverseFoo.pm b/lib/Code/TidyAll/Test/Plugin/ReverseFoo.pm
index 6abe867..cebe571 100644
--- a/lib/Code/TidyAll/Test/Plugin/ReverseFoo.pm
+++ b/lib/Code/TidyAll/Test/Plugin/ReverseFoo.pm
@@ -4,10 +4,6 @@ use base qw(Code::TidyAll::Plugin);
use strict;
use warnings;
-sub defaults {
- return { include => qr/foo[^\/]+$/ };
-}
-
sub process_file {
my ( $self, $file ) = @_;
write_file( $file, scalar( reverse( read_file($file) ) ) );
diff --git a/lib/Code/TidyAll/Test/Plugin/UpperText.pm b/lib/Code/TidyAll/Test/Plugin/UpperText.pm
index 4f7a2f1..5edea5d 100644
--- a/lib/Code/TidyAll/Test/Plugin/UpperText.pm
+++ b/lib/Code/TidyAll/Test/Plugin/UpperText.pm
@@ -3,10 +3,6 @@ use base qw(Code::TidyAll::Plugin);
use strict;
use warnings;
-sub defaults {
- return { include => qr/\.txt$/ };
-}
-
sub process_source {
my ( $self, $source ) = @_;
if ( $source =~ /^[A-Z]*$/i ) {
diff --git a/lib/Code/TidyAll/Util.pm b/lib/Code/TidyAll/Util.pm
index aba9f2b..1f9ecac 100644
--- a/lib/Code/TidyAll/Util.pm
+++ b/lib/Code/TidyAll/Util.pm
@@ -2,15 +2,17 @@ package Code::TidyAll::Util;
use Data::Dumper;
use File::Basename;
use File::Path;
-use File::Slurp qw(read_file write_file);
+use File::Slurp qw(read_file write_file read_dir);
+use File::Spec::Functions qw(abs2rel);
use File::Temp qw(tempdir);
+use List::MoreUtils qw(uniq);
use Try::Tiny;
use strict;
use warnings;
use base qw(Exporter);
our @EXPORT_OK =
- qw(basename can_load dirname dump_one_line mkpath read_file tempdir_simple write_file );
+ qw(abs2rel basename can_load dirname dump_one_line mkpath read_dir read_file tempdir_simple uniq write_file );
sub can_load {
diff --git a/lib/Code/TidyAll/t/Basic.pm b/lib/Code/TidyAll/t/Basic.pm
index 14b1664..0e27307 100644
--- a/lib/Code/TidyAll/t/Basic.pm
+++ b/lib/Code/TidyAll/t/Basic.pm
@@ -7,9 +7,9 @@ use File::Find qw(find);
use Test::Class::Most parent => 'Code::TidyAll::Test::Class';
sub test_plugin { "+Code::TidyAll::Test::Plugin::$_[0]" }
-my $UpperText = test_plugin('UpperText');
-my $ReverseFoo = test_plugin('ReverseFoo');
-my $RepeatBar = test_plugin('RepeatBar');
+my %UpperText = ( test_plugin('UpperText') => { select => '**/*.txt' } );
+my %ReverseFoo = ( test_plugin('ReverseFoo') => { select => '**/foo*' } );
+my %RepeatFoo = ( test_plugin('RepeatFoo') => { select => '**/foo*' } );
my ( $conf1, $conf2 );
sub create_dir {
@@ -38,7 +38,7 @@ sub tidy {
%$options
);
- my $output = capture_stdout { $ct->process_paths($root_dir) };
+ my $output = capture_stdout { $ct->process_all() };
if ( $params{errors} ) {
like( $output, $params{errors}, "$desc - errors" );
}
@@ -57,21 +57,21 @@ sub test_basic : Tests {
desc => 'one file no plugins',
);
$self->tidy(
- plugins => { $UpperText => {} },
- source => { "foo.txt" => "abc" },
- dest => { "foo.txt" => "ABC" },
+ plugins => {%UpperText},
+ source => { "foo.txt" => "abc" },
+ dest => { "foo.txt" => "ABC" },
desc => 'one file UpperText',
);
$self->tidy(
- plugins => { $UpperText => {}, $ReverseFoo => {} },
+ plugins => { %UpperText, %ReverseFoo },
source => { "foo.txt" => "abc", "bar.txt" => "def", "foo.tx" => "ghi", "bar.tx" => "jkl" },
dest => { "foo.txt" => "CBA", "bar.txt" => "DEF", "foo.tx" => "ihg", "bar.tx" => "jkl" },
desc => 'four files UpperText ReverseFoo',
);
$self->tidy(
- plugins => { $UpperText => {} },
- source => { "foo.txt" => "abc1" },
- dest => { "foo.txt" => "abc1" },
+ plugins => {%UpperText},
+ source => { "foo.txt" => "abc1" },
+ dest => { "foo.txt" => "abc1" },
desc => 'one file UpperText errors',
errors => qr/non-alpha content/
);
@@ -82,34 +82,39 @@ sub test_caching_and_backups : Tests {
foreach my $no_cache ( 0 .. 1 ) {
foreach my $no_backups ( 0 .. 1 ) {
+ my $desc = "(no_cache=$no_cache, no_backups=$no_backups)";
my $root_dir = $self->create_dir( { "foo.txt" => "abc" } );
- my $ct = Code::TidyAll->new(
- plugins => { $UpperText => {} },
+ my $ct = Code::TidyAll->new(
+ plugins => {%UpperText},
root_dir => $root_dir,
( $no_cache ? ( no_cache => 1 ) : () ), ( $no_backups ? ( no_backups => 1 ) : () )
);
my $output;
my $file = "$root_dir/foo.txt";
my $go = sub {
- $output = capture_stdout { $ct->process_paths($file) };
+ $output = capture_stdout { $ct->process_files($file) };
};
$go->();
- is( read_file($file), "ABC", "file changed" );
- is( $output, "foo.txt\n", 'output' );
+ is( read_file($file), "ABC", "first file change $desc" );
+ is( $output, "[tidied] foo.txt\n", "first output $desc" );
$go->();
if ($no_cache) {
- is( $output, "foo.txt\n", 'output' );
+ is( $output, "[checked] foo.txt\n", "second output $desc" );
}
else {
- is( $output, '', 'no output' );
+ is( $output, '', "second output $desc" );
}
+ write_file( $file, "ABCD" );
+ $go->();
+ is( $output, "[checked] foo.txt\n", "third output $desc" );
+
write_file( $file, "def" );
$go->();
- is( read_file($file), "DEF", "file changed" );
- is( $output, "foo.txt\n", 'output' );
+ is( read_file($file), "DEF", "fourth file change $desc" );
+ is( $output, "[tidied] foo.txt\n", "fourth output $desc" );
my $backup_dir = $ct->data_dir . "/backups";
mkpath( $backup_dir, 0, 0775 );
@@ -117,13 +122,16 @@ sub test_caching_and_backups : Tests {
find( { follow => 0, wanted => sub { push @files, $_ if -f }, no_chdir => 1 },
$backup_dir );
if ($no_backups) {
- ok( @files == 0, "no backup files" );
+ ok( @files == 0, "no backup files $desc" );
}
else {
- ok( scalar(@files) == 1 || scalar(@files) == 2, "1 or 2 backup files" );
+ ok( scalar(@files) == 1 || scalar(@files) == 2, "1 or 2 backup files $desc" );
foreach my $file (@files) {
- like( $file, qr|\.tidyall\.d/backups/foo\.txt-\d+-\d+\.bak|,
- "backup filename" );
+ like(
+ $file,
+ qr|\.tidyall\.d/backups/foo\.txt-\d+-\d+\.bak|,
+ "backup filename $desc"
+ );
}
}
}
@@ -145,25 +153,27 @@ sub test_errors : Tests {
);
}
qr/unknown constructor param\(s\) 'bad_param', 'worse_param'/;
- throws_ok { Code::TidyAll->new( root_dir => $root_dir, plugins => { 'DoesNotExist' => {} } ) }
+ throws_ok {
+ Code::TidyAll->new(
+ root_dir => $root_dir,
+ plugins => { 'DoesNotExist' => { select => '**/*' } }
+ );
+ }
qr/could not load plugin class/;
- my $ct = Code::TidyAll->new( plugins => { $UpperText => {} }, root_dir => $root_dir );
- my $output = capture_stdout { $ct->process_paths("$root_dir/foo/bar.txt") };
- is( $output, "foo/bar.txt\n", "filename output" );
- is( read_file("$root_dir/foo/bar.txt"), "ABC", "tidied" );
- $output = capture_stdout { $ct->process_paths("$root_dir/foo") };
- is( $output, "foo: skipping dir, not in recursive mode\n" );
+ my $ct = Code::TidyAll->new( plugins => {%UpperText}, root_dir => $root_dir );
+ my $output = capture_stdout { $ct->process_files("$root_dir/foo/bar.txt") };
+ is( $output, "[tidied] foo/bar.txt\n", "filename output" );
+ is( read_file("$root_dir/foo/bar.txt"), "ABC", "tidied" );
my $other_dir = realpath( tempdir_simple() );
write_file( "$other_dir/foo.txt", "ABC" );
- $output = capture_stdout { $ct->process_paths("$other_dir/foo.txt") };
- like( $output, qr/foo.txt: skipping, not underneath root dir/ );
+ throws_ok { $ct->process_files("$other_dir/foo.txt") } qr/not underneath root dir/;
}
sub test_conf_file : Tests {
my $self = shift;
my $root_dir = $self->create_dir();
- my $conf_file = "$root_dir/.tidyallrc";
+ my $conf_file = "$root_dir/tidyall.ini";
write_file( $conf_file, $conf1 );
my $ct = Code::TidyAll->new( conf_file => $conf_file );
@@ -175,9 +185,9 @@ sub test_conf_file : Tests {
root_dir => dirname($conf_file),
data_dir => "$root_dir/.tidyall.d",
plugins => {
- PerlTidy => { argv => '-noll -it=2', include => '*.pl *.pm *.t' },
- PodTidy => {},
- PerlCritic => { argv => '-severity 3' },
+ PerlTidy => { argv => '-noll -it=2', select => '**/*.{pl,pm,t}' },
+ PodTidy => { select => '**/*.{pl,pm,t}' },
+ PerlCritic => { argv => '-severity 3', select => '**/*.pm' },
}
);
while ( my ( $method, $value ) = each(%expected) ) {
@@ -188,20 +198,16 @@ sub test_conf_file : Tests {
sub test_cli : Tests {
my $self = shift;
my $root_dir = $self->create_dir();
- my $conf_file = "$root_dir/.tidyallrc";
+ my $conf_file = "$root_dir/tidyall.ini";
write_file( $conf_file, $conf2 );
write_file( "$root_dir/foo.txt", "hello" );
- my $output =
- capture_stdout { system( "$^X", "bin/tidyall", "-c", $conf_file, "-v", "-r", $root_dir ) };
+ my $output = capture_stdout { system( "$^X", "bin/tidyall", "$root_dir/foo.txt", "-v" ) };
my ($params_msg) = ( $output =~ /constructing Code::TidyAll with these params:(.*)/ );
ok( defined($params_msg), "params msg" );
- like( $params_msg, qr/backup_ttl => '15m'/, 'backup_ttl' );
- like( $params_msg, qr/recursive => '?1'?/, 'recursive' );
- like( $params_msg, qr/verbose => '?1'?/, 'verbose' );
- like( $params_msg, qr/\Qroot_dir => '$root_dir'\E/, 'root_dir' );
- like( $output, qr/foo\.txt/, 'foo.txt' );
- like( $output, qr/applying '\+Code::TidyAll::Test::Plugin::UpperText'/, 'UpperText' );
- like( $output, qr/applying '\+Code::TidyAll::Test::Plugin::RepeatBar'/, 'RepeatBar' );
+ like( $params_msg, qr/backup_ttl => '15m'/, 'backup_ttl' );
+ like( $params_msg, qr/verbose => '?1'?/, 'verbose' );
+ like( $params_msg, qr/\Qroot_dir => '$root_dir'\E/, 'root_dir' );
+ like( $output, qr/\[tidied\] foo.txt \(.*RepeatFoo, .*UpperText\)/, 'foo.txt' );
is( read_file("$root_dir/foo.txt"), "HELLOHELLOHELLO", "tidied" );
}
@@ -212,23 +218,26 @@ recursive = 1
[PerlTidy]
argv = -noll -it=2
-include = *.pl *.pm *.t
+select = **/*.{pl,pm,t}
[PodTidy]
+select = **/*.{pl,pm,t}
[PerlCritic]
argv = -severity 3
+select = **/*.pm
';
-$conf2 = "
+$conf2 = '
backup_ttl = 15m
verbose = 1
-[$UpperText]
+[+Code::TidyAll::Test::Plugin::UpperText]
+select = **/*.txt
-[$RepeatBar]
+[+Code::TidyAll::Test::Plugin::RepeatFoo]
+select = **/foo*
times = 3
-include = *.txt
-";
+';
1;
--
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