package Perl::MinimumVersion::Fast;
use 5.008005;
use strict;
use warnings;
use version ();
use Compiler::Lexer 0.13;
use List::Util qw(max);
our $VERSION = "0.14";
my $MIN_VERSION = version->new('5.008');
my $VERSION_5_018 = version->new('5.018');
my $VERSION_5_016 = version->new('5.016');
my $VERSION_5_014 = version->new('5.014');
my $VERSION_5_012 = version->new('5.012');
my $VERSION_5_010 = version->new('5.010');
sub new {
my ($class, $stuff) = @_;
my $filename;
my $src;
if (ref $stuff ne 'SCALAR') {
$filename = $stuff;
open my $fh, '<', $filename
or die "Unknown file: $filename";
$src = do { local $/; <$fh> };
} else {
$filename = '-';
$src = $$stuff;
}
my $lexer = Compiler::Lexer->new($filename);
my @tokens = $lexer->tokenize($src);
my $self = bless { }, $class;
$self->{minimum_explicit_version} = $self->_build_minimum_explicit_version(\@tokens);
$self->{minimum_syntax_version} = $self->_build_minimum_syntax_version(\@tokens);
$self;
}
sub _build_minimum_explicit_version {
my ($self, $tokens) = @_;
my @tokens = map { @$_ } @{$tokens};
my $explicit_version;
for my $i (0..@tokens-1) {
if ($tokens[$i]->{name} eq 'UseDecl' || $tokens[$i]->{name} eq 'RequireDecl') {
if (@$tokens >= $i+1) {
my $next_token = $tokens[$i+1];
if ($next_token->{name} eq 'Double') {
$explicit_version = max($explicit_version || 0, version->new($next_token->{data}));
}
}
}
}
return $explicit_version;
}
sub _build_minimum_syntax_version {
my ($self, $tokens) = @_;
my @tokens = map { @$_ } @{$tokens};
my $syntax_version = $MIN_VERSION;
my $test = sub {
my ($reason, $version) = @_;
$syntax_version = max($syntax_version, $version);
push @{$self->{version_markers}->{$version}}, $reason;
};
for my $i (0..@tokens-1) {
my $token = $tokens[$i];
if ($token->{name} eq 'ToDo') {
# ... => 5.12
$test->('yada-yada-yada operator(...)' => $VERSION_5_012);
} elsif ($token->{name} eq 'Package') {
if (@tokens > $i+2 && $tokens[$i+1]->name eq 'Class') {
my $number = $tokens[$i+2];
if ($number->{name} eq 'Int' || $number->{name} eq 'Double' || $number->{name} eq 'VersionString') {
# package NAME VERSION; => 5.012
$test->('package NAME VERSION' => $VERSION_5_012);
if (@tokens > $i+3 && $tokens[$i+3]->{name} eq 'LeftBrace') {
$test->('package NAME VERSION BLOCK' => $VERSION_5_014);
}
} elsif ($tokens[$i+2]->{name} eq 'LeftBrace') {
$test->('package NAME BLOCK' => $VERSION_5_014);
}
}
} elsif ($token->{name} eq 'UseDecl' || $token->{name} eq 'RequireDecl') {
# use feature => 5.010
if (@tokens >= $i+1) {
my $next_token = $tokens[$i+1];
if ($next_token->{data} eq 'feature') {
if (@tokens > $i+2) {
my $next_token = $tokens[$i+2];
if ($next_token->name eq 'String') {
my $arg = $next_token->data;
my $ver = do {
if ($arg eq 'fc' || $arg eq 'unicode_eval' || $arg eq 'current_sub') {
$VERSION_5_016;
} elsif ($arg eq 'unicode_strings') {
$VERSION_5_012;
} elsif ($arg eq 'experimental::lexical_subs') {
$VERSION_5_018;
} elsif ($arg =~ /\A:5\.(.*)\z/) {
version->new("v5.$1");
} else {
$VERSION_5_010;
}
};
$test->('use feature' => $ver);
} else {
$test->('use feature' => $VERSION_5_010);
}
} else {
$test->('use feature' => $VERSION_5_010);
}
}
}
} elsif ($token->{name} eq 'DefaultOperator') {
if ($token->{data} eq '//' && $i >= 1) {
my $prev_token = $tokens[$i-1];
unless (
($prev_token->name eq 'BuiltinFunc' && $prev_token->data =~ m{\A(?:split|grep|map)\z})
|| $prev_token->name eq 'LeftParenthesis') {
$test->('// operator' => $VERSION_5_010);
}
}
} elsif ($token->{name} eq 'PolymorphicCompare') {
if ($token->{data} eq '~~') {
$test->('~~ operator' => $VERSION_5_010);
}
} elsif ($token->{name} eq 'DefaultEqual') {
if ($token->{data} eq '//=') {
$test->('//= operator' => $VERSION_5_010);
}
} elsif ($token->{name} eq 'GlobalHashVar') {
if ($token->{data} eq '%-' || $token->{data} eq '%+') {
$test->('%-/%+' => $VERSION_5_010);
}
} elsif ($token->{name} eq 'SpecificValue') {
# $-{"a"}
# $+{"a"}
if ($token->{data} eq '$-' || $token->{data} eq '$+') {
$test->('%-/%+' => $VERSION_5_010);
}
} elsif ($token->{name} eq 'GlobalArrayVar') {
if ($token->{data} eq '@-' || $token->{data} eq '@+') {
$test->('%-/%+' => $VERSION_5_010);
}
} elsif ($token->{name} eq 'WhenStmt') {
if ($i >= 1 && (
$tokens[$i-1]->{name} ne 'SemiColon'
&& $tokens[$i-1]->{name} ne 'RightBrace'
&& $tokens[$i-1]->{name} ne 'LeftBrace'
)) {
$test->("postfix when" => $VERSION_5_012);
} else {
$test->("normal when" => $VERSION_5_010);
}
} elsif ($token->{name} eq 'BuiltinFunc') {
if ($token->data eq 'each' || $token->data eq 'keys' || $token->data eq 'values') {
my $func = $token->data;
if (@tokens >= $i+1) {
my $next_token = $tokens[$i+1];
if ($next_token->name eq 'GlobalVar' || $next_token->name eq 'Var') {
# each $hashref
# each $arrayref
$test->("$func \$hashref, $func \$arrayref" => $VERSION_5_014);
} elsif ($next_token->name eq 'GlobalArrayVar' || $next_token->name eq 'ArrayVar') {
$test->("$func \@array" => $VERSION_5_012);
}
}
}
}
}
return $syntax_version;
}
sub minimum_version {
my $self = shift;
return $self->{minimum_explicit_version} > $self->{minimum_syntax_version}
? $self->{minimum_explicit_version}
: $self->{minimum_syntax_version};
}
sub minimum_syntax_version {
my $self = shift;
return $self->{minimum_syntax_version};
}
sub minimum_explicit_version {
my $self = shift;
return $self->{minimum_explicit_version};
}
sub version_markers {
my $self = shift;
if ( my $explicit = $self->minimum_explicit_version ) {
$self->{version_markers}->{$explicit} = [ 'explicit' ];
}
my @rv;
foreach my $ver ( sort { version->new($a) <=> version->new($b) } keys %{$self->{version_markers}} ) {
push @rv, version->new($ver) => $self->{version_markers}->{$ver};
}
return @rv;
}
1;
__END__
=encoding utf-8
=head1 NAME
Perl::MinimumVersion::Fast - Find a minimum required version of perl for Perl code
=head1 SYNOPSIS
use Perl::MinimumVersion::Fast;
my $p = Perl::MinimumVersion::Fast->new($filename);
print $p->minimum_version, "\n";
=head1 DESCRIPTION
"Perl::MinimumVersion::Fast" takes Perl source code and calculates the minimum
version of perl required to be able to run it. Because it is based on goccy's L<Compiler::Lexer>,
it can do this without having to actually load the code.
Perl::MinimumVersion::Fast is an alternative fast & lightweight implementation of Perl::MinimumVersion.
This module supports only Perl 5.8.1+.
If you want to support B<Perl 5.6>, use L<Perl::MinimumVersion> instead.
In 2013, you don't need to support Perl 5.6 in most of case.
=head1 METHODS
=over 4
=item C<< my $p = Perl::MinimumVersion::Fast->new($filename); >>
=item C<< my $p = Perl::MinimumVersion::Fast->new(\$src); >>
Create new instance. You can create object from C<< $filename >> and C<< \$src >> in string.
=item C<< $p->minimum_version(); >>
Get a minimum perl version the code required.
=item C<< $p->minimum_explicit_version() >>
The C<minimum_explicit_version> method checks through Perl code for the
use of explicit version dependencies such as.
use 5.006;
require 5.005_03;
Although there is almost always only one of these in a file, if more than
one are found, the highest version dependency will be returned.
Returns a L<version> object, C<undef> if no dependencies could be found.
=item C<< $p->minimum_syntax_version() >>
The C<minimum_syntax_version> method will explicitly test only the
Document's syntax to determine it's minimum version, to the extent
that this is possible.
Returns a L<version> object, C<undef> if no dependencies could be found.
=item version_markers
This method returns a list of pairs in the form:
($version, \@markers)
Each pair represents all the markers that could be found indicating that the
version was the minimum needed version. C<@markers> is an array of strings.
Currently, these strings are not as clear as they might be, but this may be
changed in the future. In other words: don't rely on them as specific
identifiers.
=back
=head1 BENCHMARK
Perl::MinimumVersion::Fast is faster than Perl::MinimumVersion.
Because Perl::MinimumVersion::Fast uses L<Compiler::Lexer>, that is a Perl5 lexer implemented in C++.
And Perl::MinimumVersion::Fast omits some features implemented in Perl::MinimumVersion.
But, but, L<Perl::MinimumVersion::Fast> is really fast.
Rate Perl::MinimumVersion Perl::MinimumVersion::Fast
Perl::MinimumVersion 5.26/s -- -97%
Perl::MinimumVersion::Fast 182/s 3365% --
=head1 LICENSE
Copyright (C) tokuhirom.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=head1 THANKS TO
Most of documents are taken from L<Perl::MinimumVersion>.
=head1 AUTHOR
tokuhirom E<lt>tokuhirom@gmail.comE<gt>
=head1 SEE ALSO
This module using L<Compiler::Lexer> as a lexer for Perl5 code.
This module is inspired from L<Perl::MinimumVersion>.
=cut