[libcode-tidyall-perl] 10/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 278379caca90369c709fdcd8219cb36f7d3d7dcf
Author: Jonathan Swartz <swartz at pobox.com>
Date: Tue Jun 12 11:21:31 2012 -0700
various
---
bin/tidyall | 22 ++++-----
lib/Code/TidyAll.pm | 107 ++++++++++++++++++++++++++++++++-----------
lib/Code/TidyAll/Util.pm | 2 +-
lib/Code/TidyAll/t/Basic.pm | 89 +++++++++++++++++++++++------------
4 files changed, 150 insertions(+), 70 deletions(-)
diff --git a/bin/tidyall b/bin/tidyall
index 3f85de3..53c7db4 100755
--- a/bin/tidyall
+++ b/bin/tidyall
@@ -16,14 +16,14 @@ my %params;
my $class = 'Code::TidyAll';
GetOptions(
- 'backup-purge' => \$params{backup_purge},
- 'class' => \$class,
- 'data-dir' => \$params{data_dir},
- 'no-backup' => \$params{no_backup},
- 'no-cache' => \$params{no_cache},
- 'c|conf' => \$params{conf_file},
- 'h|help' => \$help,
- 'r|recursive' => \$params{recursive},
+ 'backup-ttl' => \$params{backup_ttl},
+ 'class' => \$class,
+ 'data-dir' => \$params{data_dir},
+ 'no-backups' => \$params{no_backups},
+ 'no-cache' => \$params{no_cache},
+ 'c|conf' => \$params{conf_file},
+ 'h|help' => \$help,
+ 'r|recursive' => \$params{recursive},
) or usage();
usage("-c|--conf required") if !$params{conf_file};
@@ -55,7 +55,7 @@ tidyall - Your all-in-one code tidier and validator
-c, --conf Required configuration file
-h, --help Print help message
-r, --recursive Descend into directories recursively
- --backup-purge When backup files can be purged. Defaults to "1d"
+ --backup-ttl When backup files can be purged. Defaults to "1d"
--class Code::TidyAll subclass to use. Defaults to "Code::TidyAll"
--data-dir Container for backups, cache, etc. Defaults to dir of conf file
--no-backup Don't backup files
@@ -164,10 +164,10 @@ C<tidyall> will backup each file before modifying it. The timestamped backups
are kept in a separate directory hierarchy under the data dir.
Old backup files will be purged automatically as part of occasional C<tidyall>
-runs. The duration specified in C<--backup-purge> indicates both the minimum
+runs. The duration specified in C<--backup-ttl> indicates both the minimum
amount of time backups should be kept, and the frequency that purges should be
run. It may be specified as "30min" or "4h" or any string acceptable to
-L<Time::Duration::Parse>. It defaults to "1d".
+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 b96b6da..26b227f 100644
--- a/lib/Code/TidyAll.pm
+++ b/lib/Code/TidyAll.pm
@@ -2,7 +2,7 @@ package Code::TidyAll;
use Cwd qw(realpath);
use Config::INI::Reader;
use Code::TidyAll::Cache;
-use Code::TidyAll::Util qw(can_load dirname mkpath read_file write_file);
+use Code::TidyAll::Util qw(basename can_load dirname mkpath read_file write_file);
use Date::Format;
use Digest::SHA1 qw(sha1_hex);
use File::Find qw(find);
@@ -12,20 +12,22 @@ use warnings;
# Incoming parameters
use Object::Tiny qw(
- backup_purge
- cache
+ backup_ttl
conf_file
data_dir
no_backups
no_cache
plugins
recursive
+ root_dir
verbose
);
# Internal
use Object::Tiny qw(
+ backup_dir
base_sig
+ cache
plugin_objects
);
@@ -53,18 +55,20 @@ sub new {
}
my $main_params = delete( $conf_params->{'_'} ) || {};
%params = ( plugins => $conf_params, %$main_params, %params );
- $params{data_dir} ||= join( "/", dirname($conf_file), ".tidyall.d" );
+ $params{root_dir} ||= dirname($conf_file);
}
+ die "conf_file or plugins required" unless $params{plugins};
+ die "conf_file or root_dir required" unless $params{root_dir};
my $self = $class->SUPER::new(%params);
- die "conf_file or plugins required" unless $self->{plugins};
- die "conf_file or data_dir required" unless $self->{data_dir};
- $self->{cache} ||= Code::TidyAll::Cache->new( cache_dir => $self->data_dir . "/cache" )
+ $self->{root_dir} = realpath( $self->{root_dir} );
+ $self->{data_dir} ||= $self->root_dir . "/.tidyall.d";
+ $self->{cache} = Code::TidyAll::Cache->new( cache_dir => $self->data_dir . "/cache" )
unless $self->no_cache;
- $self->{base_sig} = $self->_sig( [ $Code::TidyAll::VERSION || 0, $self->plugins ] );
- $self->{backup_purge} = parse_duration( $self->{backup_purge} || "1 day" );
-
+ $self->{backup_dir} = $self->data_dir . "/backups";
+ $self->{base_sig} = $self->_sig( [ $Code::TidyAll::VERSION || 0, $self->plugins ] );
+ $self->{backup_ttl} = parse_duration( $self->{backup_ttl} || "1 day" );
my $plugins = $self->plugins;
$self->{plugin_objects} =
[ map { $self->load_plugin( $_, $plugins->{$_} ) } keys( %{ $self->plugins } ) ];
@@ -99,55 +103,91 @@ sub process_paths {
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;
+ }
- ( -f $path ) ? $self->process_file($path)
- : ( -d $path ) ? $self->process_dir($path)
- : printf( "%s: not a file or directory\n", $path );
+ ( -f $path ) ? $self->_process_file($path)
+ : ( -d $path ) ? $self->_process_dir($path)
+ : $self->msg( "%s: not a file or directory\n", $path );
}
-sub process_dir {
+sub _process_dir {
my ( $self, $dir ) = @_;
- printf( "%s: skipping dir, not in recursive mode\n", $dir ) unless $self->recursive;
+ unless ( $self->recursive ) {
+ $self->msg( "%s: skipping dir, not in recursive mode\n", $dir );
+ next;
+ }
+ next if basename($dir) eq '.tidyall.d';
my @files;
- find( { wanted => sub { push @files, $_ if -f }, no_chdir => 1 }, $dir );
+ find( { follow => 0, wanted => sub { push @files, $_ if -f }, no_chdir => 1 }, $dir );
foreach my $file (@files) {
- $self->process_file($file);
+ $self->_process_file($file);
}
}
-sub process_file {
+sub _process_file {
my ( $self, $file ) = @_;
- my $cache = $self->cache;
- if ( !$cache || ( ( $cache->get("sig/$file") || '' ) ne $self->_file_sig($file) ) ) {
+
+ my $cache = $self->cache;
+ 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->($file) ) {
+ if ( $plugin->matcher->($small_path) ) {
if ( !$matched++ ) {
- print "$file\n";
- $self->backup_file($file);
+ $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 = $@ ) {
- printf STDERR "*** '%s': %s\n", $plugin->name, $error;
+ $self->msg( "*** '%s': %s", $plugin->name, $error );
return;
}
}
}
- $cache->set( "sig/$file", $self->_file_sig($file) ) if $cache;
+ $cache->set( "sig/$small_path", $self->_file_sig($file) ) unless $self->no_cache;
}
}
-sub backup_file {
+sub _backup_file {
my ( $self, $file ) = @_;
unless ( $self->no_backups ) {
my $backup_file = join( "",
- $self->data_dir, "/backups", realpath($file), "-",
- time2str( "%Y-%m-%d-%H-%M-%S", time ) );
+ $self->backup_dir, "/", $self->_small_path($file),
+ "-", time2str( "%Y-%m-%d-%H-%M-%S", time ), ".bak" );
mkpath( dirname($backup_file), 0, 0775 );
write_file( $backup_file, read_file($file) );
+ if ( my $cache = $self->cache ) {
+ my $last_purge_backups = $cache->get("last_purge_backups") || 0;
+ if ( time > $last_purge_backups + $self->backup_ttl ) {
+ $self->_purge_backups();
+ $cache->set( "last_purge_backups", time() );
+ }
+ }
}
}
+sub _purge_backups {
+ my ($self) = @_;
+ $self->msg("purging old backups") if $self->verbose;
+ find(
+ {
+ follow => 0,
+ wanted => sub {
+ unlink $_ if -f && /\.bak$/ && time > ( stat($_) )[9] + $self->backup_ttl;
+ },
+ no_chdir => 1
+ },
+ $self->backup_dir
+ );
+}
+
sub _find_file_upwards {
my ( $class, $search_dir, $search_file ) = @_;
@@ -168,6 +208,12 @@ sub _find_file_upwards {
}
}
+sub _small_path {
+ my ( $self, $path ) = @_;
+ die "'%s' is not underneath root dir '%s'!" unless index( $path, $self->root_dir ) == 0;
+ return substr( $path, length( $self->root_dir ) + 1 );
+}
+
sub _file_sig {
my ( $self, $file ) = @_;
my $last_mod = ( stat($file) )[9];
@@ -180,6 +226,11 @@ sub _sig {
return sha1_hex( join( ",", @$data ) );
}
+sub msg {
+ my ( $self, $format, @params ) = @_;
+ printf( "$format\n", @params );
+}
+
1;
__END__
diff --git a/lib/Code/TidyAll/Util.pm b/lib/Code/TidyAll/Util.pm
index e003afa..3824abc 100644
--- a/lib/Code/TidyAll/Util.pm
+++ b/lib/Code/TidyAll/Util.pm
@@ -8,7 +8,7 @@ use strict;
use warnings;
use base qw(Exporter);
-our @EXPORT_OK = qw(can_load dirname mkpath read_file tempdir_simple write_file );
+our @EXPORT_OK = qw(basename can_load dirname mkpath read_file tempdir_simple write_file );
sub can_load {
diff --git a/lib/Code/TidyAll/t/Basic.pm b/lib/Code/TidyAll/t/Basic.pm
index 8b7fe02..bf07ea6 100644
--- a/lib/Code/TidyAll/t/Basic.pm
+++ b/lib/Code/TidyAll/t/Basic.pm
@@ -1,38 +1,39 @@
package Code::TidyAll::t::Basic;
use Code::TidyAll::Util qw(mkpath read_file tempdir_simple write_file);
use Code::TidyAll;
-use File::Basename;
-use File::Path;
-use Capture::Tiny qw(capture);
+use Capture::Tiny qw(capture_stdout);
+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');
+
+sub create_dir {
+ my ( $self, $files ) = @_;
+
+ my $root_dir = tempdir_simple();
+ while ( my ( $path, $content ) = each(%$files) ) {
+ write_file( "$root_dir/$path", $content );
+ }
+ return $root_dir;
+}
+
sub tidy {
my ( $self, %params ) = @_;
my $desc = $params{desc};
- my $temp_dir = tempdir_simple();
- my $content_dir = "$temp_dir/content";
- my $data_dir = "$temp_dir/data";
- mkpath( $content_dir, 0, 0775 );
-
- while ( my ( $path, $content ) = each( %{ $params{source} } ) ) {
- write_file( "$content_dir/$path", $content );
- }
+ my $root_dir = $self->create_dir( $params{source} );
- my %plugins =
- map { ( "+Code::TidyAll::Test::Plugin::$_", $params{plugins}->{$_} ) }
- keys( %{ $params{plugins} } );
- my $ct = Code::TidyAll->new( plugins => \%plugins, recursive => 1, data_dir => $data_dir );
+ my $ct =
+ Code::TidyAll->new( plugins => $params{plugins}, recursive => 1, root_dir => $root_dir );
- my ( $stdout, $stderr ) = capture { $ct->process_dir($content_dir) };
+ my ($output) = capture_stdout { $ct->process_paths($root_dir) };
if ( $params{errors} ) {
- like( $stderr, $params{errors}, "$desc - errors" );
- }
- else {
- ok( $stderr !~ /\S/, "$desc - no errors ($stderr)" );
+ like( $output, $params{errors}, "$desc - errors" );
}
while ( my ( $path, $content ) = each( %{ $params{dest} } ) ) {
- is( read_file("$content_dir/$path"), $content, "$desc - $path content" );
+ is( read_file("$root_dir/$path"), $content, "$desc - $path content" );
}
}
@@ -46,32 +47,60 @@ 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/
);
}
-sub test_construct_errors : Tests {
+sub test_caching_and_backups : Tests {
+ my $self = shift;
+
+ my $root_dir = $self->create_dir( { "foo.txt" => "abc" } );
+ my $ct = Code::TidyAll->new( plugins => { $UpperText => {} }, root_dir => $root_dir );
+ my $output;
+ my $file = "$root_dir/foo.txt";
+ my $go = sub {
+ $output = capture_stdout { $ct->process_paths($file) };
+ };
+
+ $go->();
+ is( read_file($file), "ABC", "file changed" );
+ is( $output, "foo.txt\n", 'output' );
+
+ $go->();
+ is( $output, '', 'no output' );
+
+ write_file( $file, "def" );
+ $go->();
+ is( read_file($file), "DEF", "file changed" );
+ is( $output, "foo.txt\n", 'output' );
+
+ my $backup_dir = $ct->data_dir . "/backups";
+ my @files;
+ find( { follow => 0, wanted => sub { push @files, $_ if -f }, no_chdir => 1 }, $backup_dir );
+}
+
+sub test_errors : Tests {
my $self = shift;
my $data_dir = tempdir_simple();
throws_ok { Code::TidyAll->new( data_dir => $data_dir ) } qr/conf_file or plugins required/;
- throws_ok { Code::TidyAll->new( plugins => {} ) } qr/conf_file or data_dir required/;
+ throws_ok { Code::TidyAll->new( plugins => {} ) } qr/conf_file or root_dir required/;
}
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