[Buildroot] [pkg-perl infra 02/12] cpan: a home for Perl modules
Francois Perrad
fperrad at gmail.com
Wed Nov 20 17:01:50 UTC 2013
Signed-off-by: Francois Perrad <francois.perrad at gadz.org>
---
Config.in | 7 +
package/Config.in | 1 +
package/cpan/cpan.mk | 1 +
scancpan | 629 ++++++++++++++++++++++++++++++++++++++++++++++++++
4 files changed, 638 insertions(+)
create mode 100644 package/cpan/Config.in
create mode 100644 package/cpan/cpan.mk
create mode 100755 scancpan
diff --git a/Config.in b/Config.in
index d87e0f0..1b4bf99 100644
--- a/Config.in
+++ b/Config.in
@@ -207,6 +207,13 @@ config BR2_DEBIAN_MIRROR
endif
+config BR2_CPAN_MIRROR
+ string "CPAN mirror"
+ default "http://search.cpan.org/CPAN"
+ help
+ CPAN has multiple software mirrors scattered around the world.
+ The following allows you to select your preferred mirror.
+
endmenu
config BR2_JLEVEL
diff --git a/package/Config.in b/package/Config.in
index 311cc6c..3f7bb3e 100644
--- a/package/Config.in
+++ b/package/Config.in
@@ -382,6 +382,7 @@ source "package/perl/Config.in"
if BR2_PACKAGE_PERL
menu "Perl libraries/modules"
source "package/cpanminus/Config.in"
+source "package/cpan/Config.in"
endmenu
endif
source "package/php/Config.in"
diff --git a/package/cpan/Config.in b/package/cpan/Config.in
new file mode 100644
index 0000000..e69de29
diff --git a/package/cpan/cpan.mk b/package/cpan/cpan.mk
new file mode 100644
index 0000000..764a156
--- /dev/null
+++ b/package/cpan/cpan.mk
@@ -0,0 +1 @@
+include package/cpan/*/*.mk
diff --git a/scancpan b/scancpan
new file mode 100755
index 0000000..d8a68d6
--- /dev/null
+++ b/scancpan
@@ -0,0 +1,629 @@
+#!/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 at cpan.org>
+
+ =head1 COPYRIGHT AND LICENSE
+
+ This software is copyright (c) 2013 by Nicholas R. Perez <nperez at 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 File::Basename;
+use Module::CoreList;
+use MetaCPAN::API::Tiny;
+
+if (scalar @ARGV != 1) {
+ say << 'USAGE';
+Usage: scancpan distname
+
+This script populates the directory package/cpan with all the Perl/CPAN
+distributions required by distname. These data are fetched from
+https://metacpan.org/.
+
+ ./scancpan Try-Tiny
+
+See the Buildroot documentation for details on the usage of the Perl
+infrastructure.
+USAGE
+ exit -1;
+}
+
+my %dist;
+my %deps_build;
+my %deps_runtime;
+my $mcpan = MetaCPAN::API::Tiny->new();
+
+sub fetch {
+ my $name = shift;
+ unless ($dist{$name}) {
+ say qq{fetch ${name}};
+ my $result = $mcpan->release( distribution => $name );
+ $dist{$name} = $result;
+ my @deps_build = ();
+ my @deps_runtime = ();
+ 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 Module::CoreList::first_release( $modname );
+ next if ${$dep}{phase} eq q{develop};
+ next if ${$dep}{phase} eq q{test};
+ next if ${$dep}{relationship} ne q{requires};
+ my $distname = $mcpan->module( $modname )->{distribution};
+ if (${$dep}{phase} eq q{runtime}) {
+ push @deps_runtime, $distname;
+ }
+ else { # configure, build
+ push @deps_build, $distname;
+ }
+ fetch( $distname );
+ }
+ $deps_build{$name} = \@deps_build;
+ $deps_runtime{$name} = \@deps_runtime;
+ }
+ return;
+}
+
+fetch( @ARGV );
+say scalar keys %dist, q{ packages fetched.};
+
+sub debname {
+ my $name = shift;
+ if ($name =~ m|-perl$|) {
+ return $name;
+ }
+ else {
+ return q{lib} . lc $name . q{-perl};
+ }
+}
+
+sub brname {
+ my $name = shift;
+ $name =~ s|-|_|g;
+ return uc $name;
+}
+
+while (my ($distname, $dist) = each %dist) {
+ my $debname = debname( $distname );
+ my $dirname = q{package/cpan/} . $debname;
+ my $cfgname = $dirname . q{/Config.in};
+ my $mkname = $dirname . q{/} . $debname . q{.mk};
+ my $brname = brname( $debname );
+ mkdir $dirname unless -d $dirname;
+ unless (-f $cfgname) {
+ my $abstract = $dist->{abstract} || q{NO ABSTRACT};
+ say qq{write ${cfgname}};
+ open my $fh, q{>}, $cfgname;
+ say {$fh} qq{config BR2_PACKAGE_${brname}};
+ say {$fh} qq{\tbool "${debname}"};
+ foreach my $dep (@{$deps_runtime{$distname}}) {
+ my $brdep = brname( debname( $dep ) );
+ say {$fh} qq{\tselect BR2_PACKAGE_${brdep}};
+ }
+ say {$fh} qq{\thelp};
+ say {$fh} qq{\t ${abstract}};
+ say {$fh} qq{};
+ close $fh;
+ }
+ unless (-f $mkname) {
+ my $version = $dist->{version};
+ my $author = $dist->{author};
+ my $site = dirname( $dist->{download_url} );
+ my($scheme, $auth, $path) = $dist->{download_url} =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)|;
+ my($filename, $directories, $suffix) = fileparse( $path, q{tar.gz}, q{tgz} );
+ my $dependencies = join q{ }, map( { q{host-} . debname( $_ ); } @{$deps_build{$distname}} ),
+ map( { debname( $_ ); } @{$deps_runtime{$distname}} );
+ my $host_dependencies = join q{ }, map { q{host-} . debname( $_ ); } @{$deps_build{$distname}},
+ @{$deps_runtime{$distname}};
+ my $license = join q{ }, @{$dist->{license}};
+ say qq{write ${mkname}};
+ open my $fh, q{>}, $mkname;
+ say {$fh} qq{################################################################################};
+ say {$fh} qq{#};
+ say {$fh} qq{# ${debname}};
+ say {$fh} qq{#};
+ say {$fh} qq{################################################################################};
+ say {$fh} qq{};
+ say {$fh} qq{${brname}_VERSION = ${version}};
+ say {$fh} qq{${brname}_AUTHOR = ${author}};
+ say {$fh} qq{${brname}_SOURCE = ${distname}-\$(${brname}_VERSION).${suffix}};
+ say {$fh} qq{${brname}_SITE = \$(BR2_CPAN_MIRROR)${directories}};
+ say {$fh} qq{${brname}_DEPENDENCIES = perl ${dependencies}};
+ say {$fh} qq{HOST_${brname}_DEPENDENCIES = ${host_dependencies}};
+ say {$fh} qq{${brname}_LICENSE = ${license}} if $license && $license ne q{unknown};
+ say {$fh} qq{};
+ say {$fh} qq{\$(eval \$(perl-package))};
+ say {$fh} qq{\$(eval \$(host-perl-package))};
+ close $fh;
+ }
+}
+
+my %pkg;
+my $cfgname = q{package/cpan/Config.in};
+say qq{read ${cfgname}};
+open my $fh, q{<}, $cfgname;
+while (<$fh>) {
+ chomp;
+ $pkg{$_} = 1;
+}
+close $fh;
+
+foreach my $distname (sort keys %dist) {
+ my $debname = debname( $distname );
+ $pkg{qq{source "package/cpan/${debname}/Config.in"}} = 1;
+}
+
+say qq{write ${cfgname}};
+open $fh, q{>}, $cfgname;
+say {$fh} join qq{\n}, sort keys %pkg;
+close $fh;
+
--
1.7.9.5
More information about the buildroot
mailing list