#!perl use strict; use warnings; use Fatal qw( open close waitpid ); use English qw( -no_match_vars ); use IPC::Open2; use POSIX qw(WIFEXITED); use Text::Diff; { package CountHunks; @CountHunks::ISA = qw( Text::Diff::Base ); sub hunk { return '1' } } package main; my %exclude = map { ( $_, 1 ) } qw( Changes MANIFEST META.yml Makefile.PL README etc/perlcriticrc etc/perltidyrc etc/last_minute_check.sh ); sub run_tidy { my $file = shift; my @cmd = qw(perltidy --profile=perltidyrc); push @cmd, $file; my ( $child_out, $child_in ); my $pid = IPC::Open2::open2( $child_out, $child_in, @cmd ) or Carp::croak("IPC::Open2 of perltidy pipe failed: $ERRNO"); close $child_in; my $tidy_output = do { local ($RS) = undef; <$child_out>; }; close $child_out; waitpid $pid, 0; my $diff = Text::Diff::diff $file, \$tidy_output, { STYLE => 'CountHunks', CONTEXT => 0 }; if ( my $child_error = $CHILD_ERROR ) { Carp::croak("perltidy returned $child_error"); } return $diff; } open my $manifest, '<', '../MANIFEST' or Carp::croak("open of MANIFEST failed: $ERRNO"); FILE: while ( my $file = <$manifest> ) { chomp $file; $file =~ s/\s*[#].*\z//xms; next FILE if $file =~ /.pod\z/xms; next FILE if $file =~ /.marpa\z/xms; next FILE if $file =~ /\/Makefile\z/xms; next FILE if $exclude{$file}; $file = '../' . $file; next FILE if -d $file; Carp::croak("No such file: $file") unless -f $file; my $result = run_tidy($file); if ($result) { print "$file: ", ( length $result ), " perltidy issues\n" or Carp::croak('Cannot print to STDOUT'); } else { print "$file: clean\n" or Carp::croak('Cannot print to STDOUT'); } } close $manifest;