#!/usr/bin/env perl
# Copyright (c) 2009, Marco Fontani <mfontani@cpan.org>
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#     * Redistributions of source code must retain the above copyright
#       notice, this list of conditions and the following disclaimer.
#     * Redistributions in binary form must reproduce the above copyright
#       notice, this list of conditions and the following disclaimer in the
#       documentation and/or other materials provided with the distribution.
#     * The names of its contributors may not be used to endorse or promote products
#       derived from this software without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED ''AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
# AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
# IN NO EVENT SHALL Marco Fontani BE LIABLE FOR ANY DIRECT, INDIRECT,
# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
# BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
# ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
use strict;
use warnings;
use threads;
use threads::shared;
use File::Util;
use File::Slurp;
use Perl::Tidy;
use Time::HiRes qw/usleep/;
use Text::Diff;

#######################
### Usage with Git: ###
#######################
### Modify a project's .git/hooks/pre-commit, containing:
# exec /path/to/tidyup.pl
### This will make it so that all files in the folder are checked prior to be
### committed to Git; this program's exit code will be 1 in case any files are
### found to be untidy, therefore enforcing checking in only tidy files.

########################
### Standalone usage ###
########################
### Just run it with any true value as parameter:
# /path/to/tidyup.pl 1
### This will scan files in the same way, but will launch perltidy -b on them.

###########################
### Sample .perltidyrc: ###
###########################
#-ce    # cuddle elses
#-l=100 # max 100 columns
#-i=2   # two spaces per indent

### Use File::Util to recursively fetch a list of all .pm and .pl files in this dir
my ($f) = File::Util->new();
my (@dirs_and_files) = $f->list_dir( '.', '--recurse' );
my @perlfiles = grep { /\.p[ml]$/i } @dirs_and_files;

### find the longest file's name; share the var [used later to format the output]
my $longestfilename : shared = -( ( sort { $b <=> $a } map { length $_ } @perlfiles )[0] );

### Don't exec perltidy by default
my $exec = shift;
$exec = 0 if ( !defined $exec );

### Don't be verbose by default
my $verbose = shift;
$verbose = 0 if ( !defined $verbose );

### Lists untidy files, needs to be shared amongst threads
my @untidy : shared;

### Number of threads to be created
my $NTHREADS = 3;

### Queue for each worker
my @q;
foreach (0..$NTHREADS-1) { $q[$_] = []; }
foreach (0..$#perlfiles) {
  push @{ $q[ $_ % $NTHREADS ] }, $perlfiles[$_];
}

### Either tidies the file or adds it to the list of untidy files
sub tidy_file {
  my ( $files, $exec ) = @_;
  foreach my $file (@$files) {
    my $contents = read_file($file);
    threads->yield();
    my $tidied = '';
    perltidy( source => \$contents, destination => \$tidied );
    threads->yield();
    if ( $contents ne $tidied ) {
      if ( !$exec ) {
        printf( "%${longestfilename}s is NOT tidy\n", $file );
        {
          lock(@untidy);
          push @untidy, $file;
        }
      } else {
        printf "%${longestfilename}s is NOT tidy => perltidy -b %s\n", $file, $file;
        print diff \$contents, \$tidied, { STYLE => 'Table' } if ( $verbose );
        if ( system( 'perltidy', '-b', $file ) != 0 ) {
          warn "Couldn't tidy $file: $?";
          lock(@untidy);
          push @untidy, $file;
        }
        threads->yield();
      }
    } else {
      printf "%${longestfilename}s is tidy\n", $file;
    }
  }
}

print "Perl files:\n";

### No suffering from buffering
local $| = 1;

my @thr;

### Create all threads
foreach my $queue (@q) {
  push @thr, threads->create( 'tidy_file', $queue, $exec );
}

### Await threads completion
while ( threads->list(threads::running) ) {
  usleep(1000);
}

### Rejoin all threads
foreach ( threads->list(threads::joinable) ) {
  $_->join();
}

### Exit with error in case untidy files have been found
if (@untidy) {
  exit 1;
} else {
  exit 0;
}