[libcode-tidyall-perl] 232/374: support conf_name, list_files

Jonas Smedegaard js at alioth.debian.org
Sun Sep 29 22:26:26 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 9fb78fa427685520b4b8c5ded291c1c4db3ac45b
Author: Jonathan Swartz <swartz at pobox.com>
Date:   Fri Sep 14 11:20:48 2012 -0400

    support conf_name, list_files
---
 lib/Code/TidyAll.pm |   44 +++++++++++++++++++++++++++++++-------------
 1 file changed, 31 insertions(+), 13 deletions(-)

diff --git a/lib/Code/TidyAll.pm b/lib/Code/TidyAll.pm
index f7dd5ce..baba0a4 100644
--- a/lib/Code/TidyAll.pm
+++ b/lib/Code/TidyAll.pm
@@ -38,8 +38,6 @@ has 'cache'            => ( is => 'lazy', init_arg => undef );
 has 'plugin_objects'   => ( is => 'lazy', init_arg => undef );
 has 'plugins_for_mode' => ( is => 'lazy', init_arg => undef );
 
-my $ini_name = 'tidyall.ini';
-
 sub _build_backup_dir {
     my $self = shift;
     return $self->data_dir . "/backups";
@@ -175,6 +173,17 @@ sub process_files {
     return map { $self->process_file( realpath($_) ) } @files;
 }
 
+sub list_files {
+    my ( $self, @files ) = @_;
+
+    foreach my $file (@files) {
+        my $path = $self->_small_path($file);
+        if ( my @plugins = $self->plugins_for_path($path) ) {
+            printf( "%s (%s)\n", $path, join( ", ", map { $_->name } @plugins ) );
+        }
+    }
+}
+
 sub process_file {
     my ( $self, $file ) = @_;
 
@@ -315,27 +324,27 @@ sub _purge_backups {
 }
 
 sub find_conf_file {
-    my ( $class, $start_dir ) = @_;
+    my ( $class, $conf_name, $start_dir ) = @_;
 
     my $path1     = rel2abs($start_dir);
     my $path2     = realpath($start_dir);
-    my $conf_file = $class->_find_conf_file_upward($path1)
-      || $class->_find_conf_file_upward($path2);
+    my $conf_file = $class->_find_conf_file_upward( $conf_name, $path1 )
+      || $class->_find_conf_file_upward( $conf_name, $path2 );
     unless ( defined $conf_file ) {
-        die sprintf( "could not find $ini_name upwards from %s",
+        die sprintf( "could not find $conf_name upwards from %s",
             ( $path1 eq $path2 ) ? "'$path1'" : "'$path1' or '$path2'" );
     }
     return $conf_file;
 }
 
 sub _find_conf_file_upward {
-    my ( $class, $search_dir ) = @_;
+    my ( $class, $conf_name, $search_dir ) = @_;
 
     $search_dir =~ s{/+$}{};
 
     my $cnt = 0;
     while (1) {
-        my $try_path = "$search_dir/$ini_name";
+        my $try_path = "$search_dir/$conf_name";
         if ( -f $try_path ) {
             return $try_path;
         }
@@ -356,9 +365,9 @@ sub find_matched_files {
     my $plugins_for_path = $self->{plugins_for_path};
     my $root_length      = length( $self->root_dir );
     foreach my $plugin ( @{ $self->plugin_objects } ) {
-        my @selected = grep { -f && !-l } $self->_zglob( $plugin->select );
-        if ( defined( $plugin->ignore ) ) {
-            my %is_ignored = map { ( $_, 1 ) } $self->_zglob( $plugin->ignore );
+        my @selected = grep { -f && !-l } $self->_zglob( $plugin->selects );
+        if ( @{ $plugin->ignores } ) {
+            my %is_ignored = map { ( $_, 1 ) } $self->_zglob( $plugin->ignores );
             @selected = grep { !$is_ignored{$_} } @selected;
         }
         push( @matched_files, @selected );
@@ -380,10 +389,19 @@ sub plugins_for_path {
 }
 
 sub _zglob {
-    my ( $self, $expr ) = @_;
+    my ( $self, $globs ) = @_;
 
     local $File::Zglob::NOCASE = 0;
-    return File::Zglob::zglob( join( "/", $self->root_dir, $expr ) );
+    my @files;
+    foreach my $glob (@$globs) {
+        try {
+            push( @files, File::Zglob::zglob( join( "/", $self->root_dir, $glob ) ) );
+        }
+        catch {
+            die "error parsing '$glob': $_";
+        }
+    }
+    return uniq(@files);
 }
 
 sub _small_path {

-- 
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