KevinSchoenmayer/GseTDDUebungKCLR
2
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial Commit

Browse Source
This commit is contained in:
Riley Schneider
2025-12-03 16:38:10 +01:00
parent c5e26bf594
commit b732d8d4b5
17680 changed files with 5977495 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

225
database/perl/lib/Perl/OSType.pm Normal file
View File

@@ -0,0 +1,225 @@
use strict;
use warnings;
package Perl::OSType;
# ABSTRACT: Map Perl operating system names to generic types
our $VERSION = '1.010';
require Exporter;
our @ISA = qw(Exporter);
our %EXPORT_TAGS = ( all => [qw( os_type is_os_type )] );
our @EXPORT_OK = @{ $EXPORT_TAGS{all} };
# originally taken from Module::Build by Ken Williams et al.
my %OSTYPES = qw(
aix Unix
bsdos Unix
beos Unix
bitrig Unix
dgux Unix
dragonfly Unix
dynixptx Unix
freebsd Unix
linux Unix
haiku Unix
hpux Unix
iphoneos Unix
irix Unix
darwin Unix
machten Unix
midnightbsd Unix
minix Unix
mirbsd Unix
next Unix
openbsd Unix
netbsd Unix
dec_osf Unix
nto Unix
svr4 Unix
svr5 Unix
sco Unix
sco_sv Unix
unicos Unix
unicosmk Unix
solaris Unix
sunos Unix
cygwin Unix
msys Unix
os2 Unix
interix Unix
gnu Unix
gnukfreebsd Unix
nto Unix
qnx Unix
android Unix
dos Windows
MSWin32 Windows
os390 EBCDIC
os400 EBCDIC
posix-bc EBCDIC
vmesa EBCDIC
MacOS MacOS
VMS VMS
vos VOS
riscos RiscOS
amigaos Amiga
mpeix MPEiX
);
sub os_type {
my ($os) = @_;
$os = $^O unless defined $os;
return $OSTYPES{$os} || q{};
}
sub is_os_type {
my ( $type, $os ) = @_;
return unless $type;
$os = $^O unless defined $os;
return os_type($os) eq $type;
}
1;
=pod
=encoding UTF-8
=head1 NAME
Perl::OSType - Map Perl operating system names to generic types
=head1 VERSION
version 1.010
=head1 SYNOPSIS
use Perl::OSType ':all';
$current_type = os_type();
$other_type = os_type('dragonfly'); # gives 'Unix'
=head1 DESCRIPTION
Modules that provide OS-specific behaviors often need to know if
the current operating system matches a more generic type of
operating systems. For example, 'linux' is a type of 'Unix' operating system
and so is 'freebsd'.
This module provides a mapping between an operating system name as given by
C<$^O> and a more generic type. The initial version is based on the OS type
mappings provided in L<Module::Build> and L<ExtUtils::CBuilder>. (Thus,
Microsoft operating systems are given the type 'Windows' rather than 'Win32'.)
=head1 USAGE
No functions are exported by default. The export tag ":all" will export
all functions listed below.
=head2 os_type()
$os_type = os_type();
$os_type = os_type('MSWin32');
Returns a single, generic OS type for a given operating system name. With no
arguments, returns the OS type for the current value of C<$^O>. If the
operating system is not recognized, the function will return the empty string.
=head2 is_os_type()
$is_windows = is_os_type('Windows');
$is_unix = is_os_type('Unix', 'dragonfly');
Given an OS type and OS name, returns true or false if the OS name is of the
given type. As with C<os_type>, it will use the current operating system as a
default if no OS name is provided.
=head1 SEE ALSO
=over 4
=item *
L<Devel::CheckOS>
=back
=for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
=head1 SUPPORT
=head2 Bugs / Feature Requests
Please report any bugs or feature requests through the issue tracker
at L<https://github.com/Perl-Toolchain-Gang/Perl-OSType/issues>.
You will be notified automatically of any progress on your issue.
=head2 Source Code
This is open source software. The code repository is available for
public review and contribution under the terms of the license.
L<https://github.com/Perl-Toolchain-Gang/Perl-OSType>
git clone https://github.com/Perl-Toolchain-Gang/Perl-OSType.git
=head1 AUTHOR
David Golden <dagolden@cpan.org>
=head1 CONTRIBUTORS
=for stopwords Chris 'BinGOs' Williams David Golden Graham Ollis Jonas B. Nielsen Owain G. Ainsworth Paul Green Piotr Roszatycki
=over 4
=item *
Chris 'BinGOs' Williams <chris@bingosnet.co.uk>
=item *
David Golden <xdg@xdg.me>
=item *
Graham Ollis <plicease@cpan.org>
=item *
Jonas B. Nielsen <jonasbn@hoarfrost.local>
=item *
Owain G. Ainsworth <oga@nicotinebsd.org>
=item *
Paul Green <Paul.Green@stratus.com>
=item *
Piotr Roszatycki <piotr.roszatycki@gmail.com>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2016 by David Golden.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
__END__
# vim: ts=4 sts=4 sw=4 et:

2414
database/perl/lib/Perl/PrereqScanner/NotQuiteLite.pm Normal file
View File

File diff suppressed because it is too large Load Diff

679
database/perl/lib/Perl/PrereqScanner/NotQuiteLite/App.pm Normal file
View File

@@ -0,0 +1,679 @@
package Perl::PrereqScanner::NotQuiteLite::App;
use strict;
use warnings;
use File::Find;
use File::Glob 'bsd_glob';
use File::Basename;
use File::Spec;
use CPAN::Meta::Prereqs;
use CPAN::Meta::Requirements;
use Perl::PrereqScanner::NotQuiteLite;
use Perl::PrereqScanner::NotQuiteLite::Util::Prereqs;
use constant WIN32 => $^O eq 'MSWin32';
my %IsTestClassFamily = map {$_ => 1} qw(
Test::Class
Test::Class::Moose
Test::Class::Most
Test::Class::Sugar
Test::Classy
);
sub new {
my ($class, %opts) = @_;
for my $key (keys %opts) {
next unless $key =~ /\-/;
(my $replaced_key = $key) =~ s/\-/_/g;
$opts{$replaced_key} = $opts{$key};
}
$opts{prereqs} = CPAN::Meta::Prereqs->new;
$opts{parsers} = [':bundled'] unless defined $opts{parsers};
$opts{recommends} = 0 unless defined $opts{recommends};
$opts{suggests} = 0 unless defined $opts{suggests};
$opts{base_dir} ||= File::Spec->curdir;
$opts{cpanfile} = 1 if $opts{save_cpanfile};
if ($opts{features} and ref $opts{features} ne 'HASH') {
my @features;
if (!ref $opts{features}) {
@features = split ';', $opts{features};
} elsif (ref $opts{features} eq 'ARRAY') {
@features = @{$opts{features}};
}
my %map;
for my $spec (@features) {
my ($identifier, $description, $paths) = split ':', $spec;
my @paths = map { bsd_glob(File::Spec->catdir($opts{base_dir}, $_)) } split ',', $paths;
if (WIN32) {
s|\\|/|g for @paths;
}
$map{$identifier} = {
description => $description,
paths => \@paths,
};
}
$opts{features} = \%map;
}
if ($opts{ignore} and ref $opts{ignore} eq 'ARRAY') {
require Regexp::Trie;
my $re = Regexp::Trie->new;
for (@{$opts{ignore}}) {
s|\\|/|g if WIN32;
$re->add($_);
}
$opts{ignore_re} ||= $re->_regexp;
}
if ($opts{private} and ref $opts{private} eq 'ARRAY') {
require Regexp::Trie;
my $re = Regexp::Trie->new;
for (@{$opts{private}}) {
$re->add($_);
}
$opts{private_re} ||= $re->_regexp;
}
if (my $index_name = delete $opts{use_index}) {
my $index_package = "CPAN::Common::Index::$index_name";
if (eval "require $index_package; 1") {
$opts{index} = $index_package->new;
}
}
if ($opts{scan_also}) {
$opts{libs} ||= delete $opts{scan_also};
}
bless \%opts, $class;
}
sub run {
my ($self, @args) = @_;
unless (@args) {
# for configure requires
push @args, "Makefile.PL", "Build.PL";
# for test requires
push @args, "t";
# for runtime requires;
if ($self->{blib} and -d File::Spec->catdir($self->{base_dir}, 'blib')) {
push @args, "blib/lib", "blib/bin", "blib/script";
} else {
push @args, "lib";
push @args, glob(File::Spec->catfile($self->{base_dir}, '*.pm'));
push @args, "bin", "script", "scripts";
}
# extra libs
push @args, map { bsd_glob(File::Spec->catdir($self->{base_dir}, $_)) } @{$self->{libs} || []};
# for develop requires
push @args, "xt", "author" if $self->{develop};
}
if ($self->{verbose}) {
print STDERR "Scanning the following files/directories\n";
print STDERR " $_\n" for sort @args;
}
for my $path (@args) {
my $item = File::Spec->file_name_is_absolute($path) ? $path : File::Spec->catfile($self->{base_dir}, $path);
-d $item ? $self->_scan_dir($item) :
-f $item ? $self->_scan_file($item) :
next;
}
# add test requirements by .pm files used in .t files
$self->_add_test_requires($self->{allow_test_pms});
$self->_exclude_local_modules;
if ($self->{exclude_core}) {
$self->_exclude_core_prereqs;
}
if ($self->{index}) {
$self->_dedupe_indexed_prereqs;
}
$self->_dedupe;
if ($self->{print} or $self->{cpanfile}) {
if ($self->{json}) {
# TODO: feature support (how should we express it?)
eval { require JSON::PP } or die "requires JSON::PP";
print JSON::PP->new->pretty(1)->canonical->encode($self->{prereqs}->as_string_hash);
} elsif ($self->{cpanfile}) {
eval { require Perl::PrereqScanner::NotQuiteLite::Util::CPANfile } or die "requires Module::CPANfile";
my $file = File::Spec->catfile($self->{base_dir}, "cpanfile");
my $cpanfile = Perl::PrereqScanner::NotQuiteLite::Util::CPANfile->load_and_merge($file, $self->{prereqs}, $self->{features});
$self->_dedupe_indexed_prereqs($cpanfile->prereqs) if $self->{index};
if ($self->{save_cpanfile}) {
$cpanfile->save($file);
} elsif ($self->{print}) {
print $cpanfile->to_string, "\n";
}
return $cpanfile;
} elsif ($self->{print}) {
$self->_print_prereqs;
}
}
$self->{prereqs};
}
sub index { shift->{index} }
sub _print_prereqs {
my $self = shift;
my $combined = CPAN::Meta::Requirements->new;
for my $req ($self->_requirements) {
$combined->add_requirements($req);
}
my $hash = $combined->as_string_hash;
for my $module (sort keys %$hash) {
next if $module eq 'perl';
my $version = $hash->{$module} || 0;
$version = qq{"$version"} unless $version =~ /^[0-9]+(?:\.[0-9]+)?$/;
print $version eq '0' ? "$module\n" : "$module~$version\n";
}
}
sub _requirements {
my ($self, $prereqs) = @_;
$prereqs ||= $self->{prereqs};
my @phases = qw/configure runtime build test/;
push @phases, 'develop' if $self->{develop};
my @types = $self->{suggests} ? qw/requires recommends suggests/ : $self->{recommends} ? qw/requires recommends/ : qw/requires/;
my @requirements;
for my $phase (@phases) {
for my $type (@types) {
my $req = $prereqs->requirements_for($phase, $type);
next unless $req->required_modules;
push @requirements, $req;
}
}
if ($self->{features}) {
my @feature_prereqs = grep defined, map {$self->{features}{$_}{prereqs}} keys %{$self->{features} || {}};
for my $feature_prereqs (@feature_prereqs) {
for my $phase (@phases) {
for my $type (@types) {
my $req = $feature_prereqs->requirements_for($phase, $type);
next unless $req->required_modules;
push @requirements, $req;
}
}
}
}
@requirements;
}
sub _exclude_local_modules {
my $self = shift;
my @local_dirs = ("inc", @{$self->{libs} || []});
for my $dir (@local_dirs) {
my $local_dir = File::Spec->catdir($self->{base_dir}, $dir);
next unless -d $local_dir;
find({
wanted => sub {
my $file = $_;
return unless -f $file;
my $relpath = File::Spec->abs2rel($file, $local_dir);
return unless $relpath =~ /\.pm$/;
my $module = $relpath;
$module =~ s!\.pm$!!;
$module =~ s![\\/]!::!g;
$self->{possible_modules}{$module} = 1;
$self->{possible_modules}{"inc::$module"} = 1 if $dir eq 'inc';
},
no_chdir => 1,
}, $local_dir);
}
my $private_re = $self->{private_re};
for my $req ($self->_requirements) {
for my $module ($req->required_modules) {
next unless $self->{possible_modules}{$module} or ($private_re and $module =~ /$private_re/);
$req->clear_requirement($module);
if ($self->{verbose}) {
print STDERR " excluded $module (local)\n";
}
}
}
}
sub _exclude_core_prereqs {
my $self = shift;
eval { require Module::CoreList; Module::CoreList->VERSION('2.99') } or die "requires Module::CoreList 2.99";
my $perl_version = $self->{perl_version} || $self->_find_used_perl_version || '5.008001';
if ($perl_version =~ /^v?5\.(0?[1-9][0-9]?)(?:\.([0-9]))?$/) {
$perl_version = sprintf '5.%03d%03d', $1, $2 || 0;
}
$perl_version = '5.008001' unless exists $Module::CoreList::version{$perl_version};
my %core_alias = (
'Getopt::Long::Parser' => 'Getopt::Long',
'Tie::File::Cache' => 'Tie::File',
'Tie::File::Heap' => 'Tie::File',
'Tie::StdScalar' => 'Tie::Scalar',
'Tie::StdArray' => 'Tie::Array',
'Tie::StdHash' => 'Tie::Hash',
'Tie::ExtraHash' => 'Tie::Hash',
'Tie::RefHash::Nestable' => 'Tie::RefHash',
);
for my $req ($self->_requirements) {
for my $module ($req->required_modules) {
$module = $core_alias{$module} if exists $core_alias{$module};
if (Module::CoreList::is_core($module, undef, $perl_version) and
!Module::CoreList::deprecated_in($module, undef, $perl_version)
) {
my $core_version = $Module::CoreList::version{$perl_version}{$module} or next;
next unless $req->accepts_module($module => $core_version);
$req->clear_requirement($module);
if ($self->{verbose}) {
print STDERR " excluded $module ($perl_version core)\n";
}
}
}
}
}
sub _find_used_perl_version {
my $self = shift;
my @perl_versions;
my $perl_requirements = CPAN::Meta::Requirements->new;
for my $req ($self->_requirements) {
my $perl_req = $req->requirements_for_module('perl');
$perl_requirements->add_string_requirement('perl', $perl_req) if $perl_req;
}
return $perl_requirements->is_simple ? $perl_requirements->requirements_for_module('perl') : undef;
}
sub _add_test_requires {
my ($self, $force) = @_;
if (my $test_reqs = $self->{prereqs}->requirements_for('test', 'requires')) {
my @required_modules = $test_reqs->required_modules;
for my $module (@required_modules) {
$force = 1 if exists $IsTestClassFamily{$module};
my $relpath = $self->{possible_modules}{$module} or next;
my $context = delete $self->{_test_pm}{$relpath} or next;
$test_reqs->add_requirements($context->requires);
if ($self->{recommends} or $self->{suggests}) {
$self->{prereqs}->requirements_for('test', 'recommends')->add_requirements($context->recommends);
}
if ($self->{suggests}) {
$self->{prereqs}->requirements_for('test', 'suggests')->add_requirements($context->suggests);
}
}
if ($force) {
for my $context (values %{$self->{_test_pm} || {}}) {
$test_reqs->add_requirements($context->requires);
if ($self->{recommends} or $self->{suggests}) {
$self->{prereqs}->requirements_for('test', 'recommends')->add_requirements($context->recommends);
}
if ($self->{suggests}) {
$self->{prereqs}->requirements_for('test', 'suggests')->add_requirements($context->suggests);
}
}
}
}
}
sub _dedupe {
my $self = shift;
my $prereqs = $self->{prereqs};
my %features = map {$_ => $self->{features}{$_}{prereqs}} keys %{$self->{features} || {}};
dedupe_prereqs_and_features($prereqs, \%features);
}
sub _get_uri {
my ($self, $module) = @_;
$self->{uri_cache}{$module} ||= $self->__get_uri($module);
}
sub __get_uri {
my ($self, $module) = @_;
my $res = $self->{index}->search_packages({ package => $module }) or return;
## ignore (non-dual) core modules
return if URI->new($res->{uri})->dist_name eq 'perl';
return $res->{uri};
}
sub _dedupe_indexed_prereqs {
my ($self, $prereqs) = @_;
require URI::cpan;
for my $req ($self->_requirements($prereqs)) {
my %uri_map;
for my $module ($req->required_modules) {
next if $module eq 'perl';
my $uri = $self->_get_uri($module) or next;
$uri_map{$uri}{$module} = $req->requirements_for_module($module);
}
for my $uri (keys %uri_map) {
my @modules = keys %{$uri_map{$uri}};
next if @modules < 2;
my @modules_without_version = grep {!$uri_map{$uri}{$_}} @modules;
next unless @modules_without_version;
# clear unversioned prereqs if a versioned prereq exists
if (@modules > @modules_without_version) {
$req->clear_requirement($_) for @modules_without_version;
next;
}
# Replace with the main module if none is versioned
my $dist = URI->new($uri)->dist_name;
(my $main_module = $dist) =~ s/-/::/g;
if ($self->_get_uri($main_module)) {
$req->add_minimum($main_module);
for my $module (@modules_without_version) {
next if $main_module eq $module;
$req->clear_requirement($module);
if ($self->{verbose}) {
print STDERR " deduped $module (in favor of $main_module)\n";
}
}
} else {
# special case for distributions without a main module
my %score;
for my $module (@modules_without_version) {
my $depth = $module =~ s/::/::/g;
my $length = length $module;
$score{$module} = join ".", ($depth || 0), $length;
}
my $topmost = (sort {$score{$a} <=> $score{$b} or $a cmp $b} @modules_without_version)[0];
for my $module (@modules_without_version) {
next if $topmost eq $module;
$req->clear_requirement($module);
if ($self->{verbose}) {
print STDERR " deduped $module (in favor of $topmost)\n";
}
}
}
}
}
}
sub _scan_dir {
my ($self, $dir) = @_;
find ({
no_chdir => 1,
wanted => sub {
my $file = $_;
return unless -f $file;
my $relpath = File::Spec->abs2rel($file, $self->{base_dir});
return unless $relpath =~ /\.(?:pl|PL|pm|cgi|psgi|t)$/ or
dirname($relpath) =~ m!\b(?:bin|scripts?)$! or
($self->{develop} and $relpath =~ /^(?:author)\b/);
$self->_scan_file($file);
},
}, $dir);
}
sub _scan_file {
my ($self, $file) = @_;
$file =~ s|\\|/|g if WIN32;
if ($self->{ignore_re}) {
return if $file =~ /\b$self->{ignore_re}\b/;
}
my $context = Perl::PrereqScanner::NotQuiteLite->new(
parsers => $self->{parsers},
recommends => $self->{recommends},
suggests => $self->{suggests},
verbose => $self->{verbose},
)->scan_file($file);
my $relpath = File::Spec->abs2rel($file, $self->{base_dir});
$relpath =~ s|\\|/|g if WIN32;
my $prereqs = $self->{prereqs};
if ($self->{features}) {
for my $identifier (keys %{$self->{features}}) {
my $feature = $self->{features}{$identifier};
if (grep {$file =~ m!^$_(?:/|$)!} @{$feature->{paths}}) {
$prereqs = $feature->{prereqs} ||= CPAN::Meta::Prereqs->new;
last;
}
}
}
if ($relpath =~ m!(?:^|[\\/])t[\\/]!) {
if ($relpath =~ /\.t$/) {
$self->_add($prereqs, test => $context);
} elsif ($relpath =~ /\.pm$/) {
$self->{_test_pm}{$relpath} = $context;
}
} elsif ($relpath =~ m!(?:^|[\\/])(?:xt|inc|author)[\\/]!) {
$self->_add($prereqs, develop => $context);
} elsif ($relpath =~ m!(?:(?:^|[\\/])Makefile|^Build)\.PL$!) {
$self->_add($prereqs, configure => $context);
} elsif ($relpath =~ m!(?:^|[\\/])(?:.+)\.PL$!) {
$self->_add($prereqs, build => $context);
} else {
$self->_add($prereqs, runtime => $context);
}
if ($relpath =~ /\.pm$/) {
my $module = $relpath;
$module =~ s!\.pm$!!;
$module =~ s![\\/]!::!g;
$self->{possible_modules}{$module} = $relpath;
$module =~ s!^(?:inc|blib|x?t)::!!;
$self->{possible_modules}{$module} = $relpath;
$module =~ s!^lib::!!;
$self->{possible_modules}{$module} = $relpath;
}
}
sub _add {
my ($self, $prereqs, $phase, $context) = @_;
$prereqs->requirements_for($phase, 'requires')
->add_requirements($context->requires);
if ($self->{suggests} or $self->{recommends}) {
$prereqs->requirements_for($phase, 'recommends')
->add_requirements($context->recommends);
}
if ($self->{suggests}) {
$prereqs->requirements_for($phase, 'suggests')
->add_requirements($context->suggests);
}
}
1;
__END__
=encoding utf-8
=head1 NAME
Perl::PrereqScanner::NotQuiteLite::App
=head1 SYNOPSIS
scan-perl-prereqs-nqlite [options] [DIRS|FILES]
-or-
use Perl::PrereqScanner::NotQuiteLite::App;
my $app = Perl::PrereqScanner::NotQuiteLite::App->new(
parsers => [qw/:bundled/],
suggests => 1,
perl_minimum_version => 1,
);
my $prereqs = $app->run;
=head1 DESCRIPTION
Perl::PrereqScanner::NotQuiteLite::App walks down a directory
and scans appropriate files to find prerequisites.
You usually don't need to touch this module directly, but you
might want to if you need finer control (to use a custom CPAN index
etc).
=head1 METHODS
=head2 new
creates an object. Notable options are:
=over 4
=item parsers
Perl::PrereqScanner::NotQuiteLite::App uses all the bundled parsers
by default, but you can change if you need your own parsers.
See L<Perl::PrereqScanner::NotQuiteLite> for details.
=item recommends, suggests, perl_minimum_version
Perl::PrereqScanner::NotQuiteLite::App usually returns C<use>d
modules only, but you can change this behavior by setting these
options. See L<Perl::PrereqScanner::NotQuiteLite> for details.
=item develop
If set, Perl::PrereqScanner::NotQuiteLite::App also scans files under
C<xt> and C<author> directories to find requirements for development.
=item exclude_core
If set, Perl::PrereqScanner::NotQuiteLite::App ignores prerequisites
that are bundled with Perl (of 5.008001 by default, or of a C<use>d
perl version if any). This requires L<Module::CoreList> version 2.99
or above.
=item perl_version
You can explicitly use this option to exclude core modules of a
specific perl version.
=item allow_test_pms
Perl::PrereqScanner::NotQuiteLite::App usually ignores C<.pm> files
under C<t/> directory if they are not used in C<.t> files, considering
they are some kind of sample files. However, this assumption may be
wrong sometimes. If this option is set, it scans all the C<.pm> files
under C<t/> directory, considering some of the test modules will use
them. If L<Test::Class> (or its equivalent) is used in a test
file, this option is implicitly set.
=item base_dir
Perl::PrereqScanner::NotQuiteLite::App usually starts traversing from
the current directory. If this option is set, it starts from there.
=item scan_also
Perl::PrereqScanner::NotQuiteLite::App usually scans C<.pm> files
in the base dir, C<Makefile.PL>/C<Build.PL>, files under C<lib>,
C<t>, C<bin>, C<script(s)> directories (and C<xt>, C<author> if asked).
If your distribution uses a different file layout, or uses extra
directories to keep submodules, you can add (a reference to) a list
of paths to scan.
=item ignore, ignore_re
Your distribution may have OS-specific modules whose prerequisites
can not be installed in other platforms. You can specify (a reference
to) a list of files that should not be scanned (with C<ignore> option),
or a regular expression that matches the files (with C<ignore_re>
option).
=item features
my $app = Perl::PrereqScanner::NotQuiteLite::App->new(
features => {
'windows' => {
description => 'Windows support',
paths => ['lib/Foo/Win32.pm'],
}
},
);
Instead of ignoring a set of files, you can use C<features> option to
let their prerequisites belong to a specific feature that will not be
installed unless asked. However, you are advised to create a separate
distribution for the specific feature.
=item private, private_re
Your distribution may use private modules that are not uploaded to
the CPAN and thus should not be included in C<cpanfile>. You can
specify (a reference to) a list of those private modules (with
C<private> option) or a regular expression that matches those modules
(with C<private_re> option).
=item use_index, index
Perl::PrereqScanner::NotQuiteLite::App usually lists all the C<use>d
modules as prerequisites, but some of them may belong to the same
distribution. If an instance of L<CPAN::Common::Index> backend is
passed, it is used to dedupe those prerequisites (as long as they are
not versioned).
use CPAN::Common::Index::LocalPackage;
my $index = CPAN::Common::Index::LocalPackage->new(
{ source => "$ENV{HOME}/minicpan/modules/02packages.details.txt" }
);
my $app = Perl::PrereqScanner::NotQuiteLite::App->new(
index => $index,
);
=back
=head2 run
traverses files and directories and returns a L<CPAN::Meta::Prereqs>
object that keeps all the requirements/suggestions, without printing
anything unless you explicitly pass a C<print> option to C<new>.
=head2 index
returns a L<CPAN::Common::Index> backend object (if any).
=head1 AUTHOR
Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015 by Kenichi Ishigaki.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

794
database/perl/lib/Perl/PrereqScanner/NotQuiteLite/Context.pm Normal file
View File

@@ -0,0 +1,794 @@
package Perl::PrereqScanner::NotQuiteLite::Context;
use strict;
use warnings;
use CPAN::Meta::Requirements;
use Regexp::Trie;
use Perl::PrereqScanner::NotQuiteLite::Util;
my %defined_keywords = _keywords();
my %default_op_keywords = map {$_ => 1} qw(
x eq ne and or xor cmp ge gt le lt not
);
my %default_conditional_keywords = map {$_ => 1} qw(
if elsif unless else
);
my %default_expects_expr_block = map {$_ => 1} qw(
if elsif unless given when
for foreach while until
);
my %default_expects_block_list = map {$_ => 1} qw(
map grep sort
);
my %default_expects_fh_list = map {$_ => 1} qw(
print printf say
);
my %default_expects_fh_or_block_list = (
%default_expects_block_list,
%default_expects_fh_list,
);
my %default_expects_block = map {$_ => 1} qw(
else default
eval sub do while until continue
BEGIN END INIT CHECK
if elsif unless given when
for foreach while until
map grep sort
);
my %default_expects_word = map {$_ => 1} qw(
use require no sub
);
my %enables_utf8 = map {$_ => 1} qw(
utf8
Mojo::Base
Mojo::Base::Che
);
my %new_keyword_since = (
say => '5.010',
state => '5.010',
given => '5.010',
when => '5.010',
default => '5.010',
);
my $default_g_re_prototype = qr{\G(\([^\)]*?\))};
sub new {
my ($class, %args) = @_;
my %context = (
requires => CPAN::Meta::Requirements->new,
noes => CPAN::Meta::Requirements->new,
file => $args{file},
verbose => $args{verbose},
stash => {},
);
if ($args{suggests} or $args{recommends}) {
$context{recommends} = CPAN::Meta::Requirements->new;
}
if ($args{suggests}) {
$context{suggests} = CPAN::Meta::Requirements->new;
}
if ($args{perl_minimum_version}) {
$context{perl} = CPAN::Meta::Requirements->new;
}
for my $type (qw/use no method keyword sub/) {
if (exists $args{_}{$type}) {
for my $key (keys %{$args{_}{$type}}) {
$context{$type}{$key} = [@{$args{_}{$type}{$key}}];
}
}
}
bless \%context, $class;
}
sub stash { shift->{stash} }
sub register_keyword_parser {
my ($self, $keyword, $parser_info) = @_;
$self->{keyword}{$keyword} = $parser_info;
$self->{defined_keywords}{$keyword} = 0;
}
sub remove_keyword_parser {
my ($self, $keyword) = @_;
delete $self->{keyword}{$keyword};
delete $self->{keyword} if !%{$self->{keyword}};
delete $self->{defined_keywords}{$keyword};
}
sub register_method_parser {
my ($self, $method, $parser_info) = @_;
$self->{method}{$method} = $parser_info;
}
*register_keyword = \&register_keyword_parser;
*remove_keyword = \&remove_keyword_parser;
*register_method = \&register_method_parser;
sub register_sub_parser {
my ($self, $keyword, $parser_info) = @_;
$self->{sub}{$keyword} = $parser_info;
$self->{defined_keywords}{$keyword} = 0;
}
sub requires { shift->{requires} }
sub recommends { shift->_optional('recommends') }
sub suggests { shift->_optional('suggests') }
sub noes { shift->{noes} }
sub _optional {
my ($self, $key) = @_;
my $optional = $self->{$key} or return;
# no need to recommend/suggest what are listed as requires
if (my $requires = $self->{requires}) {
my $hash = $optional->as_string_hash;
for my $module (keys %$hash) {
if (defined $requires->requirements_for_module($module) and
$requires->accepts_module($module, $hash->{$module})
) {
$optional->clear_requirement($module);
}
}
}
$optional;
}
sub add {
shift->_add('requires', @_);
}
sub add_recommendation {
shift->_add('recommends', @_);
}
sub add_suggestion {
shift->_add('suggests', @_);
}
sub add_conditional {
shift->_add('conditional', @_);
}
sub add_no {
shift->_add('noes', @_);
}
sub add_perl {
my ($self, $perl, $reason) = @_;
return unless $self->{perl};
$self->_add('perl', 'perl', $perl);
$self->{perl_minimum_version}{$reason} = $perl;
}
sub _add {
my ($self, $type, $module, $version) = @_;
return unless is_module_name($module);
my $CMR = $self->_object($type) or return;
$version = 0 unless defined $version;
if ($self->{verbose}) {
if (!defined $CMR->requirements_for_module($module)) {
print STDERR " found $module $version ($type)\n";
}
}
$CMR->add_minimum($module, "$version");
}
sub has_added {
shift->_has_added('requires', @_);
}
sub has_added_recommendation {
shift->_has_added('recommends', @_);
}
sub has_added_suggestion {
shift->_has_added('suggests', @_);
}
sub has_added_conditional {
shift->_has_added('conditional', @_);
}
sub has_added_no {
shift->_has_added('no', @_);
}
sub _has_added {
my ($self, $type, $module) = @_;
return unless is_module_name($module);
my $CMR = $self->_object($type) or return;
defined $CMR->requirements_for_module($module) ? 1 : 0;
}
sub _object {
my ($self, $key) = @_;
if ($self->{eval}) {
$key = 'suggests';
} elsif ($self->{force_cond}) {
$key = 'recommends';
} elsif ($key && $key eq 'conditional') {
if ($self->{cond}) {
$key = 'recommends';
} elsif (grep {$_->[0] eq '{' and $_->[2] ne 'BEGIN'} @{$self->{stack} || []}) {
$key = 'recommends';
} else {
$key = 'requires';
}
} elsif (!$key) {
$key = 'requires';
}
$self->{$key} or return;
}
sub has_callbacks {
my ($self, $type) = @_;
exists $self->{$type};
}
sub has_callback_for {
my ($self, $type, $name) = @_;
exists $self->{$type}{$name};
}
sub run_callback_for {
my ($self, $type, $name, @args) = @_;
return unless $self->_object;
my ($parser, $method, @cb_args) = @{$self->{$type}{$name}};
$parser->$method($self, @cb_args, @args);
}
sub prototype_re {
my $self = shift;
if (@_) {
$self->{prototype_re} = shift;
}
return $default_g_re_prototype unless exists $self->{prototype_re};
$self->{prototype_re};
}
sub quotelike_re {
my $self = shift;
return qr/qq?/ unless exists $self->{quotelike_re};
$self->{quotelike_re};
}
sub register_quotelike_keywords {
my ($self, @keywords) = @_;
push @{$self->{quotelike}}, @keywords;
$self->{defined_keywords}{$_} = 0 for @keywords;
my $trie = Regexp::Trie->new;
$trie->add($_) for 'q', 'qq', @{$self->{quotelike} || []};
$self->{quotelike_re} = $trie->regexp;
}
sub token_expects_block_list {
my ($self, $token) = @_;
return 1 if exists $default_expects_block_list{$token};
return 0 if !exists $self->{expects_block_list};
return 1 if exists $self->{expects_block_list}{$token};
return 0;
}
sub token_expects_fh_list {
my ($self, $token) = @_;
return 1 if exists $default_expects_fh_list{$token};
return 0 if !exists $self->{expects_fh_list};
return 1 if exists $self->{expects_fh_list}{$token};
return 0;
}
sub token_expects_fh_or_block_list {
my ($self, $token) = @_;
return 1 if exists $default_expects_fh_or_block_list{$token};
return 0 if !exists $self->{expects_fh_or_block_list};
return 1 if exists $self->{expects_fh_or_block_list}{$token};
return 0;
}
sub token_expects_expr_block {
my ($self, $token) = @_;
return 1 if exists $default_expects_expr_block{$token};
return 0 if !exists $self->{expects_expr_block};
return 1 if exists $self->{expects_expr_block}{$token};
return 0;
}
sub token_expects_block {
my ($self, $token) = @_;
return 1 if exists $default_expects_block{$token};
return 0 if !exists $self->{expects_block};
return 1 if exists $self->{expects_block}{$token};
return 0;
}
sub token_expects_word {
my ($self, $token) = @_;
return 1 if exists $default_expects_word{$token};
return 0 if !exists $self->{expects_word};
return 1 if exists $self->{expects_word}{$token};
return 0;
}
sub token_is_conditional {
my ($self, $token) = @_;
return 1 if exists $default_conditional_keywords{$token};
return 0 if !exists $self->{is_conditional_keyword};
return 1 if exists $self->{is_conditional_keyword}{$token};
return 0;
}
sub token_is_keyword {
my ($self, $token) = @_;
return 1 if exists $defined_keywords{$token};
return 0 if !exists $self->{defined_keywords};
return 1 if exists $self->{defined_keywords}{$token};
return 0;
}
sub token_is_op_keyword {
my ($self, $token) = @_;
return 1 if exists $default_op_keywords{$token};
return 0 if !exists $self->{defined_op_keywords};
return 1 if exists $self->{defined_op_keywords}{$token};
return 0;
}
sub check_new_keyword {
my ($self, $token) = @_;
if (exists $new_keyword_since{$token}) {
$self->add_perl($new_keyword_since{$token}, $token);
}
}
sub register_keywords {
my ($self, @keywords) = @_;
for my $keyword (@keywords) {
$self->{defined_keywords}{$keyword} = 0;
}
}
sub register_op_keywords {
my ($self, @keywords) = @_;
for my $keyword (@keywords) {
$self->{defined_op_keywords}{$keyword} = 0;
}
}
sub remove_keywords {
my ($self, @keywords) = @_;
for my $keyword (@keywords) {
delete $self->{defined_keywords}{$keyword} if exists $self->{defined_keywords}{$keyword} and !$self->{defined_keywords}{$keyword};
}
}
sub register_sub_keywords {
my ($self, @keywords) = @_;
for my $keyword (@keywords) {
$self->{defines_sub}{$keyword} = 1;
$self->{expects_block}{$keyword} = 1;
$self->{expects_word}{$keyword} = 1;
$self->{defined_keywords}{$keyword} = 0;
}
}
sub token_defines_sub {
my ($self, $token) = @_;
return 1 if $token eq 'sub';
return 0 if !exists $self->{defines_sub};
return 1 if exists $self->{defines_sub}{$token};
return 0;
}
sub enables_utf8 {
my ($self, $module) = @_;
exists $enables_utf8{$module} ? 1 : 0;
}
sub add_package {
my ($self, $package) = @_;
$self->{packages}{$package} = 1;
}
sub packages {
my $self = shift;
keys %{$self->{packages} || {}};
}
sub remove_inner_packages_from_requirements {
my $self = shift;
for my $package ($self->packages) {
for my $rel (qw/requires recommends suggests noes/) {
next unless $self->{$rel};
$self->{$rel}->clear_requirement($package);
}
}
}
sub merge_perl {
my $self = shift;
return unless $self->{perl};
my $perl = $self->{requires}->requirements_for_module('perl');
if ($self->{perl}->accepts_module('perl', $perl)) {
delete $self->{perl_minimum_version};
} else {
$self->add(perl => $self->{perl}->requirements_for_module('perl'));
}
}
sub _keywords {(
'__FILE__' => 1,
'__LINE__' => 2,
'__PACKAGE__' => 3,
'__DATA__' => 4,
'__END__' => 5,
'__SUB__' => 6,
AUTOLOAD => 7,
BEGIN => 8,
UNITCHECK => 9,
DESTROY => 10,
END => 11,
INIT => 12,
CHECK => 13,
abs => 14,
accept => 15,
alarm => 16,
and => 17,
atan2 => 18,
bind => 19,
binmode => 20,
bless => 21,
break => 22,
caller => 23,
chdir => 24,
chmod => 25,
chomp => 26,
chop => 27,
chown => 28,
chr => 29,
chroot => 30,
close => 31,
closedir => 32,
cmp => 33,
connect => 34,
continue => 35,
cos => 36,
crypt => 37,
dbmclose => 38,
dbmopen => 39,
default => 40,
defined => 41,
delete => 42,
die => 43,
do => 44,
dump => 45,
each => 46,
else => 47,
elsif => 48,
endgrent => 49,
endhostent => 50,
endnetent => 51,
endprotoent => 52,
endpwent => 53,
endservent => 54,
eof => 55,
eq => 56,
eval => 57,
evalbytes => 58,
exec => 59,
exists => 60,
exit => 61,
exp => 62,
fc => 63,
fcntl => 64,
fileno => 65,
flock => 66,
for => 67,
foreach => 68,
fork => 69,
format => 70,
formline => 71,
ge => 72,
getc => 73,
getgrent => 74,
getgrgid => 75,
getgrnam => 76,
gethostbyaddr => 77,
gethostbyname => 78,
gethostent => 79,
getlogin => 80,
getnetbyaddr => 81,
getnetbyname => 82,
getnetent => 83,
getpeername => 84,
getpgrp => 85,
getppid => 86,
getpriority => 87,
getprotobyname => 88,
getprotobynumber => 89,
getprotoent => 90,
getpwent => 91,
getpwnam => 92,
getpwuid => 93,
getservbyname => 94,
getservbyport => 95,
getservent => 96,
getsockname => 97,
getsockopt => 98,
given => 99,
glob => 100,
gmtime => 101,
goto => 102,
grep => 103,
gt => 104,
hex => 105,
if => 106,
index => 107,
int => 108,
ioctl => 109,
join => 110,
keys => 111,
kill => 112,
last => 113,
lc => 114,
lcfirst => 115,
le => 116,
length => 117,
link => 118,
listen => 119,
local => 120,
localtime => 121,
lock => 122,
log => 123,
lstat => 124,
lt => 125,
m => 126,
map => 127,
mkdir => 128,
msgctl => 129,
msgget => 130,
msgrcv => 131,
msgsnd => 132,
my => 133,
ne => 134,
next => 135,
no => 136,
not => 137,
oct => 138,
open => 139,
opendir => 140,
or => 141,
ord => 142,
our => 143,
pack => 144,
package => 145,
pipe => 146,
pop => 147,
pos => 148,
print => 149,
printf => 150,
prototype => 151,
push => 152,
q => 153,
qq => 154,
qr => 155,
quotemeta => 156,
qw => 157,
qx => 158,
rand => 159,
read => 160,
readdir => 161,
readline => 162,
readlink => 163,
readpipe => 164,
recv => 165,
redo => 166,
ref => 167,
rename => 168,
require => 169,
reset => 170,
return => 171,
reverse => 172,
rewinddir => 173,
rindex => 174,
rmdir => 175,
s => 176,
say => 177,
scalar => 178,
seek => 179,
seekdir => 180,
select => 181,
semctl => 182,
semget => 183,
semop => 184,
send => 185,
setgrent => 186,
sethostent => 187,
setnetent => 188,
setpgrp => 189,
setpriority => 190,
setprotoent => 191,
setpwent => 192,
setservent => 193,
setsockopt => 194,
shift => 195,
shmctl => 196,
shmget => 197,
shmread => 198,
shmwrite => 199,
shutdown => 200,
sin => 201,
sleep => 202,
socket => 203,
socketpair => 204,
sort => 205,
splice => 206,
split => 207,
sprintf => 208,
sqrt => 209,
srand => 210,
stat => 211,
state => 212,
study => 213,
sub => 214,
substr => 215,
symlink => 216,
syscall => 217,
sysopen => 218,
sysread => 219,
sysseek => 220,
system => 221,
syswrite => 222,
tell => 223,
telldir => 224,
tie => 225,
tied => 226,
time => 227,
times => 228,
tr => 229,
truncate => 230,
uc => 231,
ucfirst => 232,
umask => 233,
undef => 234,
unless => 235,
unlink => 236,
unpack => 237,
unshift => 238,
untie => 239,
until => 240,
use => 241,
utime => 242,
values => 243,
vec => 244,
wait => 245,
waitpid => 246,
wantarray => 247,
warn => 248,
when => 249,
while => 250,
write => 251,
x => 252,
xor => 253,
y => 254 || 255,
)}
1;
__END__
=encoding utf-8
=head1 NAME
Perl::PrereqScanner::NotQuiteLite::Context
=head1 DESCRIPTION
This is typically used to keep callbacks, an eval state, and
found prerequisites for a processing file.
=head1 METHODS
=head2 add
$c->add($module);
$c->add($module => $minimum_version);
adds a module with/without a minimum version as a requirement
or a suggestion, depending on the eval state. You can add a module
with different versions as many times as you wish. The actual
minimum version for the module is calculated inside
(by L<CPAN::Meta::Requirements>).
=head2 register_keyword_parser, remove_keyword_parser, register_method_parser, register_sub_parser
$c->register_keyword_parser(
'func_name',
[$parser_class, 'parser_for_the_func', $used_module],
);
$c->remove_keyword_parser('func_name');
$c->register_method_parser(
'method_name',
[$parser_class, 'parser_for_the_method', $used_module],
);
If you find a module that can export a loader function is actually
C<use>d (such as L<Moose> that can export an C<extends> function
that will load a module internally), you might also register the
loader function as a custom keyword dynamically so that the scanner
can also run a callback for the function to parse its argument
tokens.
You can also remove the keyword when you find the module is C<no>ed
(and when the module supports C<unimport>).
You can also register a method callback on the fly (but you can't
remove it).
If you always want to check some functions/methods when you load a
plugin, just register them using a C<register> method in the plugin.
=head2 requires
returns a CPAN::Meta::Requirements object for requirements.
=head2 suggests
returns a CPAN::Meta::Requirements object for suggestions
(requirements in C<eval>s), or undef when it is not expected to
parse tokens in C<eval>.
=head1 METHODS MOSTLY FOR INTERNAL USE
=head2 new
creates an instance. You usually don't need to call this because
it's automatically created in the scanner.
=head2 has_callbacks, has_callback_for, run_callback_for
next unless $c->has_callbacks('use');
next unless $c->has_callbacks_for('use', 'base');
$c->run_callbacks_for('use', 'base', $tokens);
C<has_callbacks> returns true if a callback for C<use>, C<no>,
C<keyword>, or C<method> is registered. C<has_callbacks_for>
returns true if a callback for the module/keyword/method is
registered. C<run_callbacks_for> is to run the callback.
=head2 has_added
returns true if a module has already been added as a requirement
or a suggestion. Only useful for the ::UniversalVersion plugin.
=head1 AUTHOR
Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015 by Kenichi Ishigaki.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

57
database/perl/lib/Perl/PrereqScanner/NotQuiteLite/Parser/Aliased.pm Normal file
View File

@@ -0,0 +1,57 @@
package Perl::PrereqScanner::NotQuiteLite::Parser::Aliased;
use strict;
use warnings;
use Perl::PrereqScanner::NotQuiteLite::Util;
sub register { return {
use => {
aliased => 'parse_aliased_args',
},
}}
sub parse_aliased_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $tokens = convert_string_tokens($raw_tokens);
if (is_version($tokens->[0])) {
$c->add($used_module => shift @$tokens);
}
my $module = $tokens->[0];
if (ref $module) {
$module = $module->[0];
}
if (is_module_name($module)) {
$c->add($module => 0);
}
# TODO: support alias keyword?
}
1;
__END__
=encoding utf-8
=head1 NAME
Perl::PrereqScanner::NotQuiteLite::Parser::Aliased
=head1 DESCRIPTION
This parser is to deal with a module loaded (aliased) by L<aliased>.
=head1 AUTHOR
Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015 by Kenichi Ishigaki.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

133
database/perl/lib/Perl/PrereqScanner/NotQuiteLite/Parser/AnyMoose.pm Normal file
View File

@@ -0,0 +1,133 @@
package Perl::PrereqScanner::NotQuiteLite::Parser::AnyMoose;
use strict;
use warnings;
use Perl::PrereqScanner::NotQuiteLite::Util;
sub register {{
use => {
'Any::Moose' => 'parse_any_moose_args',
},
no => {
'Any::Moose' => 'remove_extends_and_with',
},
}}
sub parse_any_moose_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $tokens = convert_string_tokens($raw_tokens);
if (is_version($tokens->[0])) {
$c->add($used_module => shift @$tokens);
}
while(my $token = shift @$tokens) {
next if ref $token;
# As Any::Moose falls back to Mouse, it's nice to have
# a Mouse variant, but that should not be required.
my $module = "Mouse$token";
$c->add_recommendation($module => 0) if is_module_name($module);
}
$c->register_keyword_parser(
'extends',
[$class, 'parse_extends_args', $used_module],
);
$c->register_keyword_parser(
'with',
[$class, 'parse_with_args', $used_module],
);
}
sub remove_extends_and_with {
my ($class, $c, $used_module, $raw_tokens) = @_;
$c->remove_keyword('extends');
$c->remove_keyword('with');
}
sub parse_extends_args { shift->_parse_loader_args(@_) }
sub parse_with_args { shift->_parse_loader_args(@_) }
sub _parse_loader_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $tokens = convert_string_tokens($raw_tokens);
shift @$tokens; # discard extends, with;
my $prev;
my $saw_any_moose;
while(my $token = shift @$tokens) {
if (!ref $token) {
if ($saw_any_moose) {
my $module = "Mouse$token";
$c->add_recommendation($module => 0);
$prev = $module;
} else {
$c->add($token => 0);
$prev = $token;
}
next;
}
if ($token->[0] eq 'any_moose') {
$saw_any_moose = 1;
next;
}
my $desc = $token->[1] || '';
if ($desc eq '{}') {
my @hash_tokens = @{$token->[0] || []};
for(my $i = 0, my $len = @hash_tokens; $i < $len; $i++) {
if ($hash_tokens[$i][0] eq '-version' and $i < $len - 2) {
my $maybe_version_token = $hash_tokens[$i + 2];
my $maybe_version = $maybe_version_token->[0];
if (ref $maybe_version) {
$maybe_version = $maybe_version->[0];
}
if ($prev and is_version($maybe_version)) {
if ($saw_any_moose) {
$c->add_recommendation($prev => $maybe_version);
} else {
$c->add($prev => $maybe_version);
}
}
}
}
}
if ($saw_any_moose and $desc eq '()') {
my $tokens_in_parentheses = convert_string_tokens($token->[0]);
for my $token_in_parentheses (@$tokens_in_parentheses) {
next if ref $token_in_parentheses;
my $module = "Mouse$token_in_parentheses";
$c->add_recommendation($module => 0) if is_module_name($module);
}
}
}
}
1;
__END__
=encoding utf-8
=head1 NAME
Perl::PrereqScanner::NotQuiteLite::Parser::AnyMoose
=head1 DESCRIPTION
This parser is to deal with modules loaded by C<extends>
from L<Any::Moose> and its friends.
=head1 AUTHOR
Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017 by Kenichi Ishigaki.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

54
database/perl/lib/Perl/PrereqScanner/NotQuiteLite/Parser/Autouse.pm Normal file
View File

@@ -0,0 +1,54 @@
package Perl::PrereqScanner::NotQuiteLite::Parser::Autouse;
use strict;
use warnings;
use Perl::PrereqScanner::NotQuiteLite::Util;
sub register { return {
use => {
'autouse' => 'parse_autouse_args',
},
}}
sub parse_autouse_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $tokens = convert_string_tokens($raw_tokens);
if (is_version($tokens->[0])) {
$c->add($used_module => shift @$tokens);
}
my $module = $tokens->[0];
if (ref $module) {
$module = $module->[0];
}
if (is_module_name($module)) {
$c->add_recommendation($module => 0);
}
}
1;
__END__
=encoding utf-8
=head1 NAME
Perl::PrereqScanner::NotQuiteLite::Parser::Autouse
=head1 DESCRIPTION
This parser is to deal with lazy module loading by C<autouse>.
=head1 AUTHOR
Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017 by Kenichi Ishigaki.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

67
database/perl/lib/Perl/PrereqScanner/NotQuiteLite/Parser/Catalyst.pm Normal file
View File

@@ -0,0 +1,67 @@
package Perl::PrereqScanner::NotQuiteLite::Parser::Catalyst;
use strict;
use warnings;
use Perl::PrereqScanner::NotQuiteLite::Util;
sub register { return {
use => {
Catalyst => 'parse_catalyst_args',
},
}}
sub parse_catalyst_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my @copied_tokens = @$raw_tokens;
if (($copied_tokens[0][1] || '') eq '()') {
my $token = shift @copied_tokens;
unshift @copied_tokens, @{$token->[0]};
}
if (is_version($copied_tokens[0])) {
$c->add($used_module => shift @copied_tokens);
}
my @plugins;
for my $token (@copied_tokens) {
my $desc = $token->[1] or next;
if ($desc eq 'STRING') {
push @plugins, $token->[0][0];
} elsif ($desc eq 'QUOTED_WORD_LIST') {
push @plugins, split /\s/, $token->[0][0];
}
}
for my $plugin (@plugins) {
next if $plugin =~ /^\-/;
$plugin = "Catalyst::Plugin::$plugin" unless $plugin =~ s/^\+//;
$c->add($plugin => 0) if is_module_name($plugin);
}
}
1;
__END__
=encoding utf-8
=head1 NAME
Perl::PrereqScanner::NotQuiteLite::Parser::Catalyst
=head1 DESCRIPTION
This parser is to deal with module inheritance by C<Catalyst>.
=head1 AUTHOR
Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017 by Kenichi Ishigaki.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

92
database/perl/lib/Perl/PrereqScanner/NotQuiteLite/Parser/ClassAccessor.pm Normal file
View File

@@ -0,0 +1,92 @@
package Perl::PrereqScanner::NotQuiteLite::Parser::ClassAccessor;
use strict;
use warnings;
use Perl::PrereqScanner::NotQuiteLite::Util;
sub register {{
use => {
'Class::Accessor' => 'parse_class_accessor_args',
'Class::Accessor::Fast' => 'parse_class_accessor_args',
'Class::Accessor::Faster' => 'parse_class_accessor_args',
'Class::XSAccessor::Compat' => 'parse_class_accessor_args',
}
}}
sub parse_class_accessor_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $tokens = convert_string_tokens($raw_tokens);
if (is_version($tokens->[0])) {
$c->add($used_module => shift @$tokens);
}
while(my $token = shift @$tokens) {
if ($token =~ /^(?:antlers|moose-?like)$/i) {
$c->register_keyword_parser(
'extends',
[$class, 'parse_extends_args', $used_module],
);
last;
}
}
}
sub parse_extends_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $tokens = convert_string_tokens($raw_tokens);
shift @$tokens; # discard extends, with;
my $prev;
for my $token (@$tokens) {
if (!ref $token) {
$c->add($token => 0);
$prev = $token;
next;
}
my $desc = $token->[1] || '';
if ($desc eq '{}') {
my @hash_tokens = @{$token->[0] || []};
for(my $i = 0, my $len = @hash_tokens; $i < $len; $i++) {
if ($hash_tokens[$i][0] eq '-version' and $i < $len - 2) {
my $maybe_version_token = $hash_tokens[$i + 2];
my $maybe_version = $maybe_version_token->[0];
if (ref $maybe_version) {
$maybe_version = $maybe_version->[0];
}
if ($prev and is_version($maybe_version)) {
$c->add($prev => $maybe_version);
}
}
}
}
}
}
1;
__END__
=encoding utf-8
=head1 NAME
Perl::PrereqScanner::NotQuiteLite::Parser::ClassAccessor
=head1 DESCRIPTION
This parser is to deal with modules loaded by C<extends>
from L<Class::Accessor> and its friends.
=head1 AUTHOR
Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017 by Kenichi Ishigaki.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

76
database/perl/lib/Perl/PrereqScanner/NotQuiteLite/Parser/ClassAutouse.pm Normal file
View File

@@ -0,0 +1,76 @@
package Perl::PrereqScanner::NotQuiteLite::Parser::ClassAutouse;
use strict;
use warnings;
use Perl::PrereqScanner::NotQuiteLite::Util;
sub register { return {
use => {
'Class::Autouse' => 'parse_class_autouse_args',
},
}}
sub parse_class_autouse_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $tokens = convert_string_tokens($raw_tokens);
if (is_version($tokens->[0])) {
$c->add($used_module => shift @$tokens);
}
while(my $token = shift @$tokens) {
my $module = $token;
if (ref $module) {
$module = $module->[0];
}
if (is_module_name($module)) {
$c->add_recommendation($module => 0);
}
}
$c->register_method_parser(
'autouse',
[$class, 'parse_autouse_method_args', $used_module],
);
}
sub parse_autouse_method_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $tokens = convert_string_tokens($raw_tokens);
# Check class
my ($klass, $arrow, $method, @args) = @$tokens;
return unless $klass and ref $klass and $klass->[0] eq $used_module;
return unless $method and ref $method and $method->[0] eq 'autouse';
for my $arg (@args) {
next if ref $arg;
$c->add_recommendation($arg => 0);
}
}
1;
__END__
=encoding utf-8
=head1 NAME
Perl::PrereqScanner::NotQuiteLite::Parser::ClassAutouse
=head1 DESCRIPTION
This parser is to deal with modules loaded dynamically by
C<Class::Autouse>.
=head1 AUTHOR
Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017 by Kenichi Ishigaki.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

146
database/perl/lib/Perl/PrereqScanner/NotQuiteLite/Parser/ClassLoad.pm Normal file
View File

@@ -0,0 +1,146 @@
package Perl::PrereqScanner::NotQuiteLite::Parser::ClassLoad;
use strict;
use warnings;
use Perl::PrereqScanner::NotQuiteLite::Util;
my %known_functions = map {$_ => 1} qw/
load_class try_load_class load_optional_class
load_first_existing_class
/;
sub register { return {
use => {
'Class::Load' => 'parse_class_load_args',
},
}}
sub register_fqfn { return {
map { "Class::Load::".$_ => "parse_".$_."_args" }
keys %known_functions
}}
sub parse_class_load_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $tokens = convert_string_tokens($raw_tokens);
if (is_version($tokens->[0])) {
$c->add($used_module => shift @$tokens);
}
for my $token (@$tokens) {
next if ref $token;
if ($known_functions{$token}) {
$c->register_keyword_parser(
$token,
[$class, 'parse_'.$token.'_args', $used_module],
);
} elsif ($token eq ':all') {
for my $func (keys %known_functions) {
$c->register_keyword_parser(
$func,
[$class, 'parse_'.$func.'_args', $used_module],
);
}
}
}
}
sub parse_load_class_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $tokens = convert_string_tokens($raw_tokens);
shift @$tokens; # function
my ($module, undef, $options) = @$tokens;
my $version = 0;
if (ref $options and $options->[1] eq '{}') {
my $tokens_in_hashref = convert_string_tokens($options->[0]);
while(my ($key, undef, $value, undef) = splice @$tokens_in_hashref, 0, 4) {
if (ref $key and $key->[0] eq '-version' and is_version($value)) {
$version = $value;
}
}
}
$c->add_conditional($module => $version);
}
sub parse_try_load_class_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $tokens = convert_string_tokens($raw_tokens);
shift @$tokens; # function
my ($module, undef, $options) = @$tokens;
my $version = 0;
if (ref $options and $options->[1] eq '{}') {
my $tokens_in_hashref = convert_string_tokens($options->[0]);
while(my ($key, undef, $value, undef) = splice @$tokens_in_hashref, 0, 4) {
if (ref $key and $key->[0] eq '-version' and is_version($value)) {
$version = $value;
}
}
}
$c->add_suggestion($module => $version);
}
sub parse_load_optional_class_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
$class->parse_try_load_class_args($c, $used_module, $raw_tokens);
}
sub parse_load_first_existing_class_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $tokens = convert_string_tokens($raw_tokens);
shift @$tokens; # function
my ($module, $version);
for my $token (@$tokens) {
if (is_module_name($token)) {
if ($module) {
$c->add_suggestion($module => $version);
}
$module = $token;
$version = 0;
next;
}
if (ref $token and ($token->[1] || '') eq '{}') {
my $tokens_in_hashref = convert_string_tokens($token->[0]);
while(my ($key, undef, $value, undef) = splice @$tokens_in_hashref, 0, 4) {
if (ref $key and $key->[0] eq '-version' and is_version($value)) {
$version = $value;
}
}
}
}
if ($module) {
$c->add_suggestion($module => $version);
}
}
1;
__END__
=encoding utf-8
=head1 NAME
Perl::PrereqScanner::NotQuiteLite::Parser::ClassLoad
=head1 DESCRIPTION
This parser is to deal with module loading by C<Class::Load>.
=head1 AUTHOR
Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017 by Kenichi Ishigaki.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

198
database/perl/lib/Perl/PrereqScanner/NotQuiteLite/Parser/Core.pm Normal file
View File

@@ -0,0 +1,198 @@
package Perl::PrereqScanner::NotQuiteLite::Parser::Core;
use strict;
use warnings;
use Perl::PrereqScanner::NotQuiteLite::Util;
my %feature_since = (
say => '5.010',
state => '5.010',
switch => '5.010',
unicode_strings => '5.012',
current_sub => '5.016',
evalbytes => '5.016',
fc => '5.016',
arybase => '5.016',
unicode_eval => '5.016',
lexical_subs => '5.018',
postderef => '5.020',
postderef_qq => '5.020',
signatures => '5.020',
bitwise => '5.022',
refaliasing => '5.022',
declared_refs => '5.026',
);
sub register { return {
use => {
if => 'parse_if_args',
base => 'parse_base_args',
parent => 'parse_parent_args',
feature => 'parse_feature_args',
},
keyword => {
package => 'parse_package',
exit => 'parse_begin_exit',
},
}}
sub parse_if_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
while(my $token = shift @$raw_tokens) {
last if $token->[1] eq 'COMMA';
}
my $tokens = convert_string_tokens($raw_tokens);
my $module = shift @$tokens;
if (ref $module and ($module->[1] eq 'WORD' or $module->[1] eq 'KEYWORD')) {
$module = $module->[0];
}
if (is_module_name($module)) {
if (is_version($tokens->[0])) {
my $version = shift @$tokens;
$c->add_recommendation($module => $version);
} else {
$c->add_recommendation($module => 0);
}
} else {
push @{$c->{errors}}, "use if module not found";
}
}
sub parse_base_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $tokens = convert_string_tokens($raw_tokens);
if (is_version($tokens->[0])) {
$c->add($used_module => shift @$tokens);
}
while(my $token = shift @$tokens) {
my $module = $token;
if (ref $module and ($module->[1] || '') eq 'WORD') {
# allow bareword, but disallow function()
$module = $module->[0];
next if @$tokens and ref $tokens->[0] and ($tokens->[0][1] || '') eq '()';
}
# bareword in parentheses
if (ref $module and ref $module->[0]) {
$module = $module->[0][0];
}
if (is_module_name($module)) {
$c->add($module => 0);
}
}
}
sub parse_parent_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $tokens = convert_string_tokens($raw_tokens);
if (is_version($tokens->[0])) {
$c->add($used_module => shift @$tokens);
}
while(my $token = shift @$tokens) {
last if $token eq '-norequire';
my $module = $token;
if (ref $token) {
last if $token->[0] eq '-norequire';
}
if (ref $module and ($module->[1] || '') eq 'WORD') {
# allow bareword, but disallow function()
$module = $module->[0];
next if @$tokens and ref $tokens->[0] and ($tokens->[0][1] || '') eq '()';
}
# bareword in parentheses
if (ref $module and ref $module->[0]) {
$module = $module->[0][0];
}
$c->add($module => 0) if is_module_name($module);
}
}
sub parse_feature_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
$c->add_perl('5.010', 'feature');
my $tokens = convert_string_tokens($raw_tokens);
if (is_version($tokens->[0])) {
$c->add($used_module => shift @$tokens);
}
while(my $token = shift @$tokens) {
next if ref $token;
if (exists $feature_since{$token}) {
$c->add_perl($feature_since{$token} => "feature $token");
next;
}
if ($token =~ /^:5\.([0-9]+)(\.\[0-9]+)?/) {
my $version = sprintf '5.%03d', $1;
$c->add_perl($version, $token);
next;
}
}
}
sub parse_begin_exit {
my ($class, $c, $raw_tokens) = @_;
my @stack = @{$c->{stack} || []};
if (grep {$_->[0] eq '{' and $_->[2] eq 'BEGIN'} @stack) {
if (grep {$c->token_is_conditional($_->[0])} @$raw_tokens) {
$c->{force_cond} = 1;
} elsif (grep {$_->[0] eq '{' and $c->token_is_conditional($_->[2])} @stack) {
$c->{force_cond} = 1;
} else {
$c->{ended} = 1;
@{$c->{stack}} = ();
}
}
}
sub parse_package {
my ($class, $c, $raw_tokens) = @_;
my $tokens = convert_string_tokens($raw_tokens);
shift @$tokens; # drop "package"
my $token = shift @$tokens;
if (ref $token && $token->[1] && $token->[1] eq 'WORD') {
$c->add_package($token->[0]);
}
if (@$tokens) {
$token = shift @$tokens;
if (is_version($token)) {
$c->add_perl("5.012", "package PACKAGE VERSION");
$token = shift @$tokens;
}
if (ref $token && $token->[1] && $token->[1] =~ /^\{/) {
$c->add_perl("5.014", "package PACKAGE (VERSION) {}");
}
}
}
1;
__END__
=encoding utf-8
=head1 NAME
Perl::PrereqScanner::NotQuiteLite::Parser::Core
=head1 DESCRIPTION
This parser is to deal with module inheritance by C<base> and
C<parent> modules, and conditional loading by C<if> module.
=head1 AUTHOR
Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015 by Kenichi Ishigaki.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

61
database/perl/lib/Perl/PrereqScanner/NotQuiteLite/Parser/Inline.pm Normal file
View File

@@ -0,0 +1,61 @@
package Perl::PrereqScanner::NotQuiteLite::Parser::Inline;
use strict;
use warnings;
use Perl::PrereqScanner::NotQuiteLite::Util;
sub register { return {
use => {
Inline => 'parse_inline_args',
},
}}
sub parse_inline_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $tokens = convert_string_tokens($raw_tokens);
if (is_version($tokens->[0])) {
$c->add($used_module => shift @$tokens);
}
if (ref $tokens->[0] and is_module_name($tokens->[0][0])) {
my $module = (shift @$tokens)->[0];
if ($module eq 'with') {
$module = $tokens->[1];
if (is_module_name($module)) {
$c->add($module => 0);
}
} elsif ($module eq 'Config') {
# Configuration only
} else {
$c->add("Inline::".$module => 0);
}
}
}
1;
__END__
=encoding utf-8
=head1 NAME
Perl::PrereqScanner::NotQuiteLite::Parser::Inline
=head1 DESCRIPTION
This parser is to deal with a module loaded by L<Inline>.
=head1 AUTHOR
Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017 by Kenichi Ishigaki.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

77
database/perl/lib/Perl/PrereqScanner/NotQuiteLite/Parser/KeywordDeclare.pm Normal file
View File

@@ -0,0 +1,77 @@
package Perl::PrereqScanner::NotQuiteLite::Parser::KeywordDeclare;
use strict;
use warnings;
use Perl::PrereqScanner::NotQuiteLite::Util;
sub register { return {
use => {
'Keyword::Declare' => 'parse_keyword_declare_args',
},
}}
sub parse_keyword_declare_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
$c->register_sub_keywords(qw/keyword/);
$c->register_keywords(qw/keytype is unkeyword/);
$c->register_op_keywords(qw/is/);
$c->register_sub_parser(
'keyword',
[$class, 'parse_keyword_args', $used_module],
);
$c->register_keyword_parser(
'unkeyword',
[$class, 'parse_unkeyword_args', $used_module],
);
}
sub parse_keyword_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $tokens = convert_string_tokens($raw_tokens);
shift @$tokens; # discard keyword
if (ref $tokens->[0] and $tokens->[0][1]) {
$c->register_keywords($tokens->[0][1]);
}
}
sub parse_unkeyword_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $tokens = convert_string_tokens($raw_tokens);
shift @$tokens; # discard unkeyword
if (ref $tokens->[0] and $tokens->[0][1]) {
$c->remove_keywords($tokens->[0][0]);
}
}
1;
__END__
=encoding utf-8
=head1 NAME
Perl::PrereqScanner::NotQuiteLite::Parser::KeywordDeclare
=head1 DESCRIPTION
This parser is to deal with keywords imported from L<Keyword::Declare>.
=head1 AUTHOR
Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2018 by Kenichi Ishigaki.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

54
database/perl/lib/Perl/PrereqScanner/NotQuiteLite/Parser/Later.pm Normal file
View File

@@ -0,0 +1,54 @@
package Perl::PrereqScanner::NotQuiteLite::Parser::Later;
use strict;
use warnings;
use Perl::PrereqScanner::NotQuiteLite::Util;
sub register { return {
use => {
'later' => 'parse_later_args',
},
}}
sub parse_later_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $tokens = convert_string_tokens($raw_tokens);
if (is_version($tokens->[0])) {
$c->add($used_module => shift @$tokens);
}
my $module = $tokens->[0];
if (ref $module) {
$module = $module->[0];
}
if (is_module_name($module)) {
$c->add_recommendation($module => 0);
}
}
1;
__END__
=encoding utf-8
=head1 NAME
Perl::PrereqScanner::NotQuiteLite::Parser::Later
=head1 DESCRIPTION
This parser is to deal with lazy module loading by C<later>.
=head1 AUTHOR
Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017 by Kenichi Ishigaki.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

48
database/perl/lib/Perl/PrereqScanner/NotQuiteLite/Parser/Mixin.pm Normal file
View File

@@ -0,0 +1,48 @@
package Perl::PrereqScanner::NotQuiteLite::Parser::Mixin;
use strict;
use warnings;
use Perl::PrereqScanner::NotQuiteLite::Util;
sub register { return {
use => {
mixin => 'parse_mixin_args',
},
}}
sub parse_mixin_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $tokens = convert_string_tokens($raw_tokens);
if (is_version($tokens->[0])) {
$c->add($used_module => shift @$tokens);
}
$c->add($_ => 0) for grep {!ref $_} @$tokens;
}
1;
__END__
=encoding utf-8
=head1 NAME
Perl::PrereqScanner::NotQuiteLite::Parser::Mixin
=head1 DESCRIPTION
This parser is to deal with module loading by C<mixin> module.
=head1 AUTHOR
Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017 by Kenichi Ishigaki.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

97
database/perl/lib/Perl/PrereqScanner/NotQuiteLite/Parser/ModuleRuntime.pm Normal file
View File

@@ -0,0 +1,97 @@
package Perl::PrereqScanner::NotQuiteLite::Parser::ModuleRuntime;
use strict;
use warnings;
use Perl::PrereqScanner::NotQuiteLite::Util;
my %known_functions = map {$_ => 1} qw/
require_module use_module use_package_optimistically
/;
sub register { return {
use => {
'Module::Runtime' => 'parse_module_runtime_args',
},
}}
sub register_fqfn { return {
map { "Module::Runtime::".$_ => "parse_".$_."_args" }
keys %known_functions
}}
sub parse_module_runtime_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $tokens = convert_string_tokens($raw_tokens);
if (is_version($tokens->[0])) {
$c->add($used_module => shift @$tokens);
}
for my $token (@$tokens) {
next if ref $token;
if ($known_functions{$token}) {
$c->register_keyword_parser(
$token,
[$class, 'parse_'.$token.'_args', $used_module],
);
}
}
}
sub parse_require_module_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $tokens = convert_string_tokens($raw_tokens);
shift @$tokens; # function
my $module = shift @$tokens;
return unless is_module_name($module);
$c->add_conditional($module => 0);
}
sub parse_use_module_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $tokens = convert_string_tokens($raw_tokens);
shift @$tokens; # function
my ($module, undef, $version) = @$tokens;
$version = 0 unless $version and is_version($version);
$c->add_conditional($module => $version);
}
sub parse_use_package_optimistically_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $tokens = convert_string_tokens($raw_tokens);
shift @$tokens; # function
my ($module, undef, $version) = @$tokens;
$version = 0 unless $version and is_version($version);
$c->add_conditional($module => $version);
}
1;
__END__
=encoding utf-8
=head1 NAME
Perl::PrereqScanner::NotQuiteLite::Parser::ModuleRuntime
=head1 DESCRIPTION
This parser is to deal with module loading by C<Module::Runtime>.
=head1 AUTHOR
Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017 by Kenichi Ishigaki.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

65
database/perl/lib/Perl/PrereqScanner/NotQuiteLite/Parser/MojoBase.pm Normal file
View File

@@ -0,0 +1,65 @@
package Perl::PrereqScanner::NotQuiteLite::Parser::MojoBase;
use strict;
use warnings;
use Perl::PrereqScanner::NotQuiteLite::Util;
my @MojoBaseLike = qw/
Mojo::Base
Mojo::Weixin::Base Mojo::Webqq::Base
Kelp::Base Rethinkdb::Base PMLTQ::Base
/;
sub register {
my ($class, %args) = @_;
my %mojo_base_like = map {$_ => 1} (@MojoBaseLike, @{$args{mojo_base_like} || []});
my %mapping;
for my $module (keys %mojo_base_like) {
$mapping{use}{$module} = 'parse_mojo_base_args';
}
return \%mapping;
}
sub parse_mojo_base_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $tokens = convert_string_tokens($raw_tokens);
if (is_version($tokens->[0])) {
$c->add($used_module => shift @$tokens);
}
my $module = $tokens->[0];
if (ref $module) {
$module = $module->[0];
}
if (is_module_name($module)) {
$module =~ s|'|::|g;
$c->add($module => 0);
}
}
1;
__END__
=encoding utf-8
=head1 NAME
Perl::PrereqScanner::NotQuiteLite::Parser::MojoBase
=head1 DESCRIPTION
This parser is to deal with module inheritance by C<Mojo::Base>.
=head1 AUTHOR
Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017 by Kenichi Ishigaki.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

200
database/perl/lib/Perl/PrereqScanner/NotQuiteLite/Parser/Moose.pm Normal file
View File

@@ -0,0 +1,200 @@
package Perl::PrereqScanner::NotQuiteLite::Parser::Moose;
use strict;
use warnings;
use Perl::PrereqScanner::NotQuiteLite::Util;
# There are so many Moose-like variants
# Like Moose; modules that are not listed here but have Moose
# in their name are implicitly treated like these as well
my @ExportsExtendsAndWith = qw/
Moose Moo Mouse MooX Moo::Lax Moos
MooseX::App MooseX::Singleton MooseX::SingletonMethod
HTML::FormHandler::Moose Test::Class::Moose
App::GHPT::Wrapper::OurMoose App::wmiirc::Plugin Ark
Bot::Backbone::Service Bubblegum::Class CatalystX::Declare
Cogwheel CPAN::Testers::Backend::Base Dancer2::Plugin
Data::Object::Class DBICx::Modeler::Model Digital::Driver
Elastic::Doc Fey::ORM::Table Form::Factory::Processor
Jedi::App Momo Moonshine::Magic Moxie Nile::Base
Parse::FixedRecord Pcore Reaction::Class Reaction::UI::WidgetClass
Squirrel Statocles::Base TAEB::OO Test::Able Test::Roo
Web::Simple XML::Rabbit
/;
# Like Moose::Role; modules that are not listed here but have Role
# in their name are implicitly treated like these as well
my @ExportsWith = qw/
Moose::Role Moo::Role Mouse::Role
MooseX::Role::Parameterized
Mason::PluginRole Mojo::RoleTiny MooX::Cmd
Role::Basic Role::Tiny Role::Tiny::With Reflex::Role
Template::Caribou Test::Routine App::SimulateReads::Base
/;
# Like Mo
my @ExportsExtends = qw/
Mo
Lingy::Base OptArgs2::Mo Parse::SAMGov::Mo Pegex::Base
Sub::Mage TestML::Base Type::Utils VSO
/;
sub register {
my ($class, %args) = @_;
# Make sure everything is unique
my %exports_extends_and_with = map {$_ => 1} (@ExportsExtendsAndWith, @{$args{exports_extends_and_with} || []});
my %exports_extends = map {$_ => 1} (@ExportsExtends, @{$args{exports_extends} || []});
my %exports_with = map {$_ => 1} (@ExportsWith, @{$args{exports_with} || []});
for my $module (keys %exports_with) {
if (exists $exports_extends_and_with{$module}) {
delete $exports_with{$module};
next;
}
if (exists $exports_extends{$module}) {
$exports_extends_and_with{$module} = 1;
delete $exports_with{$module};
next;
}
}
for my $module (keys %exports_extends) {
if (exists $exports_extends_and_with{$module}) {
delete $exports_extends{$module};
next;
}
}
my %mapping;
for my $module (keys %exports_with) {
$mapping{use}{$module} = 'register_with';
$mapping{no}{$module} = 'remove_with';
}
for my $module (keys %exports_extends) {
$mapping{use}{$module} = 'register_extends';
$mapping{no}{$module} = 'remove_extends';
}
for my $module (keys %exports_extends_and_with) {
$mapping{use}{$module} = 'register_extends_and_with';
$mapping{no}{$module} = 'remove_extends_and_with';
}
return \%mapping;
}
sub register_extends_and_with {
my ($class, $c, $used_module, $raw_tokens) = @_;
$c->register_keyword_parser(
'extends',
[$class, 'parse_extends_args', $used_module],
);
$c->register_keyword_parser(
'with',
[$class, 'parse_with_args', $used_module],
);
}
sub register_with {
my ($class, $c, $used_module, $raw_tokens) = @_;
$c->register_keyword_parser(
'with',
[$class, 'parse_with_args', $used_module],
);
}
sub register_extends {
my ($class, $c, $used_module, $raw_tokens) = @_;
$c->register_keyword_parser(
'extends',
[$class, 'parse_extends_args', $used_module],
);
}
sub remove_extends_and_with {
my ($class, $c, $used_module, $raw_tokens) = @_;
$c->remove_keyword('extends');
$c->remove_keyword('with');
}
sub remove_with {
my ($class, $c, $used_module, $raw_tokens) = @_;
$c->remove_keyword('with');
}
sub remove_extends {
my ($class, $c, $used_module, $raw_tokens) = @_;
$c->remove_keyword('extends');
}
sub parse_extends_args { shift->_parse_loader_args(@_) }
sub parse_with_args { shift->_parse_loader_args(@_) }
sub _parse_loader_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $tokens = convert_string_tokens($raw_tokens);
shift @$tokens; # discard extends, with;
my $prev;
for my $token (@$tokens) {
if (!ref $token) {
$c->add($token => 0);
$prev = $token;
next;
}
my $desc = $token->[1] || '';
if ($desc eq '{}') {
my @hash_tokens = @{$token->[0] || []};
for(my $i = 0, my $len = @hash_tokens; $i < $len; $i++) {
if ($hash_tokens[$i][0] eq '-version' and $i < $len - 2) {
my $maybe_version_token = $hash_tokens[$i + 2];
my $maybe_version = $maybe_version_token->[0];
if (ref $maybe_version) {
$maybe_version = $maybe_version->[0];
}
if ($prev and is_version($maybe_version)) {
$c->add($prev => $maybe_version);
}
}
}
}
}
}
1;
__END__
=encoding utf-8
=head1 NAME
Perl::PrereqScanner::NotQuiteLite::Parser::Moose
=head1 DESCRIPTION
This parser is to deal with modules loaded by C<extends> and/or
C<with> from L<Moose> and its friends.
=head1 AUTHOR
Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015 by Kenichi Ishigaki.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

189
database/perl/lib/Perl/PrereqScanner/NotQuiteLite/Parser/MooseXDeclare.pm Normal file
View File

@@ -0,0 +1,189 @@
package Perl::PrereqScanner::NotQuiteLite::Parser::MooseXDeclare;
use strict;
use warnings;
use Perl::PrereqScanner::NotQuiteLite::Util;
sub register { return {
use => {
'MooseX::Declare' => 'parse_moosex_declare_args',
},
}}
sub parse_moosex_declare_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
$c->register_sub_parser(
'class',
[$class, 'parse_class_args', $used_module],
);
$c->register_sub_parser(
'role',
[$class, 'parse_role_args', $used_module],
);
$c->register_keyword_parser(
'extends',
[$class, 'parse_extends_args', $used_module],
);
$c->register_keyword_parser(
'with',
[$class, 'parse_with_args', $used_module],
);
$c->register_keyword_parser(
'namespace',
[$class, 'parse_namespace_args', $used_module],
);
$c->register_sub_keywords(qw/
class method role
before after around override augment
/);
$c->prototype_re(qr{\G(\((?:[^\\\(\)]*(?:\\.[^\\\(\)]*)*)\))});
}
sub parse_class_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $namespace = $c->stash->{moosex_declare}{namespace} || '';
my $tokens = convert_string_tokens($raw_tokens);
shift @$tokens; # discard class
my $class_name = (shift @$tokens || [])->[0] or return;
if ($class_name eq '::') {
my $name = (shift @$tokens || [])->[0];
$class_name = $namespace . '::' . $name;
}
my $prev = '';
while(my $token = shift @$tokens) {
if ($token->[0] eq 'extends' or $token->[0] eq 'with') {
while(1) {
my $name = (shift @$tokens || [])->[0];
if ($name eq '::') {
$name = $namespace . '::' . (shift @$tokens || [])->[0];
}
$c->add($name => 0) if is_module_name($name);
last if !@$tokens;
my $next_token = $tokens->[0];
last if $next_token->[0] ne ',';
shift @$tokens;
}
}
}
}
sub parse_role_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $namespace = $c->stash->{moosex_declare}{namespace} || '';
my $tokens = convert_string_tokens($raw_tokens);
shift @$tokens; # discard role
my $class_name = (shift @$tokens)->[0];
if ($class_name eq '::') {
my $name = (shift @$tokens)->[0];
$class_name = $namespace . '::' . $name;
}
my $prev = '';
while(my $token = shift @$tokens) {
if ($token->[0] eq 'with') {
while(1) {
my $name = (shift @$tokens)->[0];
if ($name eq '::') {
$name = $namespace . '::' . (shift @$tokens)->[0];
}
$c->add($name => 0) if is_module_name($name);
last if !@$tokens;
my $next_token = $tokens->[0];
last if $next_token->[0] ne ',';
shift @$tokens;
}
}
}
}
sub parse_namespace_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $tokens = convert_string_tokens($raw_tokens);
shift @$tokens; # discard namespace
my $first_token = (shift @$tokens)->[0];
if (is_module_name($first_token)) {
$c->stash->{moosex_declare}{namespace} = $first_token;
}
}
sub parse_extends_args { shift->_parse_loader_args(@_) }
sub parse_with_args { shift->_parse_loader_args(@_) }
sub _parse_loader_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $namespace = $c->stash->{moosex_declare}{namespace} || '';
my $tokens = convert_string_tokens($raw_tokens);
shift @$tokens; # discard extends, with;
my $prev;
while(my $token = shift @$tokens) {
if (!ref $token) {
if ($token =~ /^::/) {
$token = $namespace . $token;
}
$c->add($token => 0);
$prev = $token;
next;
}
my $desc = $token->[1] || '';
if ($desc eq '{}') {
my @hash_tokens = @{$token->[0] || []};
for(my $i = 0, my $len = @hash_tokens; $i < $len; $i++) {
if ($hash_tokens[$i][0] eq '-version' and $i < $len - 2) {
my $maybe_version_token = $hash_tokens[$i + 2];
my $maybe_version = $maybe_version_token->[0];
if (ref $maybe_version) {
$maybe_version = $maybe_version->[0];
}
if ($prev and is_version($maybe_version)) {
$c->add($prev => $maybe_version);
}
}
}
}
}
}
1;
__END__
=encoding utf-8
=head1 NAME
Perl::PrereqScanner::NotQuiteLite::Parser::MooseXDeclare
=head1 DESCRIPTION
This parser is to deal with modules loaded by C<extends> and/or
C<with> from L<MooseX::Declare>.
=head1 AUTHOR
Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017 by Kenichi Ishigaki.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

63
database/perl/lib/Perl/PrereqScanner/NotQuiteLite/Parser/Only.pm Normal file
View File

@@ -0,0 +1,63 @@
package Perl::PrereqScanner::NotQuiteLite::Parser::Only;
use strict;
use warnings;
use Perl::PrereqScanner::NotQuiteLite::Util;
sub register { return {
use => {
only => 'parse_only_args',
},
}}
sub parse_only_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $tokens = convert_string_tokens($raw_tokens);
if (is_version($tokens->[0])) {
$c->add($used_module => shift @$tokens);
}
while(my $token = shift @$tokens) {
my $module = $token;
if (ref $module) {
$module = $module->[0];
}
next unless is_module_name($module);
my $version = shift @$tokens;
$version = shift @$tokens if ref $version;
if (is_version($version)) {
$c->add($module => $version);
} else {
$c->add($module => 0); # Can't determine a version
}
last;
}
}
1;
__END__
=encoding utf-8
=head1 NAME
Perl::PrereqScanner::NotQuiteLite::Parser::Only
=head1 DESCRIPTION
This parser is to deal with a module loaded by L<only>.
=head1 AUTHOR
Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017 by Kenichi Ishigaki.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

47
database/perl/lib/Perl/PrereqScanner/NotQuiteLite/Parser/POE.pm Normal file
View File

@@ -0,0 +1,47 @@
package Perl::PrereqScanner::NotQuiteLite::Parser::POE;
use strict;
use warnings;
use Perl::PrereqScanner::NotQuiteLite::Util;
sub register { return {
use => {
POE => 'parse_poe_args',
},
}}
sub parse_poe_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $tokens = convert_string_tokens($raw_tokens);
if (is_version($tokens->[0])) {
$c->add($used_module => shift @$tokens);
}
$c->add($_ eq "POE" ? $_ : "POE::".$_ => 0) for grep {!ref $_} @$tokens;
}
1;
__END__
=encoding utf-8
=head1 NAME
Perl::PrereqScanner::NotQuiteLite::Parser::POE
=head1 DESCRIPTION
This parser is to deal with modules loaded by L<POE>.
=head1 AUTHOR
Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015 by Kenichi Ishigaki.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

85
database/perl/lib/Perl/PrereqScanner/NotQuiteLite/Parser/PackageVariant.pm Normal file
View File

@@ -0,0 +1,85 @@
package Perl::PrereqScanner::NotQuiteLite::Parser::PackageVariant;
use strict;
use warnings;
use Perl::PrereqScanner::NotQuiteLite::Util;
sub register {{
use => {
'Package::Variant' => 'parse_package_variant_args',
},
}}
sub parse_package_variant_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $tokens = convert_string_tokens($raw_tokens);
while(my $token = shift @$tokens) {
if (ref $token and $token->[0] eq 'importing') {
shift @$tokens if @$tokens && $tokens->[0][1] eq 'COMMA';
my $next_token = shift @$tokens or last;
if (!ref $next_token) {
my $module = $next_token;
if (is_module_name($module)) {
$c->add($module);
if ($c->has_callback_for(use => $module)) {
$c->run_callback_for('use', $module, [["use", "KEYWORD"], [$module, "WORD"], [";", ";"]]);
}
}
}
elsif ($next_token->[1] eq '[]') {
my $modules = convert_string_token_list($next_token->[0]);
while(my $module = shift @$modules) {
next unless is_module_name($module);
$c->add($module);
if ($c->has_callback_for(use => $module)) {
$c->run_callback_for('use', $module, [["use", "KEYWORD"], [$module, "WORD"], [";", ";"]]);
}
}
} elsif ($next_token->[1] eq '{}') {
my $hash_tokens = convert_string_token_list($next_token->[0]);
while(my $module = shift @$hash_tokens) {
my $arg = shift @$hash_tokens;
my @args = $arg->[1] eq '[]' ? @{$arg->[0]} : $arg;
$c->add($module);
if ($c->has_callback_for(use => $module)) {
$c->run_callback_for('use', $module, [["use", "KEYWORD"], [$module, "WORD"], @args, [";", ";"]]);
}
}
}
}
elsif (ref $token && !ref $token->[0] && $token->[1] eq 'WORD') {
shift @$tokens if @$tokens && $tokens->[0][1] eq 'COMMA';
shift @$tokens if @$tokens;
}
shift @$tokens if @$tokens && ref $tokens->[0] && $tokens->[0][1] eq 'COMMA';
}
}
1;
__END__
=encoding utf-8
=head1 NAME
Perl::PrereqScanner::NotQuiteLite::Parser::PackageVariant
=head1 DESCRIPTION
This parser is to deal with modules loaded by L<Package::Variant>.
=head1 AUTHOR
Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2018 by Kenichi Ishigaki.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

87
database/perl/lib/Perl/PrereqScanner/NotQuiteLite/Parser/Plack.pm Normal file
View File

@@ -0,0 +1,87 @@
package Perl::PrereqScanner::NotQuiteLite::Parser::Plack;
use strict;
use warnings;
use Perl::PrereqScanner::NotQuiteLite::Util;
sub register { return {
use => {
'Plack::Builder' => 'parse_plack_builder_args',
},
}}
sub parse_plack_builder_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
# TODO: support add_middleware(_if) methods?
$c->register_keyword_parser(
'enable',
[$class, 'parse_enable_args', $used_module],
);
$c->register_keyword_parser(
'enable_if',
[$class, 'parse_enable_if_args', $used_module],
);
}
sub parse_enable_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $tokens = convert_string_tokens($raw_tokens);
shift @$tokens; # discard 'enable' itself
my $module = shift @$tokens or return;
if ($module =~ s/^\+//) {
$c->add($module => 0);
} else {
$module =~ s/^Plack::Middleware:://;
$c->add("Plack::Middleware::".$module => 0);
}
}
sub parse_enable_if_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
while(my $token = shift @$raw_tokens) {
last if $token->[1] eq 'COMMA' or ref $token->[0];
}
shift @$raw_tokens if $raw_tokens->[0][1] eq 'COMMA';
my $tokens = convert_string_tokens($raw_tokens);
my $module = shift @$tokens or return;
if ($module =~ s/^\+//) {
$c->add($module => 0);
} else {
$module =~ s/^Plack::Middleware:://;
$c->add("Plack::Middleware::".$module => 0);
}
}
1;
__END__
=encoding utf-8
=head1 NAME
Perl::PrereqScanner::NotQuiteLite::Parser::Plack
=head1 DESCRIPTION
This parser is to deal with Plack middlewares loaded by L<Plack::Builder>.
=head1 AUTHOR
Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015 by Kenichi Ishigaki.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

54
database/perl/lib/Perl/PrereqScanner/NotQuiteLite/Parser/Prefork.pm Normal file
View File

@@ -0,0 +1,54 @@
package Perl::PrereqScanner::NotQuiteLite::Parser::Prefork;
use strict;
use warnings;
use Perl::PrereqScanner::NotQuiteLite::Util;
sub register { return {
use => {
prefork => 'parse_prefork_args',
},
}}
sub parse_prefork_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $tokens = convert_string_tokens($raw_tokens);
if (is_version($tokens->[0])) {
$c->add($used_module => shift @$tokens);
}
my $module = $tokens->[0];
if (ref $module) {
$module = $module->[0];
}
if (is_module_name($module)) {
$c->add($module => 0);
}
}
1;
__END__
=encoding utf-8
=head1 NAME
Perl::PrereqScanner::NotQuiteLite::Parser::Prefork
=head1 DESCRIPTION
This parser is to deal with module loaded by C<prefork>.
=head1 AUTHOR
Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017 by Kenichi Ishigaki.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

73
database/perl/lib/Perl/PrereqScanner/NotQuiteLite/Parser/Superclass.pm Normal file
View File

@@ -0,0 +1,73 @@
package Perl::PrereqScanner::NotQuiteLite::Parser::Superclass;
use strict;
use warnings;
use Perl::PrereqScanner::NotQuiteLite::Util;
sub register { return {
use => {
superclass => 'parse_superclass_args',
},
}}
sub parse_superclass_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $tokens = convert_string_tokens($raw_tokens);
if (is_version($tokens->[0])) {
$c->add($used_module => shift @$tokens);
}
my ($module, $version, $prev);
for my $token (@$tokens) {
last if $token eq '-norequire';
if (ref $token) {
last if $token->[0] eq '-norequire';
$prev = $token->[0];
next;
}
$prev = $token;
if (is_module_name($token)) {
if ($module) {
$c->add($module => $version || 0);
}
$module = $token;
next;
}
if (is_version($token)) {
$c->add($module => $token);
}
}
if ($module) {
$c->add($module => 0);
}
}
1;
__END__
=encoding utf-8
=head1 NAME
Perl::PrereqScanner::NotQuiteLite::Parser::Superclass
=head1 DESCRIPTION
This parser is to deal with module inheritance managed by
L<superclass>.
=head1 AUTHOR
Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015 by Kenichi Ishigaki.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

79
database/perl/lib/Perl/PrereqScanner/NotQuiteLite/Parser/Syntax.pm Normal file
View File

@@ -0,0 +1,79 @@
package Perl::PrereqScanner::NotQuiteLite::Parser::Syntax;
use strict;
use warnings;
use Perl::PrereqScanner::NotQuiteLite::Util;
my %Unsupported = map {$_ => 1} qw(
);
sub register { return {
use => {
syntax => 'parse_syntax_args',
},
}}
sub parse_syntax_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $tokens = convert_string_tokens($raw_tokens);
if (is_version($tokens->[0])) {
$c->add($used_module => shift @$tokens);
}
return if ref $tokens->[0];
my $feature_name = $tokens->[0];
my $name =
join '::',
map ucfirst,
split m{/},
join '',
map ucfirst,
split qr{_}, $feature_name;
my $feature_module = "Syntax::Feature::$name";
if (is_module_name($feature_module)) {
$c->add($feature_module => 0);
}
if ($feature_name =~ /^q[sil]$/) {
$c->register_quotelike_keywords($feature_name, 'q'.$feature_name);
}
# Some of the features change syntax too much
if ($Unsupported{$feature_name}) {
$c->{aborted} = "syntax '$feature_name'";
$c->{ended} = 1;
}
}
1;
__END__
=encoding utf-8
=head1 NAME
Perl::PrereqScanner::NotQuiteLite::Parser::Syntax
=head1 DESCRIPTION
This parser is to deal with L<syntax> features.
=head1 AUTHOR
Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017 by Kenichi Ishigaki.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

89
database/perl/lib/Perl/PrereqScanner/NotQuiteLite/Parser/SyntaxCollector.pm Normal file
View File

@@ -0,0 +1,89 @@
package Perl::PrereqScanner::NotQuiteLite::Parser::SyntaxCollector;
use strict;
use warnings;
use Perl::PrereqScanner::NotQuiteLite::Util;
sub register { return {
use => {
'Syntax::Collector' => 'parse_syntax_collector_args',
},
}}
sub parse_syntax_collector_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $tokens = convert_string_token_list($raw_tokens);
if (is_version($tokens->[0])) {
$c->add($used_module => shift @$tokens);
}
my $spec;
if (!(@$tokens % 2)) {
while(my ($key, $value) = splice @$tokens, 0, 2) {
my $keystr = ref $key ? $key->[0] : $key;
if ($keystr eq '-collect') {
$spec = $value;
last;
}
}
} else {
$spec = $tokens->[0];
}
if (ref $spec) {
$spec = $spec->[0];
}
return unless $spec;
my @features =
map {
m{^
(use|no) \s+ # "use" or "no"
(\S+) \s+ # module name
([\d\._v]+) # module version
(?: # everything else
\s* (.+)
)? # ... perhaps
[;] \s* # semicolon
$}x
? [$1, $2, $3, [ defined($4) ? eval "($4)" : ()] ]
: die("Line q{$_} doesn't conform to 'use MODULE VERSION [ARGS];'")
}
grep { ! m/^#/ } # not a comment
grep { m/[A-Z0-9]/i } # at least one alphanum
map { s/(^\s+)|(\s+$)//; $_ } # trim
map { split /(\r?\n|\r)/ } # split lines
$spec;
for my $feature (@features) {
$c->add($feature->[1], $feature->[2]);
}
}
1;
__END__
=encoding utf-8
=head1 NAME
Perl::PrereqScanner::NotQuiteLite::Parser::SyntaxCollector
=head1 DESCRIPTION
This parser is to deal with modules loading by L<Syntax::Collector> module.
=head1 AUTHOR
Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017 by Kenichi Ishigaki.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

59
database/perl/lib/Perl/PrereqScanner/NotQuiteLite/Parser/TestClassMost.pm Normal file
View File

@@ -0,0 +1,59 @@
package Perl::PrereqScanner::NotQuiteLite::Parser::TestClassMost;
use strict;
use warnings;
use Perl::PrereqScanner::NotQuiteLite::Util;
sub register { return {
use => {
'Test::Class::Most' => 'parse_test_class_most_args',
},
}}
sub parse_test_class_most_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $tokens = convert_string_token_list($raw_tokens);
if (is_version($tokens->[0])) {
$c->add($used_module => shift @$tokens);
}
while(my ($key, $value) = splice @$tokens, 0, 2) {
my $keystr = ref $key ? $key->[0] : $key;
if ($keystr eq 'parent') {
if (!ref $value) {
$c->add($value => 0);
} elsif ($value->[1] eq '[]') {
my $tokens_inside = convert_string_token_list($value->[0]);
$c->add($_ => 0) for @$tokens_inside;
}
}
}
}
1;
__END__
=encoding utf-8
=head1 NAME
Perl::PrereqScanner::NotQuiteLite::Parser::TestClassMost
=head1 DESCRIPTION
This parser is to deal with conditional loading by C<Test::Class::Most>.
=head1 AUTHOR
Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017 by Kenichi Ishigaki.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

80
database/perl/lib/Perl/PrereqScanner/NotQuiteLite/Parser/TestMore.pm Normal file
View File

@@ -0,0 +1,80 @@
package Perl::PrereqScanner::NotQuiteLite::Parser::TestMore;
use strict;
use warnings;
use Perl::PrereqScanner::NotQuiteLite::Util;
sub register { return {
use => {
'Test::More' => 'parse_test_more_args',
},
}}
sub register_fqfn { return +{
'Test::More::done_testing' => 'parse_done_testing_args',
'Test::More::plan' => 'parse_plan_args',
}}
sub parse_test_more_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
$c->register_keyword_parser(
'done_testing',
[$class, 'parse_done_testing_args', $used_module],
);
$c->register_keyword_parser(
'plan',
[$class, 'parse_plan_args', $used_module],
);
}
sub parse_done_testing_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
$c->add($used_module => '0.88');
}
sub parse_plan_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $tokens = convert_string_tokens($raw_tokens);
shift @$tokens; # discard plan
my $first_token = $tokens->[0] or return;
$first_token = $first_token->[0] if ref $first_token;
if ($first_token eq 'skip_all') {
if (grep {$_->[0] eq '{' and $_->[2] eq 'BEGIN'} @{$c->{stack} || []}) {
$c->{force_cond} = 1;
}
}
}
1;
__END__
=encoding utf-8
=head1 NAME
Perl::PrereqScanner::NotQuiteLite::Parser::TestMore
=head1 DESCRIPTION
This parser is to update the minimum version requirement of
L<Test::More> to 0.88 if C<done_testing> is found by the scanner.
=head1 AUTHOR
Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015 by Kenichi Ishigaki.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

77
database/perl/lib/Perl/PrereqScanner/NotQuiteLite/Parser/TestRequires.pm Normal file
View File

@@ -0,0 +1,77 @@
package Perl::PrereqScanner::NotQuiteLite::Parser::TestRequires;
use strict;
use warnings;
use Perl::PrereqScanner::NotQuiteLite::Util;
sub register { return {
use => {
'Test::Requires' => 'parse_test_requires_args',
},
}}
sub parse_test_requires_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
$c->register_keyword_parser(
'test_requires',
[$class, 'parse_test_requires_function_args', $used_module],
);
my $tokens = convert_string_tokens($raw_tokens);
if (is_version($tokens->[0])) {
$c->add($used_module => shift @$tokens);
}
if (ref $tokens->[0] and $tokens->[0][1] and $tokens->[0][1] eq '{}') {
my $tokens_in_hashref = convert_string_tokens($tokens->[0][0]);
while(my ($key, undef, $value, undef) = splice @$tokens_in_hashref, 0, 4) {
next unless is_module_name($key);
next unless is_version($value);
$c->add_recommendation($key => $value);
}
} else {
for my $token (@$tokens) {
next if ref $token;
if ($token =~ /^v?5/) {
$c->add_recommendation(perl => $token);
} else {
$c->add_recommendation($token => 0);
}
}
}
}
sub parse_test_requires_function_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
my $tokens = convert_string_tokens($raw_tokens);
$c->add_recommendation($_ => 0) for grep {!ref $_} @$tokens;
}
1;
__END__
=encoding utf-8
=head1 NAME
Perl::PrereqScanner::NotQuiteLite::Parser::TestRequires
=head1 DESCRIPTION
This parser is to deal with conditional loading by C<Test::Requires>.
=head1 AUTHOR
Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017 by Kenichi Ishigaki.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

62
database/perl/lib/Perl/PrereqScanner/NotQuiteLite/Parser/UniversalVersion.pm Normal file
View File

@@ -0,0 +1,62 @@
package Perl::PrereqScanner::NotQuiteLite::Parser::UniversalVersion;
use strict;
use warnings;
use Perl::PrereqScanner::NotQuiteLite::Util;
sub register { return {
method => {
VERSION => 'parse_version_args',
},
}}
sub parse_version_args {
my ($class, $c, $raw_tokens) = @_;
my ($module_token, undef, undef, $args_tokens) = @$raw_tokens;
my $module = $module_token->[0];
return unless ref $args_tokens->[0];
my @tokens_in_parens = @{$args_tokens->[0] || []};
return if @tokens_in_parens > 1;
my $version_token = $tokens_in_parens[0];
my $module_version;
if ($version_token->[1] and $version_token->[1] eq 'NUMBER') {
$module_version = $version_token->[0];
} elsif (ref $version_token->[0]) {
$module_version = $version_token->[0][0];
} else {
return;
}
if ($module_version =~ /^v?[0-9._]+$/) {
$c->add_conditional($module => $module_version) if $c->has_added_conditional($module);
}
}
1;
__END__
=encoding utf-8
=head1 NAME
Perl::PrereqScanner::NotQuiteLite::Parser::UniversalVersion
=head1 DESCRIPTION
This parser is to deal with a VERSION method called by a module.
=head1 AUTHOR
Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015 by Kenichi Ishigaki.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

62
database/perl/lib/Perl/PrereqScanner/NotQuiteLite/Parser/Unless.pm Normal file
View File

@@ -0,0 +1,62 @@
package Perl::PrereqScanner::NotQuiteLite::Parser::Unless;
use strict;
use warnings;
use Perl::PrereqScanner::NotQuiteLite::Util;
sub register { return {
use => {
unless => 'parse_unless_args',
},
}}
sub parse_unless_args {
my ($class, $c, $used_module, $raw_tokens) = @_;
while(my $token = shift @$raw_tokens) {
last if $token->[1] eq 'COMMA';
}
my $tokens = convert_string_tokens($raw_tokens);
my $module = shift @$tokens;
if (ref $module and ($module->[1] eq 'WORD' or $module->[1] eq 'KEYWORD')) {
$module = $module->[0];
}
if (is_module_name($module)) {
if (is_version($tokens->[0])) {
my $version = shift @$tokens;
$c->add_recommendation($module => $version);
} else {
$c->add_recommendation($module => 0);
}
} else {
push @{$c->{errors}}, "use unless module not found";
}
}
1;
__END__
=encoding utf-8
=head1 NAME
Perl::PrereqScanner::NotQuiteLite::Parser::Unless
=head1 DESCRIPTION
This parser is to deal with conditional loading by C<unless> module.
=head1 AUTHOR
Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017 by Kenichi Ishigaki.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

34
database/perl/lib/Perl/PrereqScanner/NotQuiteLite/Tokens.pm Normal file
View File

@@ -0,0 +1,34 @@
package Perl::PrereqScanner::NotQuiteLite::Tokens;
use strict;
use warnings;
1;
__END__
=encoding utf-8
=head1 NAME
Perl::PrereqScanner::NotQuiteLite::Tokens
=head1 DESCRIPTION
The interface of this module is not completely settled yet.
If you need something to make it easier to write your own parsers,
let me know.
=head1 AUTHOR
Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
This software is copyclose (c) 2015 by Kenichi Ishigaki.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

169
database/perl/lib/Perl/PrereqScanner/NotQuiteLite/Util.pm Normal file
View File

@@ -0,0 +1,169 @@
package Perl::PrereqScanner::NotQuiteLite::Util;
use strict;
use warnings;
use Exporter 5.57 qw/import/;
our %FLAGS; BEGIN {
my $i = 0;
%FLAGS = map {$_ => 1 << $i++} qw/
F_KEEP_TOKENS
F_EVAL
F_STRING_EVAL
F_EXPECTS_BRACKET
F_CONDITIONAL
F_SIDEFF
F_SCOPE_END
F_STATEMENT_END
F_EXPR_END
F_EXPR
/;
}
use constant \%FLAGS;
use constant {
MASK_KEEP_TOKENS => ~(F_KEEP_TOKENS),
MASK_EXPR_END => ~(F_EXPR_END|F_EXPR),
MASK_STATEMENT_END => ~(F_KEEP_TOKENS|F_STATEMENT_END|F_EXPR|F_EXPR_END|F_SIDEFF),
MASK_EVAL => ~(F_EVAL),
MASK_SIDEFF => ~(F_SIDEFF),
F_RESCAN => (F_KEEP_TOKENS|F_EVAL|F_STRING_EVAL|F_CONDITIONAL),
};
our @EXPORT = ((keys %FLAGS), qw/
is_module_name
is_version
convert_string_tokens
convert_string_token_list
MASK_KEEP_TOKENS
MASK_EXPR_END
MASK_STATEMENT_END
MASK_EVAL
MASK_SIDEFF
F_RESCAN
/);
sub is_module_name {
my $name = shift or return;
return 1 if $name =~ /^[A-Za-z_][A-Za-z0-9_]*(?:(?:::|')[A-Za-z0-9_]+)*$/;
return;
}
sub is_version {
my $version = shift;
return unless defined $version;
return 1 if $version =~ /\A
(
[0-9]+(?:\.[0-9]+)?
|
v[0-9]+(?:\.[0-9]+)*
|
[0-9]+(?:\.[0-9]+){2,}
) (?:_[0-9]+)?
\z/x;
return;
}
sub convert_string_tokens {
my $org_tokens = shift;
my @tokens;
my @copied_tokens = @$org_tokens;
my $prev = '';
while(my $copied_token = shift @copied_tokens) {
my ($token, $desc) = @$copied_token;
if ($desc and $desc eq '()' and $prev ne 'WORD') {
unshift @copied_tokens, @$token;
next;
}
if (!$desc) {
push @tokens, $copied_token;
} elsif ($desc eq 'VERSION_STRING' or $desc eq 'NUMBER') {
push @tokens, $token;
} elsif ($desc eq 'STRING') {
push @tokens, $token->[0];
} elsif ($desc eq 'QUOTED_WORD_LIST') {
push @tokens, grep {defined $_ and $_ ne ''} split /\s/, $token->[0];
} else {
push @tokens, $copied_token;
}
$prev = $desc;
}
\@tokens;
}
sub convert_string_token_list {
my $org_tokens = shift;
my @list;
my @tokens;
my @copied_tokens = @$org_tokens;
my $prev = '';
while(my $copied_token = shift @copied_tokens) {
my ($token, $desc) = @$copied_token;
if ($desc and $desc eq '()' and $prev ne 'WORD') {
unshift @copied_tokens, @$token;
next;
}
if (!$desc) {
push @tokens, $copied_token;
} elsif ($desc eq 'VERSION_STRING' or $desc eq 'NUMBER') {
push @tokens, $token;
} elsif ($desc eq 'STRING') {
push @tokens, $token->[0];
} elsif ($desc eq 'QUOTED_WORD_LIST') {
push @list, grep {defined $_ and $_ ne ''} split /\s/, $token->[0];
} elsif ($token eq ',' or $token eq '=>') {
push @list, @tokens == 1 ? $tokens[0] : \@tokens;
@tokens = ();
$prev = '';
} elsif ($desc eq ';') {
last;
} else {
push @tokens, $copied_token;
}
$prev = $desc;
}
if (@tokens) {
push @list, @tokens == 1 ? $tokens[0] : \@tokens;
}
\@list;
}
1;
__END__
=encoding utf-8
=head1 NAME
Perl::PrereqScanner::NotQuiteLite::Util
=head1 DESCRIPTION
This provides a few utility functions for internal use.
=head1 FUNCTIONS
=head2 is_module_name
takes a string and returns true if it looks like a module.
=head2 is_version
takes a string and returns true if it looks like a version.
=head1 AUTHOR
Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2015 by Kenichi Ishigaki.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

147
database/perl/lib/Perl/PrereqScanner/NotQuiteLite/Util/CPANfile.pm Normal file
View File

@@ -0,0 +1,147 @@
package Perl::PrereqScanner::NotQuiteLite::Util::CPANfile;
use strict;
use warnings;
use parent 'Module::CPANfile';
use Perl::PrereqScanner::NotQuiteLite::Util::Prereqs;
sub load_and_merge {
my ($class, $file, $prereqs, $features) = @_;
$prereqs = $prereqs->as_string_hash unless ref $prereqs eq 'HASH';
my $self;
if (-f $file) {
$self = $class->load($file);
$self->_merge_prereqs($prereqs);
} else {
$self = $class->from_prereqs($prereqs);
}
if ($features) {
for my $identifier (keys %$features) {
my $feature = $features->{$identifier};
next unless $feature->{prereqs};
$self->_merge_prereqs($feature->{prereqs}, $identifier) or next;
$self->{_prereqs}->add_feature($identifier, $feature->{description});
}
}
$self->_dedupe;
$self;
}
sub features {
my $self = shift;
map $self->feature($_), sort $self->{_prereqs}->identifiers; # TWEAKED
}
sub _merge_prereqs {
my ($self, $prereqs, $feature_id) = @_;
$prereqs = $prereqs->as_string_hash unless ref $prereqs eq 'HASH';
my $current = CPAN::Meta::Prereqs->new($self->{_prereqs}->specs($feature_id));
my $merged = $current->with_merged_prereqs(CPAN::Meta::Prereqs->new($prereqs));
$self->__replace_prereqs($merged, $feature_id);
}
sub __replace_prereqs {
my ($self, $prereqs, $feature_id) = @_;
$prereqs = $prereqs->as_string_hash unless ref $prereqs eq 'HASH';
@{$self->{_prereqs}{prereqs}{$feature_id || ''}} = ();
my $added = 0;
for my $phase (keys %$prereqs) {
for my $type (keys %{$prereqs->{$phase}}) {
while (my($module, $requirement) = each %{$prereqs->{$phase}{$type}}) {
$self->{_prereqs}->add(
feature => $feature_id,
phase => $phase,
type => $type,
module => $module,
requirement => Module::CPANfile::Requirement->new(name => $module, version => $requirement),
);
$added++
}
}
}
delete $self->{_prereqs}{cpanmeta} unless $feature_id; # to rebuild cpanmeta
$added;
}
sub _dedupe {
my $self = shift;
my $prereqs = $self->prereqs;
my %features = map {$_ => $self->feature($_)->{prereqs} } $self->{_prereqs}->identifiers;
dedupe_prereqs_and_features($prereqs, \%features);
$self->__replace_prereqs($prereqs);
for my $feature_id (keys %features) {
$self->__replace_prereqs($features{$feature_id}, $feature_id);
}
}
sub _dump_prereqs {
my($self, $prereqs, $include_empty, $base_indent) = @_;
my $code = '';
my @x_phases = sort grep {/^x_/i} keys %$prereqs; # TWEAKED
for my $phase (qw(runtime configure build test develop), @x_phases) {
my $indent = $phase eq 'runtime' ? '' : ' ';
$indent = (' ' x ($base_indent || 0)) . $indent;
my($phase_code, $requirements);
$phase_code .= "on $phase => sub {\n" unless $phase eq 'runtime';
my @x_types = sort grep {/^x_/i} keys %{$prereqs->{$phase}}; # TWEAKED
for my $type (qw(requires recommends suggests conflicts), @x_types) {
for my $mod (sort keys %{$prereqs->{$phase}{$type}}) {
my $ver = $prereqs->{$phase}{$type}{$mod};
$phase_code .= $ver eq '0'
? "${indent}$type '$mod';\n"
: "${indent}$type '$mod', '$ver';\n";
$requirements++;
}
}
$phase_code .= "\n" unless $requirements;
$phase_code .= "};\n" unless $phase eq 'runtime';
$code .= $phase_code . "\n" if $requirements or $include_empty;
}
$code =~ s/\n+$/\n/s;
$code;
}
1;
__END__
=encoding utf-8
=head1 NAME
Perl::PrereqScanner::NotQuiteLite::Util::CPANfile
=head1 SYNOPSIS
=head1 DESCRIPTION
This is a wrapper of L<Module::CPANfile>.
=head1 AUTHOR
Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017 by Kenichi Ishigaki.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut

85
database/perl/lib/Perl/PrereqScanner/NotQuiteLite/Util/Prereqs.pm Normal file
View File

@@ -0,0 +1,85 @@
package Perl::PrereqScanner::NotQuiteLite::Util::Prereqs;
use strict;
use warnings;
use Exporter 5.57 'import';
our @EXPORT = qw/dedupe_prereqs_and_features/;
sub dedupe_prereqs_and_features {
my ($prereqs, $features) = @_;
my @valid_features = grep defined, values %$features;
for my $phase ($prereqs->phases) {
my $requires = $prereqs->requirements_for($phase, 'requires');
for my $type (qw/recommends suggests/) {
my $target = $prereqs->requirements_for($phase, $type);
_dedupe($requires, $target);
}
for my $feature (@valid_features) {
for my $type (qw/requires recommends suggests/) {
my $target = $feature->requirements_for($phase, $type);
_dedupe($requires, $target);
}
}
my $recommends = $prereqs->requirements_for($phase, 'recommends');
for my $type (qw/suggests/) {
my $target = $prereqs->requirements_for($phase, $type);
_dedupe($recommends, $target);
}
for my $feature (@valid_features) {
for my $type (qw/recommends suggests/) {
my $target = $feature->requirements_for($phase, $type);
_dedupe($recommends, $target);
}
}
my $suggests = $prereqs->requirements_for($phase, 'suggests');
for my $feature (@valid_features) {
for my $type (qw/suggests/) {
my $target = $feature->requirements_for($phase, $type);
_dedupe($suggests, $target);
}
}
}
}
sub _dedupe {
my ($source, $target) = @_;
my @modules = $source->required_modules;
for my $module (@modules) {
my $version = $target->requirements_for_module($module);
next unless defined $version;
next unless $version =~ /^[0-9._]+$/;
next unless $source->accepts_module($module, $version);
$target->clear_requirement($module);
}
}
1;
__END__
=encoding utf-8
=head1 NAME
Perl::PrereqScanner::NotQuiteLite::Util::Prereqs
=head1 SYNOPSIS
=head1 DESCRIPTION
This is an internal utility to dedupe prereqs.
=head1 AUTHOR
Kenichi Ishigaki, E<lt>ishigaki@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017 by Kenichi Ishigaki.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut