File Coverage

blib/lib/Code/TidyAll.pm
Criterion Covered Total %
statement 362 389 93.0
branch 106 156 67.9
condition 33 49 67.3
subroutine 72 73 98.6
pod 7 12 58.3
total 580 679 85.4


line stmt bran cond sub pod time code
1             package Code::TidyAll;
2              
3 35     35   2050736 use strict;
  35         85  
  35         1475  
4 35     35   227 use warnings;
  35         65  
  35         2299  
5              
6 35     35   16488 use Code::TidyAll::Cache;
  35         151  
  35         1940  
7 35     35   27119 use Code::TidyAll::CacheModel;
  35         220  
  35         1986  
8 35     35   21870 use Code::TidyAll::Config::INI::Reader;
  35         220  
  35         1795  
9 35     35   20391 use Code::TidyAll::Plugin;
  35         223  
  35         1700  
10 35     35   18698 use Code::TidyAll::Result;
  35         178  
  35         2150  
11 35     35   21088 use Code::TidyAll::Zglob qw(zglob);
  35         166  
  35         2969  
12 35     35   8734 use Data::Dumper;
  35         125001  
  35         2407  
13 35     35   17834 use Date::Format;
  35         325238  
  35         3214  
14 35     35   353 use Digest::SHA qw(sha1_hex);
  35         66  
  35         2051  
15 35     35   222 use File::Find qw(find);
  35         68  
  35         2668  
16 35     35   17526 use File::pushd qw( pushd );
  35         51391  
  35         3475  
17 35     35   19590 use List::SomeUtils qw(uniq);
  35         283811  
  35         4440  
18 35     35   368 use Module::Runtime qw( use_module );
  35         85  
  35         329  
19 35     35   3028 use Path::Tiny qw(path);
  35         89  
  35         1941  
20 35     35   218 use Scalar::Util qw(blessed);
  35         86  
  35         2456  
21 35     35   218 use Specio 0.40;
  35         801  
  35         1834  
22 35     35   213 use Specio::Declare;
  35         80  
  35         374  
23 35     35   9021 use Specio::Library::Builtins;
  35         81  
  35         486  
24 35     35   413636 use Specio::Library::Numeric;
  35         111  
  35         345  
25 35     35   321925 use Specio::Library::Path::Tiny 0.04;
  35         1505  
  35         316  
26 35     35   563652 use Specio::Library::String;
  35         141  
  35         491  
27 35     35   116220 use Time::Duration::Parse qw(parse_duration);
  35         50922  
  35         3028  
28 35     35   364 use Try::Tiny;
  35         107  
  35         2609  
29              
30 35     35   234 use Moo 2.000000;
  35         959  
  35         351  
31              
32             our $VERSION = '0.85';
33              
34 8     8 0 47 sub default_conf_names { ( 'tidyall.ini', '.tidyallrc' ) }
35              
36             # External
37             has backup_ttl => (
38             is => 'ro',
39             isa => t('NonEmptyStr'),
40             default => '1 hour',
41             );
42              
43             has cache => (
44             is => 'lazy',
45             isa => object_can_type( methods => [qw( get set )] ),
46             );
47              
48             has cache_model_class => (
49             is => 'ro',
50             isa => t('ClassName'),
51             default => 'Code::TidyAll::CacheModel',
52             );
53              
54             has check_only => (
55             is => 'ro',
56             isa => t('Bool'),
57             );
58              
59             has data_dir => (
60             is => 'lazy',
61             isa => t('Path'),
62             coerce => t('Path')->coercion_sub,
63             );
64              
65             has iterations => (
66             is => 'ro',
67             isa => t('PositiveInt'),
68             default => 1,
69             );
70              
71             has jobs => (
72             is => 'ro',
73             isa => t('Int'),
74             default => 1,
75             );
76              
77             has list_only => (
78             is => 'ro',
79             isa => t('Bool'),
80             );
81              
82             has mode => (
83             is => 'ro',
84             isa => t('NonEmptyStr'),
85             default => 'cli',
86             );
87              
88             has msg_outputter => (
89             is => 'ro',
90             isa => t('CodeRef'),
91             builder => '_build_msg_outputter',
92             );
93              
94             has no_backups => (
95             is => 'ro',
96             isa => t('Bool'),
97             );
98              
99             has no_cache => (
100             is => 'ro',
101             isa => t('Bool'),
102             );
103              
104             has output_suffix => (
105             is => 'ro',
106             isa => t('Str'),
107             default => q{},
108             );
109              
110             has plugins => (
111             is => 'ro',
112             isa => t('HashRef'),
113             required => 1,
114             );
115              
116             has selected_plugins => (
117             is => 'ro',
118             isa => t( 'ArrayRef', of => t('NonEmptyStr') ),
119             lazy => 1,
120             default => sub { [] },
121             );
122              
123             has quiet => (
124             is => 'ro',
125             isa => t('Bool'),
126             );
127             has recursive => (
128             is => 'ro',
129             isa => t('Bool'),
130             );
131              
132             has refresh_cache => (
133             is => 'ro',
134             isa => t('Bool'),
135             );
136              
137             has root_dir => (
138             is => 'ro',
139             isa => t('RealDir'),
140             coerce => t('RealDir')->coercion_sub,
141             required => 1
142             );
143              
144             has verbose => (
145             is => 'ro',
146             isa => t('Bool'),
147             default => 0,
148             );
149              
150             has inc => (
151             is => 'ro',
152             isa => t( 'ArrayRef', of => t('NonEmptyStr') ),
153             default => sub { [] },
154             );
155              
156             has _backup_dir => (
157             is => 'ro',
158             isa => t('Path'),
159             init_arg => undef,
160             lazy => 1,
161             builder => '_build_backup_dir',
162             );
163              
164             has _backup_ttl_secs => (
165             is => 'ro',
166             isa => t('Int'),
167             init_arg => undef,
168             lazy => 1,
169             builder => '_build_backup_ttl_secs',
170             );
171              
172             has _base_sig => (
173             is => 'ro',
174             isa => t('NonEmptyStr'),
175             init_arg => undef,
176             lazy => 1,
177             builder => '_build_base_sig',
178             );
179              
180             has _plugin_objects => (
181             is => 'ro',
182             isa => t( 'ArrayRef', of => object_isa_type('Code::TidyAll::Plugin') ),
183             init_arg => undef,
184             lazy => 1,
185             builder => '_build_plugin_objects',
186             );
187              
188             has _plugins_to_run => (
189             is => 'ro',
190             isa => t( 'HashRef', of => t('HashRef') ),
191             init_arg => undef,
192             lazy => 1,
193             builder => '_build_plugins_to_run',
194             );
195              
196             has _plugins_for_path => (
197             is => 'ro',
198             isa => t( 'HashRef', of => t('HashRef') ),
199             init_arg => undef,
200             lazy => 1,
201             default => sub { {} },
202             );
203              
204             with qw( Code::TidyAll::Role::HasIgnore Code::TidyAll::Role::Tempdir );
205              
206             sub _build_backup_dir {
207 71     71   1006 my $self = shift;
208 71         1654 return $self->data_dir->child('backups');
209             }
210              
211             sub _build_backup_ttl_secs {
212 71     71   1089 my $self = shift;
213 71         637 return parse_duration( $self->backup_ttl );
214             }
215              
216             sub _build_base_sig {
217 45     45   3553 my $self = shift;
218 45         160 my $active_plugins = join( q{|}, map { $_->name } @{ $self->_plugin_objects } );
  62         2611  
  45         1396  
219 45   50     637 return $self->_sig( [ $Code::TidyAll::VERSION || 0, $active_plugins ] );
220             }
221              
222             sub _sig {
223 45     45   183 my ( $self, $data ) = @_;
224 45         1733 return sha1_hex( join( ',', @$data ) );
225             }
226              
227             sub _build_cache {
228 69     69   952 my $self = shift;
229 69         1490 return Code::TidyAll::Cache->new( cache_dir => $self->data_dir->child('cache') );
230             }
231              
232             sub _build_data_dir {
233 79     79   22956 my $self = shift;
234 79         745 return $self->root_dir->child('/.tidyall.d');
235             }
236              
237             sub _build_plugins_to_run {
238 80     80   1047 my $self = shift;
239              
240 80         292 my $all_plugins = $self->plugins;
241 80         167 my %selected = map { $_ => 1 } @{ $self->selected_plugins };
  6         54  
  80         2210  
242 80         4166 my %plugins;
243              
244 80 100       611 if (%selected) {
    50          
245 2         9 my @unknown = sort grep { !$all_plugins->{$_} } keys %selected;
  6         20  
246 2 100       31 die "Asked for unknown plugins: [@unknown]" if @unknown;
247 1         7 %plugins = map { $_ => $all_plugins->{$_} } keys %selected;
  2         8  
248             }
249             elsif ( my $mode = $self->mode ) {
250 99         502 %plugins = map { $_ => $all_plugins->{$_} }
251 100         447 grep { $self->_plugin_conf_matches_mode( $all_plugins->{$_}, $mode ) }
252 78         169 keys %{$all_plugins};
  78         321  
253             }
254              
255 79         2126 return \%plugins;
256             }
257              
258             sub _plugin_conf_matches_mode {
259 100     100   306 my ( $self, $conf, $mode ) = @_;
260              
261 100 100       474 if ( my $only_modes = $conf->{only_modes} ) {
262 2 100       21 return 0 if ( q{ } . $only_modes . q{ } ) !~ / $mode /;
263             }
264 99 50       355 if ( my $except_modes = $conf->{except_modes} ) {
265 0 0       0 return 0 if ( q{ } . $except_modes . q{ } ) =~ / $mode /;
266             }
267 99         318 return 1;
268             }
269              
270             sub _build_plugin_objects {
271 80     80   1385 my $self = shift;
272              
273             # Sort tidiers by weight (by default validators have a weight of 60 and non-
274             # validators a weight of 50 meaning non-validators normally go first), then
275             # alphabetical
276             # TODO: These should probably sort in a consistent way independent of locale
277             return [
278 32 50       1200 sort { ( $a->weight <=> $b->weight ) || ( $a->name cmp $b->name ) }
279 100         10302 map { $self->_load_plugin( $_, $self->_plugins_to_run->{$_} ) }
280 80         176 keys %{ $self->_plugins_to_run }
  80         2088  
281             ];
282             }
283              
284             sub _load_plugin {
285 100     100   1116 my ( $self, $plugin_name, $plugin_conf ) = @_;
286              
287             # Extract first name in case there is a description
288             #
289 100         452 my ($plugin_fname) = ( $plugin_name =~ /^(\S+)/ );
290              
291 100 100       669 my $plugin_class = (
292             $plugin_fname =~ /^\+/
293             ? substr( $plugin_fname, 1 )
294             : "Code::TidyAll::Plugin::$plugin_fname"
295             );
296             try {
297 100 50   100   7103 use_module($plugin_class) || die 'not found';
298             }
299             catch {
300 1     1   539 die qq{could not load plugin class '$plugin_class': $_};
301 100         1303 };
302              
303 99         61363 return $plugin_class->new(
304             name => $plugin_name,
305             tidyall => $self,
306             %$plugin_conf
307             );
308             }
309              
310             sub BUILD {
311 84     84 0 8087 my ( $self, $params ) = @_;
312              
313             # Strict constructor
314             #
315 84 100       401 if ( my @bad_params = grep { !$self->can($_) } keys(%$params) ) {
  290         1507  
316             die sprintf(
317             'unknown constructor param%s %s for %s',
318             @bad_params > 1 ? 's' : q{},
319 1 50       7 join( ', ', sort map {qq['$_']} @bad_params ),
  2         30  
320             ref($self)
321             );
322             }
323              
324 83 100       568 unless ( $self->no_backups ) {
325 71         2064 $self->_backup_dir->mkpath( { mode => 0775 } );
326 71         65334 $self->_purge_backups_periodically();
327             }
328              
329 83         4608 @INC = ( @{ $self->inc }, @INC );
  83         2154  
330             }
331              
332             sub _purge_backups_periodically {
333 71     71   253 my ($self) = @_;
334 71         2790 my $cache = $self->cache;
335 71   100     47368 my $last_purge_backups = $cache->get('last_purge_backups') || 0;
336 71 100       8498 if ( time > $last_purge_backups + $self->_backup_ttl_secs ) {
337 48         6204 $self->_purge_backups();
338 48         8426 $cache->set( 'last_purge_backups', time() );
339             }
340             }
341              
342             sub _purge_backups {
343 48     48   167 my ($self) = @_;
344 48 100       350 $self->msg('purging old backups') if $self->verbose;
345             find(
346             {
347             follow => 0,
348             wanted => sub {
349 48 0 33 48   8062 unlink $_ if -f && /\.bak$/ && time > ( stat($_) )[9] + $self->_backup_ttl_secs;
      33        
350             },
351 48         1712 no_chdir => 1
352             },
353             $self->_backup_dir,
354             );
355             }
356              
357             sub new_from_conf_file {
358 9     9 1 53436 my ( $class, $conf_file, %params ) = @_;
359              
360 9         46 $conf_file = path($conf_file);
361              
362 9 50       365 die qq{no such file '$conf_file'} unless $conf_file->is_file;
363 9         297 my $conf_params = $class->_read_conf_file($conf_file);
364 9   100     46 my $main_params = delete( $conf_params->{'_'} ) || {};
365              
366             %params = (
367             plugins => $conf_params,
368             root_dir => path($conf_file)->realpath->parent,
369 9         48 %{$main_params},
  9         2597  
370             %params
371             );
372              
373             # Initialize with alternate class if given
374             #
375 9 50       71 if ( my $tidyall_class = delete( $params{tidyall_class} ) ) {
376 0 0       0 local @INC = ( @{ $conf_params->{inc} }, @INC ) if $conf_params->{inc};
  0         0  
377 0 0       0 use_module($tidyall_class) or die qq{cannot load '$tidyall_class'};
378 0         0 $class = $tidyall_class;
379             }
380              
381 9 100       43 if ( $params{verbose} ) {
382 2   33     23 my $msg_outputter = $params{msg_outputter} || $class->_build_msg_outputter();
383 2         9 $msg_outputter->(
384             'constructing %s with these params: %s', $class,
385             _dump_params( \%params )
386             );
387             }
388              
389 9         195 return $class->new(%params);
390             }
391              
392             sub _read_conf_file {
393 9     9   30 my ( $class, $conf_file ) = @_;
394 9         76 my $conf_string = $conf_file->slurp_utf8;
395 9         12323 my $root_dir = $conf_file->parent;
396 9         835 $conf_string =~ s/\$ROOT/$root_dir/g;
397 9         189 my $conf_hash = Code::TidyAll::Config::INI::Reader->read_string($conf_string);
398 9 50       348 die qq{'$conf_file' did not evaluate to a hash}
399             unless ( ref($conf_hash) eq 'HASH' );
400 9         47 return $conf_hash;
401             }
402              
403             sub _dump_params {
404 2     2   3 my $p = shift;
405              
406 2         10 return Data::Dumper->new( [ _recurse_dump($p) ] )
407             ->Indent(0)
408             ->Sortkeys(1)
409             ->Quotekeys(0)
410             ->Terse(1)
411             ->Dump;
412             }
413              
414             # This is all a ridiculous workaround around the fact that there is no good
415             # way to tell Data::Dumper how to serialize a Path::Tiny object.
416             sub _recurse_dump {
417 2     2   5 my ($p) = @_;
418              
419 2 50       6 return $p unless ref $p;
420              
421 2 50       8 if ( ref $p eq 'HASH' ) {
    0          
422 2         4 my %dump;
423 2         4 for my $k ( keys %{$p} ) {
  2         9  
424 10         51 my $v = $p->{$k};
425 10 100       39 if ( blessed $v ) {
    50          
426 2 50       19 if ( $v->isa('Path::Tiny') ) {
427 2         13 $dump{$k} = $v . q{};
428             }
429             else {
430 0         0 die 'Cannot dump ' . ref($v) . ' object';
431             }
432             }
433             elsif ( ref $v =~ /^(?:HASH|ARRAY)$/ ) {
434 0         0 $dump{$k} = _recurse_dump($v);
435             }
436             else {
437 8         19 $dump{$k} = $v;
438             }
439             }
440 2         32 return \%dump;
441             }
442             elsif ( ref $p eq 'ARRAY' ) {
443 0         0 my @dump;
444 0         0 for my $v ( @{$p} ) {
  0         0  
445 0 0       0 if ( blessed $v ) {
    0          
446 0 0       0 if ( $v->isa('Path::Tiny') ) {
447 0         0 push @dump, $v . q{};
448             }
449             else {
450 0         0 die 'Cannot dump ' . ref($v) . ' object';
451             }
452             }
453             elsif ( ref $v =~ /^(?:HASH|ARRAY)$/ ) {
454 0         0 push @dump, _recurse_dump($v);
455             }
456             else {
457 0         0 push @dump, $v;
458             }
459             }
460 0         0 return \@dump;
461             }
462              
463 0         0 die "_recurse_dump was called with a value that was not a scalar, hashref, or an arrayref: $p";
464             }
465              
466             sub process_all {
467 17     17 0 19084 my $self = shift;
468              
469 17         100 return $self->process_paths( $self->find_matched_files );
470             }
471              
472             sub process_paths {
473 98     98 1 252998 my ( $self, @paths ) = @_;
474              
475             @paths = map {
476 119     119   4553 try { $_->realpath }
477 119 100       9257 || $_->absolute
478 98         368 } map { path($_) } @paths;
  119         889  
479              
480 98         30624 my $dir = pushd( $self->root_dir );
481 98 100 66     14070 if ( $self->jobs > 1 && @paths > 1 ) {
482 5         30 return $self->_process_parallel(@paths);
483             }
484             else {
485 93         422 return map { $self->process_path($_) } @paths;
  99         524  
486             }
487             }
488              
489             sub _process_parallel {
490 5     5   15 my ( $self, @paths ) = @_;
491              
492 5 50       20 unless ( eval { require Parallel::ForkManager; 1; } ) {
  5         50  
  5         25  
493 0         0 die 'Running Code::TidyAll with multiple jobs requires Parallel::ForkManager';
494             }
495              
496 5         15 my @results;
497             my %path_to_pid;
498              
499 5         65 my $pm = Parallel::ForkManager->new( $self->jobs );
500 5         29785 $pm->set_waitpid_blocking_sleep(0.01);
501             $pm->run_on_finish(
502             sub {
503 5     5   5886388 my ( $pid, $code, $result ) = @_[ 0, 1, 5 ];
504              
505 5 50       34 if ($code) {
506 0         0 warn "Error running tidyall on $path_to_pid{$pid}. Got exit status of $code.";
507             }
508             else {
509 5         94 push @results, $result;
510             }
511             }
512 5         65 );
513              
514 5         60 for my $path (@paths) {
515 14 100       245 if ( my $pid = $pm->start ) {
516 10         71499 $path_to_pid{$path} = $pid;
517 10         1146 next;
518             }
519              
520 4         49419 $pm->finish( 0, $self->process_path($path) );
521             }
522              
523 1         80 $pm->wait_all_children;
524              
525 1         34 return @results;
526             }
527              
528             sub process_path {
529 103     103 0 452 my ( $self, $path ) = @_;
530              
531 103 100       784 if ( $path->is_dir ) {
    100          
532 2 100       68 if ( $self->recursive ) {
533 1         21 return $self->process_paths( $path->children );
534             }
535             else {
536 1         16 return ( $self->_error_result( "$path: is a directory (try -r/--recursive)", $path ) );
537             }
538             }
539             elsif ( $path->is_file ) {
540 100         4024 return ( $self->process_file($path) );
541             }
542             else {
543 1         87 return ( $self->_error_result( "$path: not a file or directory", $path ) );
544             }
545             }
546              
547             sub process_file {
548 102     102 1 13719 my ( $self, $full_path ) = @_;
549              
550 102         685 $full_path = path($full_path);
551 102 50       20926 die "$full_path is not a file" unless $full_path->is_file;
552              
553 102         2304 my $path = $self->_small_path($full_path);
554              
555 101 50       8182 if ( $self->list_only ) {
556 0 0       0 if ( my @plugins = $self->plugins_for_path($path) ) {
557 0         0 $self->msg( '%s (%s)', $path, join( ', ', map { $_->name } @plugins ) );
  0         0  
558             }
559 0         0 return Code::TidyAll::Result->new( path => $path, state => 'checked' );
560             }
561              
562 101         587 my $cache_model = $self->_cache_model_for( $path, $full_path );
563 101 50       239079 if ( $self->refresh_cache ) {
    100          
564 0         0 $cache_model->remove;
565             }
566             elsif ( $cache_model->is_cached ) {
567 8 50       972 $self->msg( '[cached] %s', $path ) if $self->verbose;
568 8         318 return Code::TidyAll::Result->new( path => $path, state => 'cached' );
569             }
570              
571 93   33     7806 my $contents = $cache_model->file_contents || $full_path->slurp_raw;
572 93         42074 my $result = $self->process_source( $contents, $path );
573              
574 93 100       103248 if ( $result->state eq 'tidied' ) {
575              
576             # backup original contents
577 58         694 $self->_backup_file( $path, $contents );
578              
579             # write new contents out to disk
580 58         48724 $contents = $result->new_contents;
581              
582             # We don't use ->spew because that creates a new file and renames it,
583             # losing the existing mode setting in the process.
584 58         409 path( $full_path . $self->output_suffix )->append_raw( { truncate => 1 }, $contents );
585              
586             # change the in memory contents of the cache (but don't update yet)
587 58 50       31939 $cache_model->file_contents($contents) unless $self->output_suffix;
588             }
589              
590 93 100       545 $cache_model->update if $result->ok;
591 93         1594 return $result;
592             }
593              
594             sub _small_path {
595 106     106   530 my ( $self, $path ) = @_;
596 106 100       829 die sprintf( q{'%s' is not underneath root dir '%s'!}, $path, $self->root_dir )
597             unless index( $path, $self->root_dir ) == 0;
598 105         1732 return path( substr( $path . q{}, length( $self->root_dir ) + 1 ) );
599             }
600              
601             sub plugins_for_path {
602 119     119 1 6634 my ( $self, $path ) = @_;
603              
604             $self->_plugins_for_path->{$path}
605 119   100     4194 ||= [ grep { $_->matches_path($path) } @{ $self->_plugin_objects } ];
  69         3042  
  58         5780  
606 119         4276 return @{ $self->_plugins_for_path->{$path} };
  119         3203  
607             }
608              
609             sub _cache_model_for {
610 101     101   337 my ( $self, $path, $full_path ) = @_;
611 101 100       10145 return $self->cache_model_class->new(
612             path => $path,
613             full_path => $full_path,
614             ( $self->no_cache ? () : ( cache_engine => $self->cache ) ),
615             base_sig => $self->_base_sig,
616             );
617             }
618              
619             sub _backup_file {
620 58     58   197 my ( $self, $path, $contents ) = @_;
621 58 100       4730 unless ( $self->no_backups ) {
622 42         1631 my $backup_file = $self->_backup_dir->child( $self->_backup_filename($path) );
623 42         11843 $backup_file->parent->mkpath( { mode => 0775 } );
624 42         11383 $backup_file->spew_raw($contents);
625             }
626             }
627              
628             sub _backup_filename {
629 42     42   759 my ( $self, $path ) = @_;
630              
631 42         772 return join( q{}, $path, '-', time2str( '%Y%m%d-%H%M%S', time ), '.bak' );
632             }
633              
634             sub process_source {
635 118     118 1 50876 my ( $self, $contents, $path ) = @_;
636              
637 118         674 $path = path($path);
638              
639 118 50 33     3928 die 'contents and path required' unless defined($contents) && defined($path);
640 118         607 my @plugins = $self->plugins_for_path($path);
641              
642 118 100       2359 if ( !@plugins ) {
643 1 0       19 $self->msg(
    50          
644             '[no plugins apply%s] %s',
645             $self->mode ? q{ for mode '} . $self->mode . q{'} : q{}, $path
646             ) if $self->verbose;
647 1         39 return Code::TidyAll::Result->new( path => $path, state => 'no_match' );
648             }
649              
650 117 100       634 if ( $self->verbose ) {
651 6         21 my @names = join ', ', map { $_->name } @plugins;
  17         93  
652 6         51 $self->msg("[applying the following plugins: @names]");
653             }
654              
655 117         393 my $new_contents = my $orig_contents = $contents;
656 117         407 my $plugin;
657             my $error;
658 117         0 my @diffs;
659             try {
660 117     117   8221 foreach my $method (qw(preprocess_source process_source_or_file postprocess_source)) {
661 336         6237 foreach $plugin (@plugins) {
662 398         593 my $diff;
663 398         4249 ( $new_contents, $diff )
664             = $plugin->$method( $new_contents, $path, $self->check_only );
665 383 100       1442 if ($diff) {
666 2         17 push @diffs, [ $plugin->name, $diff ];
667             }
668             }
669             }
670             }
671             catch {
672 15     15   1241 chomp;
673 15         46 $error = $_;
674 15 50       165 $error = sprintf( q{*** '%s': %s}, $plugin->name, $_ ) if $plugin;
675 117         2963 };
676              
677 117   100     4081 my $was_tidied = !$error && ( $new_contents ne $orig_contents );
678 117 100 100     879 if ( $was_tidied && $self->check_only ) {
679 5         12 $error = '*** needs tidying';
680              
681             # Github annotations parsable output to highlight code in pull requests
682 5 100       41 if ( $ENV{GITHUB_ACTIONS} ) {
683 1         6 $error .= "\n::error file=${path}::File ${path} needs tidying";
684             }
685              
686 5         21 foreach my $diff (@diffs) {
687 2         5 $error .= "\n\n";
688 2         7 $error .= "$diff->[0] made the following change:\n$diff->[1]";
689             }
690 5 100       15 $error .= "\n\n" if @diffs;
691 5         12 undef $was_tidied;
692             }
693              
694 117 100 100     1010 if ( !$self->quiet || $error ) {
695 99 100       421 my $status = $was_tidied ? '[tidied] ' : '[checked] ';
696             my $plugin_names
697 99 100       500 = $self->verbose ? sprintf( ' (%s)', join( ', ', map { $_->name } @plugins ) ) : q{};
  17         72  
698 99         459 $self->msg( '%s%s%s', $status, $path, $plugin_names );
699             }
700              
701 117 100       7254 if ($error) {
    100          
702 20         152 return $self->_error_result( $error, $path, $orig_contents, $new_contents );
703             }
704             elsif ($was_tidied) {
705 66         3253 return Code::TidyAll::Result->new(
706             path => $path,
707             state => 'tidied',
708             orig_contents => $orig_contents,
709             new_contents => $new_contents
710             );
711             }
712             else {
713 31         1539 return Code::TidyAll::Result->new( path => $path, state => 'checked' );
714             }
715             }
716              
717             sub _error_result {
718 22     22   135 my ( $self, $msg, $path, $orig_contents, $new_contents ) = @_;
719 22         99 $self->msg( '%s', $msg );
720 22 100 66     1541 return Code::TidyAll::Result->new(
    100 66        
721             path => $path,
722             state => 'error',
723             error => $msg,
724             (
725             ( defined $orig_contents && length $orig_contents )
726             ? ( orig_contents => $orig_contents )
727             : ()
728             ),
729             (
730             ( defined $new_contents && length $new_contents )
731             ? ( new_contents => $new_contents )
732             : ()
733             ),
734             );
735             }
736              
737             sub find_conf_file {
738 6     6 1 986 my ( $class, $conf_names, $start_dir ) = @_;
739              
740 6         42 $start_dir = path($start_dir);
741 6         150 my $path1 = $start_dir->absolute;
742 6         283 my $path2 = $start_dir->realpath;
743 6   33     1490 my $conf_file = $class->_find_conf_file_upward( $conf_names, $path1 )
744             || $class->_find_conf_file_upward( $conf_names, $path2 );
745 6 50       191 unless ( defined $conf_file ) {
746 0 0       0 die sprintf(
747             'could not find %s upwards from %s',
748             join( ' or ', @$conf_names ),
749             ( $path1 eq $path2 ) ? qq{'$path1'} : qq{'$path1' or '$path2'}
750             );
751             }
752 6         43 return $conf_file;
753             }
754              
755             sub _find_conf_file_upward {
756 6     6   24 my ( $class, $conf_names, $search_dir ) = @_;
757              
758 6         13 my $cnt = 0;
759 6         16 while (1) {
760 8         22 foreach my $conf_name (@$conf_names) {
761 13         183 my $try_path = $search_dir->child($conf_name);
762 13 100       757 return $try_path if $try_path->is_file;
763             }
764              
765 2         28 my $parent = $search_dir->parent;
766 2 50       93 last if $parent eq $search_dir;
767 2         20 $search_dir = $parent;
768              
769 2 50       9 die 'inf loop!' if ++$cnt > 100;
770             }
771             }
772              
773             sub find_matched_files {
774 19     19 1 68 my ($self) = @_;
775              
776 19         689 my $plugins_for_path = $self->_plugins_for_path;
777 19         1088 my $root_length = length( $self->root_dir );
778              
779 19         123 my @all;
780 19         40 for my $plugin ( @{ $self->_plugin_objects } ) {
  19         495  
781 30         1406 my @matched = $self->_matched_by_plugin($plugin);
782 30         87 push @all, @matched;
783              
784             # When we end up in process_source we'll need to know which plugins
785             # match a given file. This could be (re-)calculated When we call
786             # ->plugins_for_path($file) there but since we already know the path
787             # to plugin mapping, we might as well store it here.
788 30         76 for my $file (@matched) {
789 54         153 my $path = substr( $file, $root_length + 1 );
790 54   100     280 $plugins_for_path->{$path} ||= [];
791 54         72 push @{ $plugins_for_path->{$path} }, $plugin;
  54         170  
792             }
793             }
794              
795 19         273 return map { path($_) } uniq(@all);
  41         1262  
796             }
797              
798             sub _matched_by_plugin {
799 30     30   75 my $self = shift;
800 30         52 my $plugin = shift;
801              
802 7         22 my %is_ignored = map { $_ => 1 }
803 30 50       95 $self->_zglob( [ @{ $self->ignores || [] }, @{ $plugin->ignores || [] } ] );
  30 50       854  
  30         1532  
804             my @matched
805 30 100 100     782 = grep { !$is_ignored{$_} } grep { -f && -s && !-l } $self->_zglob( $plugin->selects );
  64         291  
  67         1939  
806              
807 30 100       538 my $shebang = $plugin->shebang
808             or return @matched;
809              
810 1         2 my $re = join '|', map {quotemeta} @{$shebang};
  2         15  
  1         3  
811 1         61 $re = qr/^#!.*\b(?:$re)\b/;
812             return grep {
813 1         3 my $fh;
  6         10  
814 6 50       124 open $fh, '<', $_ or die $!;
815 6         136 scalar <$fh> =~ /$re/;
816             } @matched;
817             }
818              
819             sub _zglob {
820 60     60   2811 my ( $self, $globs ) = @_;
821              
822 60         133 local $Code::TidyAll::Zglob::NOCASE = 0;
823 60         95 my @files;
824 60         134 foreach my $glob (@$globs) {
825             try {
826 43     43   2721 push @files, zglob( join( "/", $self->root_dir, $glob ) );
827             }
828             catch {
829 0     0   0 die qq{error parsing '$glob': $_};
830             }
831 43         521 }
832 60         1464 return uniq(@files);
833             }
834              
835             sub msg {
836 133     133 0 646 my ( $self, $format, @params ) = @_;
837 133         832 $self->msg_outputter()->( $format, @params );
838             }
839              
840             sub _build_msg_outputter {
841             return sub {
842 135     135   688 my $format = shift;
843 135         11519 printf "$format\n", @_;
844 86     86   28531 };
845             }
846              
847             1;
848              
849             # ABSTRACT: Engine for tidyall, your all-in-one code tidier and validator
850              
851             __END__
852              
853             =pod
854              
855             =encoding UTF-8
856              
857             =head1 NAME
858              
859             Code::TidyAll - Engine for tidyall, your all-in-one code tidier and validator
860              
861             =head1 VERSION
862              
863             version 0.85
864              
865             =head1 SYNOPSIS
866              
867             use Code::TidyAll;
868              
869             my $ct = Code::TidyAll->new_from_conf_file(
870             '/path/to/conf/file',
871             ...
872             );
873              
874             # or
875              
876             my $ct = Code::TidyAll->new(
877             root_dir => '/path/to/root',
878             plugins => {
879             perltidy => {
880             select => 'lib/**/*.(pl|pm)',
881             argv => '-noll -it=2',
882             },
883             ...
884             }
885             );
886              
887             # then...
888              
889             $ct->process_paths($file1, $file2);
890              
891             =head1 DESCRIPTION
892              
893             This is the engine used by L<tidyall> - read that first to get an overview.
894              
895             You can call this API from your own program instead of executing C<tidyall>.
896              
897             =head1 METHODS
898              
899             This class offers the following methods:
900              
901             =head2 Code::TidyAll->new(%params)
902              
903             The regular constructor. Must pass at least I<plugins> and I<root_dir>.
904              
905             =head2 $tidyall->new_from_conf_file( $conf_file, %params )
906              
907             Takes a conf file path, followed optionally by a set of key/value parameters.
908             Reads parameters out of the conf file and combines them with the passed
909             parameters (the latter take precedence), and calls the regular constructor.
910              
911             If the conf file or params defines I<tidyall_class>, then that class is
912             constructed instead of C<Code::TidyAll>.
913              
914             =head3 Constructor parameters
915              
916             =over 4
917              
918             =item * plugins
919              
920             Specify a hash of plugins, each of which is itself a hash of options. This is
921             equivalent to what would be parsed out of the sections in the configuration
922             file.
923              
924             =item * selected_plugins
925              
926             An arrayref of plugins to be used. This overrides the C<mode> parameter.
927              
928             This is really only useful if you're getting configuration from a config file
929             and want to narrow the set of plugins to be run.
930              
931             Note that plugins will still only run on files which match their C<select> and
932             C<ignore> configuration.
933              
934             =item * cache_model_class
935              
936             The cache model class. Defaults to C<Code::TidyAll::CacheModel>
937              
938             =item * cache
939              
940             The cache instance (e.g. an instance of C<Code::TidyAll::Cache> or a C<CHI>
941             instance.) An instance of C<Code::TidyAll::Cache> is automatically instantiated
942             by default.
943              
944             =item * backup_ttl
945              
946             =item * check_only
947              
948             If this is true, then we simply check that files pass validation steps and that
949             tidying them does not change the file. Any changes from tidying are not
950             actually written back to the file.
951              
952             =item * no_cleanup
953              
954             A boolean indicating if we should skip cleaning temporary files or not.
955             Defaults to false.
956              
957             =item * inc
958              
959             An arrayref of directories to prepend to C<@INC>. This can be set via the
960             command-line as C<-I>, but you can also set it in a config file.
961              
962             This affects both loading and running plugins.
963              
964             =item * data_dir
965              
966             =item * iterations
967              
968             =item * mode
969              
970             =item * no_backups
971              
972             =item * no_cache
973              
974             =item * output_suffix
975              
976             =item * quiet
977              
978             =item * root_dir
979              
980             =item * ignore
981              
982             =item * verbose
983              
984             These options are the same as the equivalent C<tidyall> command-line options,
985             replacing dashes with underscore (e.g. the C<backup-ttl> option becomes
986             C<backup_ttl> here).
987              
988             =item * msg_outputter
989              
990             This is a subroutine reference that is called whenever a message needs to be
991             printed in some way. The sub receives a C<sprintf()> format string followed by
992             one or more parameters. The default sub used simply calls C<printf "$format\n",
993             @_> but L<Test::Code::TidyAll> overrides this to use the C<<
994             Test::Builder->diag >> method.
995              
996             =back
997              
998             =head2 $tidyall->process_paths( $path, ... )
999              
1000             This method iterates through a list of paths, processing all the files it
1001             finds. It will descend into subdirectories if C<recursive> flag is true.
1002             Returns a list of L<Code::TidyAll::Result> objects, one for each file.
1003              
1004             =head2 $tidyall->process_file( $file )
1005              
1006             Process the one I<file>, meaning:
1007              
1008             =over 4
1009              
1010             =item *
1011              
1012             Check the cache and return immediately if file has not changed.
1013              
1014             =item *
1015              
1016             Apply appropriate matching plugins.
1017              
1018             =item *
1019              
1020             Print success or failure result to STDOUT, depending on quiet/verbose settings.
1021              
1022             =item *
1023              
1024             Write to the cache if caching is enabled.
1025              
1026             =item *
1027              
1028             Return a L<Code::TidyAll::Result> object.
1029              
1030             =back
1031              
1032             =head2 $tidyall->process_source( $source, $path )
1033              
1034             Like C<process_file>, but process the I<source> string instead of a file, and
1035             does not read from or write to the cache. You must still pass the relative
1036             I<path> from the root as the second argument, so that we know which plugins to
1037             apply. Returns a L<Code::TidyAll::Result> object.
1038              
1039             =head2 $tidyall->plugins_for_path($path)
1040              
1041             Given a relative I<path> from the root, returns a list of
1042             L<Code::TidyAll::Plugin> objects that apply to it, or an empty list if no
1043             plugins apply.
1044              
1045             =head2 $tidyall->find_matched_files
1046              
1047             Returns a list of sorted files that match at least one plugin in configuration.
1048              
1049             =head2 Code::TidyAll->find_conf_file( $conf_names, $start_dir )
1050              
1051             Start in the I<start_dir> and work upwards, looking for a file matching one of
1052             the I<conf_names>. Returns the pathname if found or throw an error if not
1053             found.
1054              
1055             =head1 SUPPORT
1056              
1057             Bugs may be submitted at L<https://github.com/houseabsolute/perl-code-tidyall/issues>.
1058              
1059             =head1 SOURCE
1060              
1061             The source code repository for Code-TidyAll can be found at L<https://github.com/houseabsolute/perl-code-tidyall>.
1062              
1063             =head1 AUTHORS
1064              
1065             =over 4
1066              
1067             =item *
1068              
1069             Jonathan Swartz <swartz@pobox.com>
1070              
1071             =item *
1072              
1073             Dave Rolsky <autarch@urth.org>
1074              
1075             =back
1076              
1077             =head1 CONTRIBUTORS
1078              
1079             =for stopwords Adam Herzog Andreas Vögele Andy Jack Bernhard Schmalhofer Finn Smith George Hartzell Graham Knop gregor herrmann Gregory Oschwald Joe Crotty Kenneth Ölwing Mark Fowler Grimes Martin Gruner mauke Mohammad S Anwar Nick Tonkin Olaf Alders Paulo Custodio Pavel Dostál Pedro Melo Ricardo Signes Sergey Romanov Shlomi Fish timgimyee
1080              
1081             =over 4
1082              
1083             =item *
1084              
1085             Adam Herzog <adam@adamherzog.com>
1086              
1087             =item *
1088              
1089             Andreas Vögele <andreas@andreasvoegele.com>
1090              
1091             =item *
1092              
1093             Andy Jack <andyjack@cpan.org>
1094              
1095             =item *
1096              
1097             Bernhard Schmalhofer <Bernhard.Schmalhofer@gmx.de>
1098              
1099             =item *
1100              
1101             Finn Smith <finn@timeghost.net>
1102              
1103             =item *
1104              
1105             George Hartzell <georgewh@gene.com>
1106              
1107             =item *
1108              
1109             Graham Knop <haarg@haarg.org>
1110              
1111             =item *
1112              
1113             gregor herrmann <gregoa@debian.org>
1114              
1115             =item *
1116              
1117             Gregory Oschwald <goschwald@maxmind.com>
1118              
1119             =item *
1120              
1121             Joe Crotty <joe.crotty@returnpath.net>
1122              
1123             =item *
1124              
1125             Kenneth Ölwing <kenneth.olwing@skatteverket.se>
1126              
1127             =item *
1128              
1129             Mark Fowler <mark@twoshortplanks.com>
1130              
1131             =item *
1132              
1133             Mark Grimes <mgrimes@cpan.org>
1134              
1135             =item *
1136              
1137             Martin Gruner <martin.gruner@otrs.com>
1138              
1139             =item *
1140              
1141             mauke <lukasmai.403@gmail.com>
1142              
1143             =item *
1144              
1145             Mohammad S Anwar <mohammad.anwar@yahoo.com>
1146              
1147             =item *
1148              
1149             Nick Tonkin <ntonkin@bur-ntonkin-m1.corp.endurance.com>
1150              
1151             =item *
1152              
1153             Olaf Alders <olaf@wundersolutions.com>
1154              
1155             =item *
1156              
1157             Paulo Custodio <pauloscustodio@gmail.com>
1158              
1159             =item *
1160              
1161             Pavel Dostál <pdostal@suse.cz>
1162              
1163             =item *
1164              
1165             Pedro Melo <melo@simplicidade.org>
1166              
1167             =item *
1168              
1169             Ricardo Signes <rjbs@cpan.org>
1170              
1171             =item *
1172              
1173             Sergey Romanov <sromanov-dev@yandex.ru>
1174              
1175             =item *
1176              
1177             Shlomi Fish <shlomif@shlomifish.org>
1178              
1179             =item *
1180              
1181             timgimyee <tim.gim.yee@gmail.com>
1182              
1183             =back
1184              
1185             =head1 COPYRIGHT AND LICENSE
1186              
1187             This software is copyright (c) 2011 - 2025 by Jonathan Swartz.
1188              
1189             This is free software; you can redistribute it and/or modify it under
1190             the same terms as the Perl 5 programming language system itself.
1191              
1192             The full text of the license can be found in the
1193             F<LICENSE> file included with this distribution.
1194              
1195             =cut