e15c35f588
Signed-off-by: Fabrice Fontaine <fontaine.fabrice@gmail.com> Signed-off-by: Thomas Petazzoni <thomas.petazzoni@bootlin.com>
998 lines
30 KiB
Perl
Executable File
998 lines
30 KiB
Perl
Executable File
#!/usr/bin/env perl
|
|
|
|
# This chunk of stuff was generated by App::FatPacker. To find the original
|
|
# file's code, look for the end of this BEGIN block or the string 'FATPACK'
|
|
BEGIN {
|
|
my %fatpacked;
|
|
|
|
$fatpacked{"MetaCPAN/API/Tiny.pm"} = <<'METACPAN_API_TINY';
|
|
package MetaCPAN::API::Tiny;
|
|
{
|
|
$MetaCPAN::API::Tiny::VERSION = '1.131730';
|
|
}
|
|
use strict;
|
|
use warnings;
|
|
# ABSTRACT: A Tiny API client for MetaCPAN
|
|
|
|
use Carp;
|
|
use JSON::PP 'encode_json', 'decode_json';
|
|
use HTTP::Tiny;
|
|
|
|
|
|
sub new {
|
|
my ($class, @args) = @_;
|
|
|
|
$#_ % 2 == 0
|
|
or croak 'Arguments must be provided as name/value pairs';
|
|
|
|
my %params = @args;
|
|
|
|
die 'ua_args must be an array reference'
|
|
if $params{ua_args} && ref($params{ua_args}) ne 'ARRAY';
|
|
|
|
my $self = +{
|
|
base_url => $params{base_url} || 'http://api.metacpan.org/v0',
|
|
ua => $params{ua} || HTTP::Tiny->new(
|
|
$params{ua_args}
|
|
? @{$params{ua_args}}
|
|
: (agent => 'MetaCPAN::API::Tiny/'
|
|
. ($MetaCPAN::API::VERSION || 'xx'))),
|
|
};
|
|
|
|
return bless($self, $class);
|
|
}
|
|
|
|
sub _build_extra_params {
|
|
my $self = shift;
|
|
|
|
@_ % 2 == 0
|
|
or croak 'Incorrect number of params, must be key/value';
|
|
|
|
my %extra = @_;
|
|
my $ua = $self->{ua};
|
|
|
|
foreach my $key (keys %extra)
|
|
{
|
|
# The implementation in HTTP::Tiny uses + instead of %20, fix that
|
|
$extra{$key} = $ua->_uri_escape($extra{$key});
|
|
$extra{$key} =~ s/\+/%20/g;
|
|
}
|
|
|
|
my $params = join '&', map { "$_=" . $extra{$_} } sort keys %extra;
|
|
|
|
return $params;
|
|
}
|
|
|
|
|
|
# /source/{author}/{release}/{path}
|
|
sub source {
|
|
my $self = shift;
|
|
my %opts = @_ ? @_ : ();
|
|
my $url = '';
|
|
my $error = "Provide 'author' and 'release' and 'path'";
|
|
|
|
%opts or croak $error;
|
|
|
|
if (
|
|
defined ( my $author = $opts{'author'} ) &&
|
|
defined ( my $release = $opts{'release'} ) &&
|
|
defined ( my $path = $opts{'path'} )
|
|
) {
|
|
$url = "source/$author/$release/$path";
|
|
} else {
|
|
croak $error;
|
|
}
|
|
|
|
$url = $self->{base_url} . "/$url";
|
|
|
|
my $result = $self->{ua}->get($url);
|
|
$result->{'success'}
|
|
or croak "Failed to fetch '$url': " . $result->{'reason'};
|
|
|
|
return $result->{'content'};
|
|
}
|
|
|
|
|
|
# /release/{distribution}
|
|
# /release/{author}/{release}
|
|
sub release {
|
|
my $self = shift;
|
|
my %opts = @_ ? @_ : ();
|
|
my $url = '';
|
|
my $error = "Either provide 'distribution', or 'author' and 'release', " .
|
|
"or 'search'";
|
|
|
|
%opts or croak $error;
|
|
|
|
my %extra_opts = ();
|
|
|
|
if ( defined ( my $dist = $opts{'distribution'} ) ) {
|
|
$url = "release/$dist";
|
|
} elsif (
|
|
defined ( my $author = $opts{'author'} ) &&
|
|
defined ( my $release = $opts{'release'} )
|
|
) {
|
|
$url = "release/$author/$release";
|
|
} elsif ( defined ( my $search_opts = $opts{'search'} ) ) {
|
|
ref $search_opts && ref $search_opts eq 'HASH'
|
|
or croak $error;
|
|
|
|
%extra_opts = %{$search_opts};
|
|
$url = 'release/_search';
|
|
} else {
|
|
croak $error;
|
|
}
|
|
|
|
return $self->fetch( $url, %extra_opts );
|
|
}
|
|
|
|
|
|
# /pod/{module}
|
|
# /pod/{author}/{release}/{path}
|
|
sub pod {
|
|
my $self = shift;
|
|
my %opts = @_ ? @_ : ();
|
|
my $url = '';
|
|
my $error = "Either provide 'module' or 'author and 'release' and 'path'";
|
|
|
|
%opts or croak $error;
|
|
|
|
if ( defined ( my $module = $opts{'module'} ) ) {
|
|
$url = "pod/$module";
|
|
} elsif (
|
|
defined ( my $author = $opts{'author'} ) &&
|
|
defined ( my $release = $opts{'release'} ) &&
|
|
defined ( my $path = $opts{'path'} )
|
|
) {
|
|
$url = "pod/$author/$release/$path";
|
|
} else {
|
|
croak $error;
|
|
}
|
|
|
|
# check content-type
|
|
my %extra = ();
|
|
if ( defined ( my $type = $opts{'content-type'} ) ) {
|
|
$type =~ m{^ text/ (?: html|plain|x-pod|x-markdown ) $}x
|
|
or croak 'Incorrect content-type provided';
|
|
|
|
$extra{headers}{'content-type'} = $type;
|
|
}
|
|
|
|
$url = $self->{base_url}. "/$url";
|
|
|
|
my $result = $self->{ua}->get( $url, \%extra );
|
|
$result->{'success'}
|
|
or croak "Failed to fetch '$url': " . $result->{'reason'};
|
|
|
|
return $result->{'content'};
|
|
}
|
|
|
|
|
|
# /module/{module}
|
|
sub module {
|
|
my $self = shift;
|
|
my $name = shift;
|
|
|
|
$name or croak 'Please provide a module name';
|
|
|
|
return $self->fetch("module/$name");
|
|
}
|
|
|
|
|
|
# file() is a synonym of module
|
|
sub file { goto &module }
|
|
|
|
|
|
# /author/{author}
|
|
sub author {
|
|
my $self = shift;
|
|
my ( $pause_id, $url, %extra_opts );
|
|
|
|
if ( @_ == 1 ) {
|
|
$url = 'author/' . shift;
|
|
} elsif ( @_ == 2 ) {
|
|
my %opts = @_;
|
|
|
|
if ( defined $opts{'pauseid'} ) {
|
|
$url = "author/" . $opts{'pauseid'};
|
|
} elsif ( defined $opts{'search'} ) {
|
|
my $search_opts = $opts{'search'};
|
|
|
|
ref $search_opts && ref $search_opts eq 'HASH'
|
|
or croak "'search' key must be hashref";
|
|
|
|
%extra_opts = %{$search_opts};
|
|
$url = 'author/_search';
|
|
} else {
|
|
croak 'Unknown option given';
|
|
}
|
|
} else {
|
|
croak 'Please provide an author PAUSEID or a "search"';
|
|
}
|
|
|
|
return $self->fetch( $url, %extra_opts );
|
|
}
|
|
|
|
|
|
|
|
sub fetch {
|
|
my $self = shift;
|
|
my $url = shift;
|
|
my $extra = $self->_build_extra_params(@_);
|
|
my $base = $self->{base_url};
|
|
my $req_url = $extra ? "$base/$url?$extra" : "$base/$url";
|
|
|
|
my $result = $self->{ua}->get($req_url);
|
|
return $self->_decode_result( $result, $req_url );
|
|
}
|
|
|
|
|
|
sub post {
|
|
my $self = shift;
|
|
my $url = shift;
|
|
my $query = shift;
|
|
my $base = $self->{base_url};
|
|
|
|
defined $url
|
|
or croak 'First argument of URL must be provided';
|
|
|
|
ref $query and ref $query eq 'HASH'
|
|
or croak 'Second argument of query hashref must be provided';
|
|
|
|
my $query_json = encode_json( $query );
|
|
my $result = $self->{ua}->request(
|
|
'POST',
|
|
"$base/$url",
|
|
{
|
|
headers => { 'Content-Type' => 'application/json' },
|
|
content => $query_json,
|
|
}
|
|
);
|
|
|
|
return $self->_decode_result( $result, $url, $query_json );
|
|
}
|
|
|
|
sub _decode_result {
|
|
my $self = shift;
|
|
my ( $result, $url, $original ) = @_;
|
|
my $decoded_result;
|
|
|
|
ref $result and ref $result eq 'HASH'
|
|
or croak 'First argument must be hashref';
|
|
|
|
defined $url
|
|
or croak 'Second argument of a URL must be provided';
|
|
|
|
if ( defined ( my $success = $result->{'success'} ) ) {
|
|
my $reason = $result->{'reason'} || '';
|
|
$reason .= ( defined $original ? " (request: $original)" : '' );
|
|
|
|
$success or croak "Failed to fetch '$url': $reason";
|
|
} else {
|
|
croak 'Missing success in return value';
|
|
}
|
|
|
|
defined ( my $content = $result->{'content'} )
|
|
or croak 'Missing content in return value';
|
|
|
|
eval { $decoded_result = decode_json $content; 1 }
|
|
or do { croak "Couldn't decode '$content': $@" };
|
|
|
|
return $decoded_result;
|
|
}
|
|
|
|
1;
|
|
|
|
__END__
|
|
|
|
=pod
|
|
|
|
=head1 NAME
|
|
|
|
MetaCPAN::API::Tiny - A Tiny API client for MetaCPAN
|
|
|
|
=head1 VERSION
|
|
|
|
version 1.131730
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
This is the Tiny version of L<MetaCPAN::API>. It implements a compatible API
|
|
with a few notable exceptions:
|
|
|
|
=over 4
|
|
|
|
=item Attributes are direct hash access
|
|
|
|
The attributes defined using Mo(o|u)se are now accessed via the blessed hash
|
|
directly. There are no accessors defined to access this elements.
|
|
|
|
=item Exception handling
|
|
|
|
Instead of using Try::Tiny, raw evals are used. This could potentially cause
|
|
issues, so just be aware.
|
|
|
|
=item Testing
|
|
|
|
Test::Fatal was replaced with an eval implementation of exception().
|
|
Test::TinyMocker usage is retained, but may be absorbed since it is pure perl
|
|
|
|
=back
|
|
|
|
=head1 CLASS_METHODS
|
|
|
|
=head2 new
|
|
|
|
new is the constructor for MetaCPAN::API::Tiny. In the non-tiny version of this
|
|
module, this is provided via Any::Moose built from the attributes defined. In
|
|
the tiny version, we define our own constructor. It takes the same arguments
|
|
and provides similar checks to MetaCPAN::API with regards to arguments passed.
|
|
|
|
=head1 PUBLIC_METHODS
|
|
|
|
=head2 source
|
|
|
|
my $source = $mcpan->source(
|
|
author => 'DOY',
|
|
release => 'Moose-2.0201',
|
|
path => 'lib/Moose.pm',
|
|
);
|
|
|
|
Searches MetaCPAN for a module or a specific release and returns the plain source.
|
|
|
|
=head2 release
|
|
|
|
my $result = $mcpan->release( distribution => 'Moose' );
|
|
|
|
# or
|
|
my $result = $mcpan->release( author => 'DOY', release => 'Moose-2.0001' );
|
|
|
|
Searches MetaCPAN for a dist.
|
|
|
|
You can do complex searches using 'search' parameter:
|
|
|
|
# example lifted from MetaCPAN docs
|
|
my $result = $mcpan->release(
|
|
search => {
|
|
author => "OALDERS AND ",
|
|
filter => "status:latest",
|
|
fields => "name",
|
|
size => 1,
|
|
},
|
|
);
|
|
|
|
=head2 pod
|
|
|
|
my $result = $mcpan->pod( module => 'Moose' );
|
|
|
|
# or
|
|
my $result = $mcpan->pod(
|
|
author => 'DOY',
|
|
release => 'Moose-2.0201',
|
|
path => 'lib/Moose.pm',
|
|
);
|
|
|
|
Searches MetaCPAN for a module or a specific release and returns the POD.
|
|
|
|
=head2 module
|
|
|
|
my $result = $mcpan->module('MetaCPAN::API');
|
|
|
|
Searches MetaCPAN and returns a module's ".pm" file.
|
|
|
|
=head2 file
|
|
|
|
A synonym of L</module>
|
|
|
|
=head2 author
|
|
|
|
my $result1 = $mcpan->author('XSAWYERX');
|
|
my $result2 = $mcpan->author( pauseid => 'XSAWYERX' );
|
|
|
|
Searches MetaCPAN for a specific author.
|
|
|
|
You can do complex searches using 'search' parameter:
|
|
|
|
# example lifted from MetaCPAN docs
|
|
my $result = $mcpan->author(
|
|
search => {
|
|
q => 'profile.name:twitter',
|
|
size => 1,
|
|
},
|
|
);
|
|
|
|
=head2 fetch
|
|
|
|
my $result = $mcpan->fetch('/release/distribution/Moose');
|
|
|
|
# with parameters
|
|
my $more = $mcpan->fetch(
|
|
'/release/distribution/Moose',
|
|
param => 'value',
|
|
);
|
|
|
|
This is a helper method for API implementations. It fetches a path from MetaCPAN, decodes the JSON from the content variable and returns it.
|
|
|
|
You don't really need to use it, but you can in case you want to write your own extension implementation to MetaCPAN::API.
|
|
|
|
It accepts an additional hash as "GET" parameters.
|
|
|
|
=head2 post
|
|
|
|
# /release&content={"query":{"match_all":{}},"filter":{"prefix":{"archive":"Cache-Cache-1.06"}}}
|
|
my $result = $mcpan->post(
|
|
'release',
|
|
{
|
|
query => { match_all => {} },
|
|
filter => { prefix => { archive => 'Cache-Cache-1.06' } },
|
|
},
|
|
);
|
|
|
|
The POST equivalent of the "fetch()" method. It gets the path and JSON request.
|
|
|
|
=head1 THANKS
|
|
|
|
Overall the tests and code were ripped directly from MetaCPAN::API and
|
|
tiny-fied. A big thanks to Sawyer X for writing the original module.
|
|
|
|
=head1 AUTHOR
|
|
|
|
Nicholas R. Perez <nperez@cpan.org>
|
|
|
|
=head1 COPYRIGHT AND LICENSE
|
|
|
|
This software is copyright (c) 2013 by Nicholas R. Perez <nperez@cpan.org>.
|
|
|
|
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
|
|
METACPAN_API_TINY
|
|
|
|
s/^ //mg for values %fatpacked;
|
|
|
|
unshift @INC, sub {
|
|
if (my $fat = $fatpacked{$_[1]}) {
|
|
if ($] < 5.008) {
|
|
return sub {
|
|
return 0 unless length $fat;
|
|
$fat =~ s/^([^\n]*\n?)//;
|
|
$_ = $1;
|
|
return 1;
|
|
};
|
|
}
|
|
open my $fh, '<', \$fat
|
|
or die "FatPacker error loading $_[1] (could be a perl installation issue?)";
|
|
return $fh;
|
|
}
|
|
return
|
|
};
|
|
|
|
} # END OF FATPACK CODE
|
|
|
|
|
|
use 5.010;
|
|
use strict;
|
|
use warnings;
|
|
use Fatal qw(open close);
|
|
|
|
use Getopt::Long;
|
|
use Pod::Usage;
|
|
use File::Basename;
|
|
use File::Path qw(make_path);
|
|
use Module::CoreList;
|
|
use HTTP::Tiny;
|
|
use Safe;
|
|
use MetaCPAN::API::Tiny;
|
|
use Digest::SHA qw(sha256_hex);
|
|
use Text::Wrap;
|
|
$Text::Wrap::columns = 62;
|
|
|
|
# Below, 5.030 should be aligned with the version of perl actually
|
|
# bundled in Buildroot:
|
|
die <<"MSG" if $] < 5.030;
|
|
This script needs a host perl with the same major version as Buildroot target perl.
|
|
|
|
Your current host perl is:
|
|
$^X
|
|
version $]
|
|
|
|
You may install a local one by running:
|
|
perlbrew install perl-5.30.0
|
|
MSG
|
|
|
|
my ($help, $man, $quiet, $force, $recommend, $test, $host);
|
|
my $target = 1;
|
|
GetOptions( 'help|?' => \$help,
|
|
'man' => \$man,
|
|
'quiet|q' => \$quiet,
|
|
'force|f' => \$force,
|
|
'host!' => \$host,
|
|
'target!' => \$target,
|
|
'recommend' => \$recommend,
|
|
'test' => \$test
|
|
) or pod2usage(-exitval => 1);
|
|
pod2usage(-exitval => 0) if $help;
|
|
pod2usage(-exitval => 0, -verbose => 2) if $man;
|
|
pod2usage(-exitval => 1) if scalar @ARGV == 0;
|
|
|
|
my %dist; # name -> metacpan data
|
|
my %need_target; # name -> 1 if target package is needed
|
|
my %need_host; # name -> 1 if host package is needed
|
|
my %need_dlopen; # name -> 1 if requires dynamic library
|
|
my %is_xs; # name -> 1 if XS module
|
|
my %deps_build; # name -> list of host dependencies
|
|
my %deps_runtime; # name -> list of target dependencies
|
|
my %license_files; # name -> hash of license files
|
|
my %checksum; # author -> list of checksum
|
|
my $mirror = 'http://cpan.metacpan.org'; # a CPAN mirror
|
|
my $mcpan = MetaCPAN::API::Tiny->new(base_url => 'http://fastapi.metacpan.org/v1');
|
|
my $ua = HTTP::Tiny->new();
|
|
my $new_pkgs;
|
|
|
|
my %white_list = (
|
|
'ExtUtils-Config' => 1,
|
|
'ExtUtils-InstallPaths' => 1,
|
|
'ExtUtils-Helpers' => 1,
|
|
'File-ShareDir-Install' => 1,
|
|
'Module-Build' => 1,
|
|
'Module-Build-Tiny' => 1,
|
|
);
|
|
my @info = ();
|
|
|
|
sub get_checksum {
|
|
my ($url) = @_;
|
|
my ($path) = $url =~ m|^[^:/?#]+://[^/?#]*([^?#]*)|;
|
|
my ($basename, $dirname) = fileparse( $path );
|
|
unless ($checksum{$dirname}) {
|
|
my $url = $mirror . $dirname . q{CHECKSUMS};
|
|
my $response = $ua->get($url);
|
|
$checksum{$dirname} = $response->{content};
|
|
}
|
|
my $chksum = Safe->new->reval($checksum{$dirname});
|
|
return $chksum->{$basename}, $basename;
|
|
}
|
|
|
|
sub is_xs {
|
|
my ($manifest) = @_;
|
|
# This heuristic determines if a module is a native extension, by searching
|
|
# some file extension types in the MANIFEST of the distribution.
|
|
# It was inspired by http://deps.cpantesters.org/static/purity.html
|
|
return $manifest =~ m/\.(swg|xs|c|h|i)[\n\s]/;
|
|
}
|
|
|
|
sub find_license_files {
|
|
my ($manifest) = @_;
|
|
my @license_files;
|
|
foreach (split /\n/, $manifest) {
|
|
next if m|/|;
|
|
s|\s+.*$||;
|
|
push @license_files, $_ if m/(ARTISTIC|COPYING|COPYRIGHT|LICENSE|LICENCE)/i;
|
|
}
|
|
if (scalar @license_files == 0 && $manifest =~ m/(README)[\n\s]/i) {
|
|
@license_files = ($1);
|
|
}
|
|
if (scalar @license_files == 0 && $manifest =~ m/(README\.md)[\n\s]/i) {
|
|
@license_files = ($1);
|
|
}
|
|
return @license_files;
|
|
}
|
|
|
|
sub want_test {
|
|
my ($distname) = @_;
|
|
return 1 if $need_dlopen{$distname} && scalar @{$deps_runtime{$distname}} > 0;
|
|
}
|
|
|
|
sub get_dependencies {
|
|
my ($distname) = @_;
|
|
my %dep = map { $_ => 1 } @{$deps_runtime{$distname}};
|
|
for my $direct (@{$deps_runtime{$distname}}) {
|
|
for (get_dependencies( $direct )) {
|
|
$dep{$_} = 1;
|
|
}
|
|
}
|
|
return keys %dep;
|
|
}
|
|
|
|
sub get_indirect_dependencies {
|
|
my ($distname) = @_;
|
|
my %indirect;
|
|
my %direct = map { $_ => 1 } @{$deps_runtime{$distname}};
|
|
for my $dep (get_dependencies( $distname )) {
|
|
$indirect{$dep} = 1 unless exists $direct{$dep};
|
|
}
|
|
return keys %indirect;
|
|
}
|
|
|
|
sub fetch {
|
|
my ($name, $need_target, $need_host, $top) = @_;
|
|
$need_target{$name} = $need_target if $need_target;
|
|
$need_host{$name} = $need_host if $need_host;
|
|
unless ($dist{$name} && !$top) {
|
|
say qq{fetch ${name}} unless $quiet;
|
|
my $result = $mcpan->release( distribution => $name );
|
|
my $main_module = $result->{main_module};
|
|
push @info, qq{[$name] $main_module is a core module}
|
|
if $top && Module::CoreList::is_core( $main_module, undef, $] );
|
|
$dist{$name} = $result;
|
|
$license_files{$name} = {};
|
|
eval {
|
|
my $author = $result->{author};
|
|
my $release = $name . q{-} . $result->{version};
|
|
my $manifest = $mcpan->source( author => $author, release => $release, path => 'MANIFEST' );
|
|
$need_dlopen{$name} = $is_xs{$name} = is_xs( $manifest );
|
|
foreach my $fname (find_license_files( $manifest )) {
|
|
my $license = $mcpan->source( author => $author, release => $release, path => $fname );
|
|
$license_files{$name}->{$fname} = sha256_hex( $license );
|
|
}
|
|
};
|
|
if ($@) {
|
|
warn $@;
|
|
}
|
|
my %build = ();
|
|
my %runtime = ();
|
|
my %optional = ();
|
|
foreach my $dep (@{$result->{dependency}}) {
|
|
my $modname = ${$dep}{module};
|
|
next if $modname eq q{perl};
|
|
next if $modname =~ m|^Alien|;
|
|
next if $modname =~ m|^Win32|;
|
|
next if !($test && $top) && $modname =~ m|^Test|;
|
|
next if Module::CoreList::is_core( $modname, undef, $] );
|
|
# we could use the host Module::CoreList data, because host perl and
|
|
# target perl have the same major version
|
|
next if ${$dep}{phase} eq q{develop};
|
|
next if ${$dep}{phase} eq q{x_Dist_Zilla};
|
|
next if !($test && $top) && ${$dep}{phase} eq q{test};
|
|
my $distname = $mcpan->module( $modname )->{distribution};
|
|
if (${$dep}{phase} eq q{runtime}) {
|
|
if (${$dep}{relationship} eq q{requires}) {
|
|
$runtime{$distname} = 1;
|
|
}
|
|
else {
|
|
$optional{$distname} = 1 if $recommend && $top;
|
|
}
|
|
}
|
|
else { # configure, build
|
|
$build{$distname} = 1;
|
|
push @info, qq{[$name] suspicious dependency on $distname}
|
|
unless exists $white_list{$distname};
|
|
}
|
|
}
|
|
$deps_build{$name} = [keys %build];
|
|
$deps_runtime{$name} = [keys %runtime];
|
|
foreach my $distname (@{$deps_build{$name}}) {
|
|
fetch( $distname, 0, 1 );
|
|
}
|
|
foreach my $distname (@{$deps_runtime{$name}}) {
|
|
fetch( $distname, $need_target, $need_host );
|
|
$need_dlopen{$name} ||= $need_dlopen{$distname};
|
|
}
|
|
foreach my $distname (keys %optional) {
|
|
fetch( $distname, $need_target, $need_host );
|
|
}
|
|
}
|
|
return;
|
|
}
|
|
|
|
foreach my $distname (@ARGV) {
|
|
# Command-line's distributions
|
|
fetch( $distname, !!$target, !!$host, 1 );
|
|
}
|
|
say scalar keys %dist, q{ packages fetched.} unless $quiet;
|
|
|
|
# Buildroot package name: lowercase
|
|
sub fsname {
|
|
my $name = shift;
|
|
$name =~ s|_|-|g;
|
|
return q{perl-} . lc $name;
|
|
}
|
|
|
|
# Buildroot variable name: uppercase
|
|
sub brname {
|
|
my $name = shift;
|
|
$name =~ s|-|_|g;
|
|
return uc $name;
|
|
}
|
|
|
|
# Buildroot requires license name as in http://spdx.org/licenses/
|
|
sub brlicense {
|
|
my $license = shift;
|
|
$license =~ s|apache_1_1|Apache-1.1|;
|
|
$license =~ s|apache_2_0|Apache-2.0|;
|
|
$license =~ s|artistic_2|Artistic-2.0|;
|
|
$license =~ s|artistic|Artistic-1.0|;
|
|
$license =~ s|lgpl_2_1|LGPL-2.1|;
|
|
$license =~ s|lgpl_3_0|LGPL-3.0|;
|
|
$license =~ s|gpl_2|GPL-2.0|;
|
|
$license =~ s|gpl_3|GPL-3.0|;
|
|
$license =~ s|mit|MIT|;
|
|
$license =~ s|mozilla_1_1|Mozilla-1.1|;
|
|
$license =~ s|openssl|OpenSSL|;
|
|
$license =~ s|perl_5|Artistic or GPL-1.0+|;
|
|
return $license;
|
|
}
|
|
|
|
while (my ($distname, $dist) = each %dist) {
|
|
my $fsname = fsname( $distname );
|
|
my $dirname = q{package/} . $fsname;
|
|
my $cfgname = $dirname . q{/Config.in};
|
|
my $mkname = $dirname . q{/} . $fsname . q{.mk};
|
|
my $hashname = $dirname . q{/} . $fsname . q{.hash};
|
|
my $brname = brname( $fsname );
|
|
my $testdir = q{support/testing/tests/package};
|
|
my $testname = $testdir . q{/test_} . lc $brname . q{.py};
|
|
unless (-d $dirname) {
|
|
make_path $dirname;
|
|
$new_pkgs = 1;
|
|
}
|
|
if ($need_target{$distname} && ($force || !-f $cfgname)) {
|
|
$dist->{abstract} =~ s|\s+$||;
|
|
$dist->{abstract} .= q{.} unless $dist->{abstract} =~ m|\.$|;
|
|
my $abstract = wrap( q{}, qq{\t }, $dist->{abstract} );
|
|
my $homepage = $dist->{resources}->{homepage} || qq{https://metacpan.org/release/${distname}};
|
|
say qq{write ${cfgname}} unless $quiet;
|
|
open my $fh, q{>}, $cfgname;
|
|
say {$fh} qq{config BR2_PACKAGE_${brname}};
|
|
say {$fh} qq{\tbool "${fsname}"};
|
|
say {$fh} qq{\tdepends on !BR2_STATIC_LIBS} if $need_dlopen{$distname};
|
|
foreach my $dep (sort @{$deps_runtime{$distname}}) {
|
|
my $brdep = brname( fsname( $dep ) );
|
|
say {$fh} qq{\tselect BR2_PACKAGE_${brdep} # runtime};
|
|
}
|
|
say {$fh} qq{\thelp};
|
|
say {$fh} qq{\t ${abstract}\n} if $abstract;
|
|
say {$fh} qq{\t ${homepage}};
|
|
if ($need_dlopen{$distname}) {
|
|
say {$fh} qq{\ncomment "${fsname} needs a toolchain w/ dynamic library"};
|
|
say {$fh} qq{\tdepends on BR2_STATIC_LIBS};
|
|
}
|
|
close $fh;
|
|
}
|
|
if ($force || !-f $mkname) {
|
|
my $version = $dist->{version};
|
|
my ($path) = $dist->{download_url} =~ m|^[^:/?#]+://[^/?#]*([^?#]*)|;
|
|
# this URL contains only the scheme, auth and path parts (but no query and fragment parts)
|
|
# the scheme is not used, because the job is done by the BR download infrastructure
|
|
# the auth part is not used, because we use $(BR2_CPAN_MIRROR)
|
|
my ($filename, $directories, $suffix) = fileparse( $path, q{tar.gz}, q{tgz} );
|
|
$directories =~ s|/$||;
|
|
my @dependencies = map( { q{host-} . fsname( $_ ); } sort @{$deps_build{$distname}} );
|
|
my $dependencies = join qq{ \\\n\t}, @dependencies;
|
|
$dependencies = qq{\\\n\t} . $dependencies if scalar @dependencies > 1;
|
|
my @host_dependencies = map { q{host-} . fsname( $_ ); } sort( @{$deps_build{$distname}},
|
|
@{$deps_runtime{$distname}} );
|
|
my $host_dependencies = join qq{ \\\n\t}, @host_dependencies;
|
|
$host_dependencies = qq{\\\n\t} . $host_dependencies if scalar @host_dependencies > 1;
|
|
my $license = brlicense( ref $dist->{license} eq 'ARRAY'
|
|
? join q{ or }, @{$dist->{license}}
|
|
: $dist->{license} );
|
|
my $license_files = join q{ }, sort keys %{$license_files{$distname}};
|
|
if ($license_files && (!$license || $license eq q{unknown})) {
|
|
push @info, qq{[$distname] undefined LICENSE, see $license_files};
|
|
$license = q{???};
|
|
}
|
|
say qq{write ${mkname}} unless $quiet;
|
|
open my $fh, q{>}, $mkname;
|
|
say {$fh} qq{################################################################################};
|
|
say {$fh} qq{#};
|
|
say {$fh} qq{# ${fsname}};
|
|
say {$fh} qq{#};
|
|
say {$fh} qq{################################################################################};
|
|
say {$fh} qq{};
|
|
say {$fh} qq{${brname}_VERSION = ${version}};
|
|
say {$fh} qq{${brname}_SOURCE = ${distname}-\$(${brname}_VERSION).${suffix}};
|
|
say {$fh} qq{${brname}_SITE = \$(BR2_CPAN_MIRROR)${directories}};
|
|
say {$fh} qq{${brname}_DEPENDENCIES = ${dependencies}} if $need_target{$distname} && $dependencies;
|
|
say {$fh} qq{HOST_${brname}_DEPENDENCIES = ${host_dependencies}} if $need_host{$distname} && $host_dependencies;
|
|
say {$fh} qq{${brname}_LICENSE = ${license}} if $license;
|
|
say {$fh} qq{${brname}_LICENSE_FILES = ${license_files}} if $license_files;
|
|
say {$fh} qq{${brname}_DISTNAME = ${distname}};
|
|
say {$fh} qq{};
|
|
say {$fh} qq{\$(eval \$(perl-package))} if $need_target{$distname};
|
|
say {$fh} qq{\$(eval \$(host-perl-package))} if $need_host{$distname};
|
|
close $fh;
|
|
}
|
|
if ($force || !-f $hashname) {
|
|
my ($checksum, $filename) = get_checksum($dist->{download_url});
|
|
my $md5 = $checksum->{md5};
|
|
my $sha256 = $checksum->{sha256};
|
|
say qq{write ${hashname}} unless $quiet;
|
|
open my $fh, q{>}, $hashname;
|
|
say {$fh} qq{# retrieved by scancpan from ${mirror}/};
|
|
say {$fh} qq{md5 ${md5} ${filename}};
|
|
say {$fh} qq{sha256 ${sha256} ${filename}};
|
|
my %license_files = %{$license_files{$distname}};
|
|
if (scalar keys %license_files) {
|
|
say {$fh} q{};
|
|
say {$fh} qq{# computed by scancpan};
|
|
foreach my $license (sort keys %license_files) {
|
|
my $digest = $license_files{$license};
|
|
say {$fh} qq{sha256 ${digest} ${license}};
|
|
}
|
|
}
|
|
close $fh;
|
|
}
|
|
if (want_test( $distname ) && ($force || !-f $testname)) {
|
|
my $classname = $distname;
|
|
$classname =~ s|-||g;
|
|
my $modname = $distname;
|
|
$modname =~ s|-|::|g;
|
|
my $mark = $is_xs{$distname} ? q{ XS} : q{};
|
|
my @indirect = (get_indirect_dependencies( $distname ));
|
|
say qq{write ${testname}} unless $quiet;
|
|
make_path $testdir unless -d $testdir;
|
|
open my $fh, q{>}, $testname;
|
|
say {$fh} qq{from tests.package.test_perl import TestPerlBase};
|
|
say {$fh} qq{};
|
|
say {$fh} qq{};
|
|
say {$fh} qq{class TestPerl${classname}(TestPerlBase):};
|
|
say {$fh} qq{ """};
|
|
say {$fh} qq{ package:};
|
|
say {$fh} qq{ ${distname}${mark}};
|
|
say {$fh} qq{ direct dependencies:};
|
|
foreach my $dep (sort @{$deps_runtime{$distname}}) {
|
|
$mark = $is_xs{$dep} ? q{ XS} : q{};
|
|
say {$fh} qq{ ${dep}${mark}};
|
|
}
|
|
if (scalar @indirect > 0) {
|
|
say {$fh} qq{ indirect dependencies:};
|
|
foreach my $dep (sort @indirect) {
|
|
$mark = $is_xs{$dep} ? q{ XS} : q{};
|
|
say {$fh} qq{ ${dep}${mark}};
|
|
}
|
|
}
|
|
say {$fh} qq{ """};
|
|
say {$fh} qq{};
|
|
say {$fh} qq{ config = TestPerlBase.config + \\};
|
|
say {$fh} qq{ """};
|
|
say {$fh} qq{ BR2_PACKAGE_PERL=y};
|
|
say {$fh} qq{ BR2_PACKAGE_${brname}=y};
|
|
say {$fh} qq{ """};
|
|
say {$fh} qq{};
|
|
say {$fh} qq{ def test_run(self):};
|
|
say {$fh} qq{ self.login()};
|
|
foreach my $dep (sort grep { $is_xs{$_} } @indirect) {
|
|
$dep =~ s|-|::|g;
|
|
say {$fh} qq{ self.module_test("${dep}")};
|
|
}
|
|
foreach my $dep (sort grep { $is_xs{$_} } @{$deps_runtime{$distname}}) {
|
|
$dep =~ s|-|::|g;
|
|
say {$fh} qq{ self.module_test("${dep}")};
|
|
}
|
|
say {$fh} qq{ self.module_test("${modname}")};
|
|
close $fh;
|
|
}
|
|
}
|
|
|
|
if ($new_pkgs) {
|
|
my %pkg;
|
|
my $cfgname = q{package/Config.in};
|
|
if (-f $cfgname) {
|
|
open my $fh, q{<}, $cfgname;
|
|
while (<$fh>) {
|
|
chomp;
|
|
$pkg{$_} = 1 if m|package/perl-|;
|
|
}
|
|
close $fh;
|
|
}
|
|
|
|
foreach my $distname (keys %need_target) {
|
|
my $fsname = fsname( $distname );
|
|
$pkg{qq{\tsource "package/${fsname}/Config.in"}} = 1;
|
|
}
|
|
|
|
say qq{${cfgname} must contain the following lines:};
|
|
say join qq{\n}, sort keys %pkg;
|
|
}
|
|
|
|
say join qq{\n}, @info;
|
|
|
|
__END__
|
|
|
|
=head1 NAME
|
|
|
|
utils/scancpan Try-Tiny Moo
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
utils/scancpan [options] [distname ...]
|
|
|
|
Options:
|
|
-help
|
|
-man
|
|
-quiet
|
|
-force
|
|
-target/-notarget
|
|
-host/-nohost
|
|
-recommend
|
|
-test
|
|
|
|
=head1 OPTIONS
|
|
|
|
=over 8
|
|
|
|
=item B<-help>
|
|
|
|
Prints a brief help message and exits.
|
|
|
|
=item B<-man>
|
|
|
|
Prints the manual page and exits.
|
|
|
|
=item B<-quiet>
|
|
|
|
Executes without output
|
|
|
|
=item B<-force>
|
|
|
|
Forces the overwriting of existing files.
|
|
|
|
=item B<-target/-notarget>
|
|
|
|
Switches package generation for the target variant (the default is C<-target>).
|
|
|
|
=item B<-host/-nohost>
|
|
|
|
Switches package generation for the host variant (the default is C<-nohost>).
|
|
|
|
=item B<-recommend>
|
|
|
|
Adds I<recommended> dependencies.
|
|
|
|
=item B<-test>
|
|
|
|
Adds dependencies for test.
|
|
|
|
=back
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
This script creates templates of the Buildroot package files for all the
|
|
Perl/CPAN distributions required by the specified distnames. The
|
|
dependencies and metadata are fetched from https://metacpan.org/.
|
|
|
|
After running this script, it is necessary to check the generated files.
|
|
For distributions that link against a target library, you have to add the
|
|
buildroot package name for that library to the DEPENDENCIES variable.
|
|
|
|
See the Buildroot documentation for details on the usage of the Perl
|
|
infrastructure.
|
|
|
|
The major version of the host perl must be aligned on the target one,
|
|
in order to work with the right CoreList data.
|
|
|
|
=head1 LICENSE
|
|
|
|
Copyright (C) 2013-2019 by Francois Perrad <francois.perrad@gadz.org>
|
|
|
|
This program is free software; you can redistribute it and/or modify
|
|
it under the terms of the GNU General Public License as published by
|
|
the Free Software Foundation; either version 2 of the License, or
|
|
(at your option) any later version.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
along with this program; if not, write to the Free Software
|
|
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
|
|
|
This script is a part of Buildroot.
|
|
|
|
This script requires the module C<MetaCPAN::API::Tiny> (version 1.131730)
|
|
which was included at the beginning of this file by the tool C<fatpack>.
|
|
|
|
See L<https://metacpan.org/release/NPEREZ/MetaCPAN-API-Tiny-1.131730>.
|
|
|
|
See L<https://metacpan.org/release/App-FatPacker>.
|
|
|
|
These both libraries are free software and may be distributed under the same
|
|
terms as perl itself.
|
|
|
|
And perl may be distributed under the terms of Artistic v1 or GPL v1 license.
|
|
|
|
=cut
|