busybox: use SED macro instead of 'sed -i'
[buildroot-gz.git] / support / scripts / scancpan
blobd8723f35b01b2d3653089f272da520a918ada138
1 #!/usr/bin/env perl
3 # This chunk of stuff was generated by App::FatPacker. To find the original
4 # file's code, look for the end of this BEGIN block or the string 'FATPACK'
5 BEGIN {
6 my %fatpacked;
8 $fatpacked{"MetaCPAN/API/Tiny.pm"} = <<'METACPAN_API_TINY';
9 package MetaCPAN::API::Tiny;
11 $MetaCPAN::API::Tiny::VERSION = '1.131730';
13 use strict;
14 use warnings;
15 # ABSTRACT: A Tiny API client for MetaCPAN
17 use Carp;
18 use JSON::PP 'encode_json', 'decode_json';
19 use HTTP::Tiny;
22 sub new {
23 my ($class, @args) = @_;
25 $#_ % 2 == 0
26 or croak 'Arguments must be provided as name/value pairs';
28 my %params = @args;
30 die 'ua_args must be an array reference'
31 if $params{ua_args} && ref($params{ua_args}) ne 'ARRAY';
33 my $self = +{
34 base_url => $params{base_url} || 'http://api.metacpan.org/v0',
35 ua => $params{ua} || HTTP::Tiny->new(
36 $params{ua_args}
37 ? @{$params{ua_args}}
38 : (agent => 'MetaCPAN::API::Tiny/'
39 . ($MetaCPAN::API::VERSION || 'xx'))),
42 return bless($self, $class);
45 sub _build_extra_params {
46 my $self = shift;
48 @_ % 2 == 0
49 or croak 'Incorrect number of params, must be key/value';
51 my %extra = @_;
52 my $ua = $self->{ua};
54 foreach my $key (keys %extra)
56 # The implementation in HTTP::Tiny uses + instead of %20, fix that
57 $extra{$key} = $ua->_uri_escape($extra{$key});
58 $extra{$key} =~ s/\+/%20/g;
61 my $params = join '&', map { "$_=" . $extra{$_} } sort keys %extra;
63 return $params;
67 # /source/{author}/{release}/{path}
68 sub source {
69 my $self = shift;
70 my %opts = @_ ? @_ : ();
71 my $url = '';
72 my $error = "Provide 'author' and 'release' and 'path'";
74 %opts or croak $error;
76 if (
77 defined ( my $author = $opts{'author'} ) &&
78 defined ( my $release = $opts{'release'} ) &&
79 defined ( my $path = $opts{'path'} )
80 ) {
81 $url = "source/$author/$release/$path";
82 } else {
83 croak $error;
86 $url = $self->{base_url} . "/$url";
88 my $result = $self->{ua}->get($url);
89 $result->{'success'}
90 or croak "Failed to fetch '$url': " . $result->{'reason'};
92 return $result->{'content'};
96 # /release/{distribution}
97 # /release/{author}/{release}
98 sub release {
99 my $self = shift;
100 my %opts = @_ ? @_ : ();
101 my $url = '';
102 my $error = "Either provide 'distribution', or 'author' and 'release', " .
103 "or 'search'";
105 %opts or croak $error;
107 my %extra_opts = ();
109 if ( defined ( my $dist = $opts{'distribution'} ) ) {
110 $url = "release/$dist";
111 } elsif (
112 defined ( my $author = $opts{'author'} ) &&
113 defined ( my $release = $opts{'release'} )
115 $url = "release/$author/$release";
116 } elsif ( defined ( my $search_opts = $opts{'search'} ) ) {
117 ref $search_opts && ref $search_opts eq 'HASH'
118 or croak $error;
120 %extra_opts = %{$search_opts};
121 $url = 'release/_search';
122 } else {
123 croak $error;
126 return $self->fetch( $url, %extra_opts );
130 # /pod/{module}
131 # /pod/{author}/{release}/{path}
132 sub pod {
133 my $self = shift;
134 my %opts = @_ ? @_ : ();
135 my $url = '';
136 my $error = "Either provide 'module' or 'author and 'release' and 'path'";
138 %opts or croak $error;
140 if ( defined ( my $module = $opts{'module'} ) ) {
141 $url = "pod/$module";
142 } elsif (
143 defined ( my $author = $opts{'author'} ) &&
144 defined ( my $release = $opts{'release'} ) &&
145 defined ( my $path = $opts{'path'} )
147 $url = "pod/$author/$release/$path";
148 } else {
149 croak $error;
152 # check content-type
153 my %extra = ();
154 if ( defined ( my $type = $opts{'content-type'} ) ) {
155 $type =~ m{^ text/ (?: html|plain|x-pod|x-markdown ) $}x
156 or croak 'Incorrect content-type provided';
158 $extra{headers}{'content-type'} = $type;
161 $url = $self->{base_url}. "/$url";
163 my $result = $self->{ua}->get( $url, \%extra );
164 $result->{'success'}
165 or croak "Failed to fetch '$url': " . $result->{'reason'};
167 return $result->{'content'};
171 # /module/{module}
172 sub module {
173 my $self = shift;
174 my $name = shift;
176 $name or croak 'Please provide a module name';
178 return $self->fetch("module/$name");
182 # file() is a synonym of module
183 sub file { goto &module }
186 # /author/{author}
187 sub author {
188 my $self = shift;
189 my ( $pause_id, $url, %extra_opts );
191 if ( @_ == 1 ) {
192 $url = 'author/' . shift;
193 } elsif ( @_ == 2 ) {
194 my %opts = @_;
196 if ( defined $opts{'pauseid'} ) {
197 $url = "author/" . $opts{'pauseid'};
198 } elsif ( defined $opts{'search'} ) {
199 my $search_opts = $opts{'search'};
201 ref $search_opts && ref $search_opts eq 'HASH'
202 or croak "'search' key must be hashref";
204 %extra_opts = %{$search_opts};
205 $url = 'author/_search';
206 } else {
207 croak 'Unknown option given';
209 } else {
210 croak 'Please provide an author PAUSEID or a "search"';
213 return $self->fetch( $url, %extra_opts );
218 sub fetch {
219 my $self = shift;
220 my $url = shift;
221 my $extra = $self->_build_extra_params(@_);
222 my $base = $self->{base_url};
223 my $req_url = $extra ? "$base/$url?$extra" : "$base/$url";
225 my $result = $self->{ua}->get($req_url);
226 return $self->_decode_result( $result, $req_url );
230 sub post {
231 my $self = shift;
232 my $url = shift;
233 my $query = shift;
234 my $base = $self->{base_url};
236 defined $url
237 or croak 'First argument of URL must be provided';
239 ref $query and ref $query eq 'HASH'
240 or croak 'Second argument of query hashref must be provided';
242 my $query_json = encode_json( $query );
243 my $result = $self->{ua}->request(
244 'POST',
245 "$base/$url",
247 headers => { 'Content-Type' => 'application/json' },
248 content => $query_json,
252 return $self->_decode_result( $result, $url, $query_json );
255 sub _decode_result {
256 my $self = shift;
257 my ( $result, $url, $original ) = @_;
258 my $decoded_result;
260 ref $result and ref $result eq 'HASH'
261 or croak 'First argument must be hashref';
263 defined $url
264 or croak 'Second argument of a URL must be provided';
266 if ( defined ( my $success = $result->{'success'} ) ) {
267 my $reason = $result->{'reason'} || '';
268 $reason .= ( defined $original ? " (request: $original)" : '' );
270 $success or croak "Failed to fetch '$url': $reason";
271 } else {
272 croak 'Missing success in return value';
275 defined ( my $content = $result->{'content'} )
276 or croak 'Missing content in return value';
278 eval { $decoded_result = decode_json $content; 1 }
279 or do { croak "Couldn't decode '$content': $@" };
281 return $decoded_result;
286 __END__
288 =pod
290 =head1 NAME
292 MetaCPAN::API::Tiny - A Tiny API client for MetaCPAN
294 =head1 VERSION
296 version 1.131730
298 =head1 DESCRIPTION
300 This is the Tiny version of L<MetaCPAN::API>. It implements a compatible API
301 with a few notable exceptions:
303 =over 4
305 =item Attributes are direct hash access
307 The attributes defined using Mo(o|u)se are now accessed via the blessed hash
308 directly. There are no accessors defined to access this elements.
310 =item Exception handling
312 Instead of using Try::Tiny, raw evals are used. This could potentially cause
313 issues, so just be aware.
315 =item Testing
317 Test::Fatal was replaced with an eval implementation of exception().
318 Test::TinyMocker usage is retained, but may be absorbed since it is pure perl
320 =back
322 =head1 CLASS_METHODS
324 =head2 new
326 new is the constructor for MetaCPAN::API::Tiny. In the non-tiny version of this
327 module, this is provided via Any::Moose built from the attributes defined. In
328 the tiny version, we define our own constructor. It takes the same arguments
329 and provides similar checks to MetaCPAN::API with regards to arguments passed.
331 =head1 PUBLIC_METHODS
333 =head2 source
335 my $source = $mcpan->source(
336 author => 'DOY',
337 release => 'Moose-2.0201',
338 path => 'lib/Moose.pm',
341 Searches MetaCPAN for a module or a specific release and returns the plain source.
343 =head2 release
345 my $result = $mcpan->release( distribution => 'Moose' );
347 # or
348 my $result = $mcpan->release( author => 'DOY', release => 'Moose-2.0001' );
350 Searches MetaCPAN for a dist.
352 You can do complex searches using 'search' parameter:
354 # example lifted from MetaCPAN docs
355 my $result = $mcpan->release(
356 search => {
357 author => "OALDERS AND ",
358 filter => "status:latest",
359 fields => "name",
360 size => 1,
364 =head2 pod
366 my $result = $mcpan->pod( module => 'Moose' );
368 # or
369 my $result = $mcpan->pod(
370 author => 'DOY',
371 release => 'Moose-2.0201',
372 path => 'lib/Moose.pm',
375 Searches MetaCPAN for a module or a specific release and returns the POD.
377 =head2 module
379 my $result = $mcpan->module('MetaCPAN::API');
381 Searches MetaCPAN and returns a module's ".pm" file.
383 =head2 file
385 A synonym of L</module>
387 =head2 author
389 my $result1 = $mcpan->author('XSAWYERX');
390 my $result2 = $mcpan->author( pauseid => 'XSAWYERX' );
392 Searches MetaCPAN for a specific author.
394 You can do complex searches using 'search' parameter:
396 # example lifted from MetaCPAN docs
397 my $result = $mcpan->author(
398 search => {
399 q => 'profile.name:twitter',
400 size => 1,
404 =head2 fetch
406 my $result = $mcpan->fetch('/release/distribution/Moose');
408 # with parameters
409 my $more = $mcpan->fetch(
410 '/release/distribution/Moose',
411 param => 'value',
414 This is a helper method for API implementations. It fetches a path from MetaCPAN, decodes the JSON from the content variable and returns it.
416 You don't really need to use it, but you can in case you want to write your own extension implementation to MetaCPAN::API.
418 It accepts an additional hash as "GET" parameters.
420 =head2 post
422 # /release&content={"query":{"match_all":{}},"filter":{"prefix":{"archive":"Cache-Cache-1.06"}}}
423 my $result = $mcpan->post(
424 'release',
426 query => { match_all => {} },
427 filter => { prefix => { archive => 'Cache-Cache-1.06' } },
431 The POST equivalent of the "fetch()" method. It gets the path and JSON request.
433 =head1 THANKS
435 Overall the tests and code were ripped directly from MetaCPAN::API and
436 tiny-fied. A big thanks to Sawyer X for writing the original module.
438 =head1 AUTHOR
440 Nicholas R. Perez <nperez@cpan.org>
442 =head1 COPYRIGHT AND LICENSE
444 This software is copyright (c) 2013 by Nicholas R. Perez <nperez@cpan.org>.
446 This is free software; you can redistribute it and/or modify it under
447 the same terms as the Perl 5 programming language system itself.
449 =cut
450 METACPAN_API_TINY
452 s/^ //mg for values %fatpacked;
454 unshift @INC, sub {
455 if (my $fat = $fatpacked{$_[1]}) {
456 if ($] < 5.008) {
457 return sub {
458 return 0 unless length $fat;
459 $fat =~ s/^([^\n]*\n?)//;
460 $_ = $1;
461 return 1;
464 open my $fh, '<', \$fat
465 or die "FatPacker error loading $_[1] (could be a perl installation issue?)";
466 return $fh;
468 return
471 } # END OF FATPACK CODE
474 use 5.018; # same major version as target perl
475 use strict;
476 use warnings;
477 use Fatal qw(open close);
479 use Getopt::Long;
480 use Pod::Usage;
481 use File::Basename;
482 use Module::CoreList;
483 use MetaCPAN::API::Tiny;
485 my ($help, $man, $quiet, $force, $recommend, $host);
486 my $target = 1;
487 GetOptions( 'help|?' => \$help,
488 'man' => \$man,
489 'quiet|q' => \$quiet,
490 'force|f' => \$force,
491 'host!' => \$host,
492 'target!' => \$target,
493 'recommend' => \$recommend
494 ) or pod2usage(-exitval => 1);
495 pod2usage(-exitval => 0) if $help;
496 pod2usage(-exitval => 0, -verbose => 2) if $man;
497 pod2usage(-exitval => 1) if scalar @ARGV == 0;
499 my %dist; # name -> metacpan data
500 my %need_target; # name -> 1 if target package is needed
501 my %need_host; # name -> 1 if host package is needed
502 my %deps_build; # name -> list of host dependencies
503 my %deps_runtime; # name -> list of target dependencies
504 my $mcpan = MetaCPAN::API::Tiny->new();
506 sub fetch {
507 my ($name, $need_target, $need_host) = @_;
508 $need_target{$name} = $need_target if $need_target;
509 $need_host{$name} = $need_host if $need_host;
510 unless ($dist{$name}) {
511 say qq{fetch ${name}} unless $quiet;
512 my $result = $mcpan->release( distribution => $name );
513 $dist{$name} = $result;
514 my @deps_build = ();
515 my @deps_runtime = ();
516 my $mb;
517 foreach my $dep (@{$result->{dependency}}) {
518 my $modname = ${$dep}{module};
519 $mb = 1 if $modname eq q{Module::Build};
520 # Module::Build has a special treatment, because it is a core module,
521 # but some module require a very recent version of it
522 next if $modname eq q{perl};
523 next if $modname =~ m|^Alien|;
524 next if $modname =~ m|^Win32|;
525 next if Module::CoreList::first_release( $modname );
526 # we could use the host Module::CoreList data, because host perl and
527 # target perl have the same major version
528 next if ${$dep}{phase} eq q{develop};
529 next if ${$dep}{phase} eq q{test};
530 next if !$recommend && ${$dep}{relationship} ne q{requires};
531 my $distname = $mcpan->module( $modname )->{distribution};
532 if (${$dep}{phase} eq q{runtime}) {
533 push @deps_runtime, $distname;
535 else { # configure, build
536 push @deps_build, $distname;
539 unshift @deps_build, q{Module-Build} if $mb;
540 $deps_build{$name} = \@deps_build;
541 $deps_runtime{$name} = \@deps_runtime;
543 foreach my $distname (@{$deps_build{$name}}) {
544 fetch( $distname, 0, 1 );
546 foreach my $distname (@{$deps_runtime{$name}}) {
547 fetch( $distname, $need_target, $need_host );
549 return;
552 foreach my $distname (@ARGV) {
553 # Command-line's distributions
554 fetch( $distname, !!$target, !!$host );
556 say scalar keys %dist, q{ packages fetched.} unless $quiet;
558 # Buildroot package name: lowercase
559 sub fsname {
560 my $name = shift;
561 return q{perl-} . lc $name;
564 # Buildroot variable name: uppercase
565 sub brname {
566 my $name = shift;
567 $name =~ s|-|_|g;
568 return uc $name;
571 while (my ($distname, $dist) = each %dist) {
572 my $fsname = fsname( $distname );
573 my $dirname = q{package/} . $fsname;
574 my $cfgname = $dirname . q{/Config.in};
575 my $mkname = $dirname . q{/} . $fsname . q{.mk};
576 my $brname = brname( $fsname );
577 mkdir $dirname unless -d $dirname;
578 if ($need_target{$distname} && ($force || !-f $cfgname)) {
579 my $abstract = $dist->{abstract};
580 say qq{write ${cfgname}} unless $quiet;
581 open my $fh, q{>}, $cfgname;
582 say {$fh} qq{config BR2_PACKAGE_${brname}};
583 say {$fh} qq{\tbool "${fsname}"};
584 foreach my $dep (sort @{$deps_runtime{$distname}}) {
585 my $brdep = brname( fsname( $dep ) );
586 say {$fh} qq{\tselect BR2_PACKAGE_${brdep}};
588 say {$fh} qq{\thelp} if $abstract;
589 say {$fh} qq{\t ${abstract}} if $abstract;
590 close $fh;
592 if ($force || !-f $mkname) {
593 my $version = $dist->{version};
594 my($path) = $dist->{download_url} =~ m|^[^:/?#]+://[^/?#]*([^?#]*)|;
595 # this URL contains only the scheme, auth and path parts (but no query and fragment parts)
596 # the scheme is not used, because the job is done by the BR download infrastructure
597 # the auth part is not used, because we use $(BR2_CPAN_MIRROR)
598 my($filename, $directories, $suffix) = fileparse( $path, q{tar.gz}, q{tgz} );
599 my $dependencies = join q{ }, map( { q{host-} . fsname( $_ ); } sort @{$deps_build{$distname}} ),
600 map( { fsname( $_ ); } sort @{$deps_runtime{$distname}} );
601 my $host_dependencies = join q{ }, map { q{host-} . fsname( $_ ); } sort( @{$deps_build{$distname}},
602 @{$deps_runtime{$distname}} );
603 my $license = ref $dist->{license} eq 'ARRAY'
604 ? join q{ or }, @{$dist->{license}}
605 : $dist->{license};
606 $license = q{Artistic or GPLv1+} if $license eq q{perl_5};
607 say qq{write ${mkname}} unless $quiet;
608 open my $fh, q{>}, $mkname;
609 say {$fh} qq{################################################################################};
610 say {$fh} qq{#};
611 say {$fh} qq{# ${fsname}};
612 say {$fh} qq{#};
613 say {$fh} qq{################################################################################};
614 say {$fh} qq{};
615 say {$fh} qq{${brname}_VERSION = ${version}};
616 say {$fh} qq{${brname}_SOURCE = ${distname}-\$(${brname}_VERSION).${suffix}};
617 say {$fh} qq{${brname}_SITE = \$(BR2_CPAN_MIRROR)${directories}};
618 say {$fh} qq{${brname}_DEPENDENCIES = perl ${dependencies}} if $need_target{$distname};
619 say {$fh} qq{HOST_${brname}_DEPENDENCIES = ${host_dependencies}} if $need_host{$distname};
620 say {$fh} qq{${brname}_LICENSE = ${license}} if $license && $license ne q{unknown};
621 say {$fh} qq{};
622 say {$fh} qq{\$(eval \$(perl-package))} if $need_target{$distname};
623 say {$fh} qq{\$(eval \$(host-perl-package))} if $need_host{$distname};
624 close $fh;
628 my %pkg;
629 my $cfgname = q{package/Config.in};
630 if (-f $cfgname) {
631 open my $fh, q{<}, $cfgname;
632 while (<$fh>) {
633 chomp;
634 $pkg{$_} = 1 if m|package/perl-|;
636 close $fh;
639 foreach my $distname (keys %need_target) {
640 my $fsname = fsname( $distname );
641 $pkg{qq{source "package/${fsname}/Config.in"}} = 1;
644 say qq{${cfgname} must contain the following lines:};
645 say join qq{\n}, sort keys %pkg;
647 __END__
649 =head1 NAME
651 support/scripts/scancpan Try-Tiny Moo
653 =head1 SYNOPSIS
655 curl -kL http://install.perlbrew.pl | bash
657 perlbrew install perl-5.18.2
659 supports/scripts/scancpan [options] [distname ...]
661 Options:
662 -help
663 -man
664 -quiet
665 -force
666 -target/-notarget
667 -host/-nohost
668 -recommend
670 =head1 OPTIONS
672 =over 8
674 =item B<-help>
676 Prints a brief help message and exits.
678 =item B<-man>
680 Prints the manual page and exits.
682 =item B<-quiet>
684 Executes without output
686 =item B<-force>
688 Forces the overwriting of existing files.
690 =item B<-target/-notarget>
692 Switches package generation for the target variant (the default is C<-target>).
694 =item B<-host/-nohost>
696 Switches package generation for the host variant (the default is C<-nohost>).
698 =item B<-recommend>
700 Adds I<recommended> dependencies.
702 =back
704 =head1 DESCRIPTION
706 This script creates templates of the Buildroot package files for all the
707 Perl/CPAN distributions required by the specified distnames. The
708 dependencies and metadata are fetched from https://metacpan.org/.
710 After running this script, it is necessary to check the generated files.
711 You have to manually add the license files (PERL_FOO_LICENSE_FILES variable).
712 For distributions that link against a target library, you have to add the
713 buildroot package name for that library to the DEPENDENCIES variable.
715 See the Buildroot documentation for details on the usage of the Perl
716 infrastructure.
718 The major version of the host perl must be aligned on the target one,
719 in order to work with the right CoreList data.
721 =head1 LICENSE
723 Copyright (C) 2013-2014 by Francois Perrad <francois.perrad@gadz.org>
725 This program is free software; you can redistribute it and/or modify
726 it under the terms of the GNU General Public License as published by
727 the Free Software Foundation; either version 2 of the License, or
728 (at your option) any later version.
730 This program is distributed in the hope that it will be useful,
731 but WITHOUT ANY WARRANTY; without even the implied warranty of
732 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
733 General Public License for more details.
735 You should have received a copy of the GNU General Public License
736 along with this program; if not, write to the Free Software
737 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
739 This script is a part of Buildroot.
741 This script requires the module C<MetaCPAN::API::Tiny> (version 1.131730)
742 which was included at the beginning of this file by the tool C<fatpack>.
744 See L<http://search.cpan.org/~nperez/MetaCPAN-API-Tiny-1.131730/>.
746 See L<http://search.cpan.org/search?query=App-FatPacker&mode=dist>.
748 These both libraries are free software and may be distributed under the same
749 terms as perl itself.
751 And perl may be distributed under the terms of Artistic v1 or GPL v1 license.
753 =cut