????
Your IP : 3.146.255.135
| Current Path : /bin/ |
|
|
| Current File : //bin/perlver |
#!/usr/bin/perl
eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
if 0; # not running under some shell
package perlver;
=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>.
--blame option shows code which requires this version of perl
The synopsis above pretty much covers all you need to know at this point.
=cut
use 5.005;
use strict;
use version 'qv';
use File::Spec ();
use Getopt::Long 'GetOptions';
use Params::Util '_INSTANCE';
use File::Find::Rule ();
use File::Find::Rule::Perl ();
use Perl::MinimumVersion 'PMV';
# Define prototypes
sub verbose ($);
sub message ($);
sub error (@);
sub format_version ($);
sub dist ($);
use vars qw{$VERSION $VERBOSE $BLAME $EXPLAIN};
BEGIN {
$VERSION = '1.30';
# Configuration globals
$VERBOSE = '';
$BLAME = '';
$EXPLAIN = '';
# Unbuffer output
$| = 1;
}
#####################################################################
# Configuration
GetOptions(
verbose => \$VERBOSE,
blame => \$BLAME,
explain => \$EXPLAIN,
);
# Get the target
my $target = shift @ARGV;
unless ( $target ) {
error("You did not provide a file or directory to check");
}
print "\n";
if ( $BLAME ) {
blame($target);
} else {
summary($target);
}
exit(0);
#####################################################################
# Regular Mode
sub summary {
my $target = shift;
my @files = ();
if ( -d $target ) {
verbose "Found directory '$target'\n";
verbose "Searching for Perl files... ";
@files = find($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";
}
# 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;
# Load the document standalone first so we store the file name
my $document = PPI::Document::File->new(
$file,
readonly => 1,
);
unless ( $document ) {
verbose "[error]\n";
next;
}
# Create the version checker
my $pmv = PMV->new( $document );
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;
$result->[4] = $pmv->{syntax_check_failed} if exists $pmv->{syntax_check_failed};
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';
$output->[4] = $result->[4] || '' if ($EXPLAIN);
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";
if ($EXPLAIN) {
chomp($line_format);
$line_format.=" (%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;
}
# Prepare formatting parts
my $divider = " | $spacer |\n";
my $capline = " $spacer \n";
my $rowline = " | %-${len_all}s |\n";
# Print the results
print "\n";
print $capline;
printf( $line_format, @{shift(@outputs)} );
print $divider;
foreach my $result ( @outputs ) {
printf( $line_format, @$result );
}
print $divider;
printf( $rowline, "Minimum explicit version : $pmv_explicit" );
printf( $rowline, "Minimum syntax version : $pmv_syntax" );
printf( $rowline, "Minimum version of perl : $pmv_total" );
if ( $pmv_bug ) {
print $divider;
printf( $rowline, "ERROR : ACTUAL DEPENDENCY HIGHER THAN SPECIFIED" );
printf( $rowline, "DETAILS : perlver --blame $target" );
}
print $capline;
print "\n";
}
sub blame {
my $target = shift;
my @files = ();
if ( -d $target ) {
verbose "Found directory '$target'\n";
verbose "Searching for Perl files... ";
@files = find($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";
}
# Scan the files
verbose "Processing files...\n";
my $maximum = undef;
my $blame = undef;
my $file_len = 12 + List::Util::max map { length $_ } @files;
my $max = undef;
my $maxpmv = undef;
foreach my $file ( @files ) {
# Set up the results data
verbose sprintf("%-${file_len}s", "Scanning $file...");
# Load the document standalone first so we store the file name
my $document = PPI::Document::File->new(
$file,
readonly => 1,
);
unless ( $document ) {
verbose "[error]\n";
next;
}
# Create the version checker
my $pmv = PMV->new( $document );
unless ( $pmv ) {
verbose "[error]\n";
next;
}
# Check the syntax version
my $reason = $pmv->minimum_syntax_reason( $max ? $max->version : undef );
if ( $reason ) {
verbose $reason->version . "\n";
} else {
verbose "~\n";
next;
}
# Handle the first successful case
if ( ! $max or $reason->version > $max->version ) {
$max = $reason;
$maxpmv = $pmv;
next;
}
}
# Anything?
unless ( $max ) {
print "Nothing obvious to blame\n";
exit(0);
}
# Index and prepare
my $element = $max->element or die "Reason element unknown";
my $document = $element->top or die "Reason document unknown";
$document->index_locations;
# Generate the location message
my $file = $document->filename;
my $line = $element->line_number;
my $char = $element->column_number;
my $content = $element->content;
my $rule = $max->rule;
my $version = $max->version;
print " ------------------------------------------------------------\n";
print " File : $file\n";
print " Line : $line\n";
print " Char : $char\n";
print " Rule : $rule\n";
print " Version : $version\n";
print " ------------------------------------------------------------\n";
print " $content\n";
print " ------------------------------------------------------------\n";
}
sub find {
my $dir = shift;
my $perl = File::Find::Rule->perl_file;
my $build = File::Find::Rule->name('blib', '_build')->directory;
return dist($dir)
? File::Find::Rule->any(
$build->prune->discard,
$perl,
)->in( $dir )
: $perl->in( $dir );
}
#####################################################################
# 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, 'Perl::MinimumVersion::Reason') ) {
$version = $version->version->normal;
} elsif ( _INSTANCE($version, 'version') ) {
return $version->normal;
} elsif ( $version ) {
return "$version";
} elsif ( defined $version ) {
return '~';
} else {
return 'undef';
}
}
sub format_reason ($) {
my $reason = shift;
# Index the document of the worse offender
my $element = $reason->element;
my $document = $element->top;
$document->index_locations;
$DB::single = 1;
1;
}
sub dist ($) {
my $dir = shift;
if ( -f File::Spec->catfile($dir, 'Makefile.PL') ) {
return 1;
}
if ( -f File::Spec->catfile($dir, 'Build.PL') ) {
return 1;
}
return '';
}
=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 <adamk@cpan.org>
=head1 SEE ALSO
L<PPI>, L<Perl::MinimumVersion>
=head1 COPYRIGHT
Copyright 2005 - 2012 Adam Kennedy.
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
Warning: Cannot modify header information - headers already sent by (output started at /tmp/phpDV0f6J:203) in /home/r6536736/public_html/gaiheki-kyoto.com/wp-includes/pluggable.php on line 1435
Warning: Cannot modify header information - headers already sent by (output started at /tmp/phpDV0f6J:203) in /home/r6536736/public_html/gaiheki-kyoto.com/wp-includes/pluggable.php on line 1438