#!/usr/bin/perl

=pod

=head1 NAME

perlver - The Perl Minimum Version Analyzer

=head1 SYNOPSIS

  adam@red:~$ perlver Perl-MinimumVersion
  Found directory '.'
  Searching for Perl files... found 3 file(s)
  Scanning lib/Perl/MinimumVersion.pm... done
  Scanning t/01_compile.t... done
  Scanning t/02_main.t... done
  
      ---------------------------------------------------------
    | file                       | explicit | syntax | external |
    | --------------------------------------------------------- |
    | lib/Perl/MinimumVersion.pm | 5.005    | ~      | n/a      |
    | t/01_compile.t             | ~        | ~      | n/a      |
    | t/02_main.t                | ~        | ~      | n/a      |
      ---------------------------------------------------------
    
  Minimum version of Perl required: ...
  
  adam@red:~$

=head1 DESCRIPTION

C<perlver> is a console script created to provide convenient access to the
functionality provided by L<Perl::MinimumVersion>.

The synopsis above pretty much covers all you need to know at this point.

=cut

package perlver;

use 5.005;
use strict;
use version              'qv';
use Getopt::Long         'GetOptions';
use Params::Util         '_INSTANCE';
use File::Find::Rule     ();
use constant             'FFR' => 'File::Find::Rule';
use Perl::MinimumVersion 'PMV';

# Define prototypes
sub verbose        ($);
sub message        ($);
sub error          (@);
sub format_version ($);

use vars qw{$VERSION $VERBOSE};
BEGIN {
	$VERSION = '0.14';

	# Configuration globals
	$VERBOSE = '';

	# Unbuffer output
	$| = 1;
}

# Perl file searcher
my $FIND_PERL = FFR->file
	->or(
		FFR->name( qr/\.(?:pm|pl|t)$/i ),
		FFR->name( qr/^[^\.]$/ )
		   ->grep( qr/^#!.*\bperl/, [ sub { 1 } ] )
	);





#####################################################################
# Configuration

GetOptions(
	verbose => \$VERBOSE,
	);

# Get the target
my $target = shift @ARGV
	or error("You did not provide a file or directory to check");
my @files = ();
print "\n";
if ( -d $target ) {
	verbose "Found directory '$target'\n";
	verbose "Searching for Perl files... ";
	@files = $FIND_PERL->in( $target );
	verbose "found " . scalar(@files) . " file(s)\n";
} elsif ( -f $target ) {
	verbose "Found file '$target'\n";
	@files = $target;
} else {
	error "File or directory '$target' does not exist";
}





#####################################################################
# Execution

# Scan the files
verbose "Processing files...\n";
my @results  = ();
my $file_len = 12 + List::Util::max map { length $_ } @files;
foreach my $file ( @files ) {
	# Set up the results data
	verbose sprintf("%-${file_len}s", "Scanning $file...");
	my $result  = [ $file, undef, undef ];
	push @results, $result;

	# Create the version checker
	my $pmv = PMV->new( $file );
	unless ( $pmv ) {
		verbose "[error]\n";
		next;
	}

	# Check the explicit version
	$result->[1] = $pmv->minimum_explicit_version;

	# Check the syntax version
	$result->[2] = $pmv->minimum_syntax_version;

	verbose "[ok]\n";
}

# Calculate the minimum explicit, syntax and total versions
verbose "Compiling results...\n";
my $pmv_explicit = PMV->_max( map { $_->[1] } @results   );
my $pmv_syntax   = PMV->_max( map { $_->[2] } @results   );
my $pmv_bug      = !! ($pmv_explicit and $pmv_syntax and $pmv_syntax > $pmv_explicit);
my $pmv_total    = PMV->_max( $pmv_explicit, $pmv_syntax );

# Generate the output values
my @outputs = ( [ 'file', 'explicit', 'syntax', 'external' ] );
foreach my $result ( @results ) {
	my $output = [];
	$output->[0] = $result->[0];
	$output->[1] = format_version($result->[1]);
	$output->[2] = format_version($result->[2]);
	# $output->[3] = format_version($result->[3]);
	$output->[3] = 'n/a';
	push @outputs, $output;
}

# Complete the output preperation work
$pmv_explicit     = format_version( $pmv_explicit );
$pmv_syntax       = format_version( $pmv_syntax   );
$pmv_total        = format_version( $pmv_total    );
if ( $pmv_total eq '~' ) {
	$pmv_total = format_version( qv(5.004) ) . ' (default)';
}
my $len0          = List::Util::max map { length $_->[0] } @outputs;
my $len1          = List::Util::max map { length $_->[1] } @outputs;
my $len2          = List::Util::max map { length $_->[2] } @outputs;
my $len3          = List::Util::max map { length $_->[3] } @outputs;
my $len_all       = $len0 + $len1 + $len2 + $len3 + 9;
my $len_totals    = $len1 + $len2 + $len3 + 6;
my $line_format   = " | %-${len0}s | %-${len1}s | %-${len2}s | %-${len3}s |\n";
my $spacer        = '-' x $len_all;
my $error_message = "ERROR DETECTED : ACTUAL DEPENDENCY HIGHER THAN SPECIFIED";
my $error_length  = length $error_message;
if ( $error_length > $len_all ) {
	my $diff = $error_length - $len_all;
	$len_all += $diff;
	$len0    += $diff;
}

# Print the results
print "\n";
print "   $spacer\n";
printf( $line_format, @{shift(@outputs)} );
print " | $spacer |\n";
foreach my $result ( @outputs ) {
	printf( $line_format, @$result );
}
print " | $spacer |\n";
printf( " | %-${len_all}s |\n", "Minimum explicit version : $pmv_explicit" );
printf( " | %-${len_all}s |\n", "Minimum syntax version   : $pmv_syntax"   );
printf( " | %-${len_all}s |\n", "Minimum version of perl  : $pmv_total"    );
if ( $pmv_bug ) {
	print " | $spacer |\n";
	printf( " | %-${len_all}s |\n", "ERROR DETECTED : ACTUAL DEPENDENCY HIGHER THAN SPECIFIED" );
}
print "   $spacer\n";
print "\n";



# Done
exit(0);





#####################################################################
# Support Functions

sub verbose ($) {
	return 1 unless $VERBOSE;
	print ' ' . $_[0];
}

sub message ($) {
	print ' ' . $_[0];
}

sub error (@) {
	print ' ' . join '', map { "$_\n" } ('', @_, '');
	exit(255);
}

sub format_version ($) {
	my $version = shift;
	if ( _INSTANCE($version, 'version') ) {
		return $version->normal;
	} elsif ( $version ) {
		return "$version";
	} elsif ( defined $version ) {
		return '~';
	} else {
		return 'undef';
	}
}

=pod

=head1 TO DO

- Add PPI::Cache integration

- Add PPI::Metrics integration (once it exists)

- Add some sort of parseable output

=head1 SUPPORT

All bugs should be filed via the bug tracker at

L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Perl-MinimumVersion>

For other issues, or commercial enhancement and support, contact the author

=head1 AUTHORS

Adam Kennedy, L<http://ali.as/>, cpan@ali.as

=head1 SEE ALSO

L<PPI>, L<Perl::MinimumVersion>

=head1 COPYRIGHT

Copyright (c) 2005, 2006 Adam Kennedy. All rights reserved.

This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.

The full text of the license can be found in the
LICENSE file included with this module.

=cut
