1#!/usr/bin/env perl 2 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' 5BEGIN { 6my %fatpacked; 7 8$fatpacked{"MetaCPAN/API/Tiny.pm"} = <<'METACPAN_API_TINY'; 9 package MetaCPAN::API::Tiny; 10 { 11 $MetaCPAN::API::Tiny::VERSION = '1.131730'; 12 } 13 use strict; 14 use warnings; 15 # ABSTRACT: A Tiny API client for MetaCPAN 16 17 use Carp; 18 use JSON::PP 'encode_json', 'decode_json'; 19 use HTTP::Tiny; 20 21 22 sub new { 23 my ($class, @args) = @_; 24 25 $#_ % 2 == 0 26 or croak 'Arguments must be provided as name/value pairs'; 27 28 my %params = @args; 29 30 die 'ua_args must be an array reference' 31 if $params{ua_args} && ref($params{ua_args}) ne 'ARRAY'; 32 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'))), 40 }; 41 42 return bless($self, $class); 43 } 44 45 sub _build_extra_params { 46 my $self = shift; 47 48 @_ % 2 == 0 49 or croak 'Incorrect number of params, must be key/value'; 50 51 my %extra = @_; 52 my $ua = $self->{ua}; 53 54 foreach my $key (keys %extra) 55 { 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; 59 } 60 61 my $params = join '&', map { "$_=" . $extra{$_} } sort keys %extra; 62 63 return $params; 64 } 65 66 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'"; 73 74 %opts or croak $error; 75 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; 84 } 85 86 $url = $self->{base_url} . "/$url"; 87 88 my $result = $self->{ua}->get($url); 89 $result->{'success'} 90 or croak "Failed to fetch '$url': " . $result->{'reason'}; 91 92 return $result->{'content'}; 93 } 94 95 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'"; 104 105 %opts or croak $error; 106 107 my %extra_opts = (); 108 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'} ) 114 ) { 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; 119 120 %extra_opts = %{$search_opts}; 121 $url = 'release/_search'; 122 } else { 123 croak $error; 124 } 125 126 return $self->fetch( $url, %extra_opts ); 127 } 128 129 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'"; 137 138 %opts or croak $error; 139 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'} ) 146 ) { 147 $url = "pod/$author/$release/$path"; 148 } else { 149 croak $error; 150 } 151 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'; 157 158 $extra{headers}{'content-type'} = $type; 159 } 160 161 $url = $self->{base_url}. "/$url"; 162 163 my $result = $self->{ua}->get( $url, \%extra ); 164 $result->{'success'} 165 or croak "Failed to fetch '$url': " . $result->{'reason'}; 166 167 return $result->{'content'}; 168 } 169 170 171 # /module/{module} 172 sub module { 173 my $self = shift; 174 my $name = shift; 175 176 $name or croak 'Please provide a module name'; 177 178 return $self->fetch("module/$name"); 179 } 180 181 182 # file() is a synonym of module 183 sub file { goto &module } 184 185 186 # /author/{author} 187 sub author { 188 my $self = shift; 189 my ( $pause_id, $url, %extra_opts ); 190 191 if ( @_ == 1 ) { 192 $url = 'author/' . shift; 193 } elsif ( @_ == 2 ) { 194 my %opts = @_; 195 196 if ( defined $opts{'pauseid'} ) { 197 $url = "author/" . $opts{'pauseid'}; 198 } elsif ( defined $opts{'search'} ) { 199 my $search_opts = $opts{'search'}; 200 201 ref $search_opts && ref $search_opts eq 'HASH' 202 or croak "'search' key must be hashref"; 203 204 %extra_opts = %{$search_opts}; 205 $url = 'author/_search'; 206 } else { 207 croak 'Unknown option given'; 208 } 209 } else { 210 croak 'Please provide an author PAUSEID or a "search"'; 211 } 212 213 return $self->fetch( $url, %extra_opts ); 214 } 215 216 217 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"; 224 225 my $result = $self->{ua}->get($req_url); 226 return $self->_decode_result( $result, $req_url ); 227 } 228 229 230 sub post { 231 my $self = shift; 232 my $url = shift; 233 my $query = shift; 234 my $base = $self->{base_url}; 235 236 defined $url 237 or croak 'First argument of URL must be provided'; 238 239 ref $query and ref $query eq 'HASH' 240 or croak 'Second argument of query hashref must be provided'; 241 242 my $query_json = encode_json( $query ); 243 my $result = $self->{ua}->request( 244 'POST', 245 "$base/$url", 246 { 247 headers => { 'Content-Type' => 'application/json' }, 248 content => $query_json, 249 } 250 ); 251 252 return $self->_decode_result( $result, $url, $query_json ); 253 } 254 255 sub _decode_result { 256 my $self = shift; 257 my ( $result, $url, $original ) = @_; 258 my $decoded_result; 259 260 ref $result and ref $result eq 'HASH' 261 or croak 'First argument must be hashref'; 262 263 defined $url 264 or croak 'Second argument of a URL must be provided'; 265 266 if ( defined ( my $success = $result->{'success'} ) ) { 267 my $reason = $result->{'reason'} || ''; 268 $reason .= ( defined $original ? " (request: $original)" : '' ); 269 270 $success or croak "Failed to fetch '$url': $reason"; 271 } else { 272 croak 'Missing success in return value'; 273 } 274 275 defined ( my $content = $result->{'content'} ) 276 or croak 'Missing content in return value'; 277 278 eval { $decoded_result = decode_json $content; 1 } 279 or do { croak "Couldn't decode '$content': $@" }; 280 281 return $decoded_result; 282 } 283 284 1; 285 286 __END__ 287 288 =pod 289 290 =head1 NAME 291 292 MetaCPAN::API::Tiny - A Tiny API client for MetaCPAN 293 294 =head1 VERSION 295 296 version 1.131730 297 298 =head1 DESCRIPTION 299 300 This is the Tiny version of L<MetaCPAN::API>. It implements a compatible API 301 with a few notable exceptions: 302 303 =over 4 304 305 =item Attributes are direct hash access 306 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. 309 310 =item Exception handling 311 312 Instead of using Try::Tiny, raw evals are used. This could potentially cause 313 issues, so just be aware. 314 315 =item Testing 316 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 319 320 =back 321 322 =head1 CLASS_METHODS 323 324 =head2 new 325 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. 330 331 =head1 PUBLIC_METHODS 332 333 =head2 source 334 335 my $source = $mcpan->source( 336 author => 'DOY', 337 release => 'Moose-2.0201', 338 path => 'lib/Moose.pm', 339 ); 340 341 Searches MetaCPAN for a module or a specific release and returns the plain source. 342 343 =head2 release 344 345 my $result = $mcpan->release( distribution => 'Moose' ); 346 347 # or 348 my $result = $mcpan->release( author => 'DOY', release => 'Moose-2.0001' ); 349 350 Searches MetaCPAN for a dist. 351 352 You can do complex searches using 'search' parameter: 353 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, 361 }, 362 ); 363 364 =head2 pod 365 366 my $result = $mcpan->pod( module => 'Moose' ); 367 368 # or 369 my $result = $mcpan->pod( 370 author => 'DOY', 371 release => 'Moose-2.0201', 372 path => 'lib/Moose.pm', 373 ); 374 375 Searches MetaCPAN for a module or a specific release and returns the POD. 376 377 =head2 module 378 379 my $result = $mcpan->module('MetaCPAN::API'); 380 381 Searches MetaCPAN and returns a module's ".pm" file. 382 383 =head2 file 384 385 A synonym of L</module> 386 387 =head2 author 388 389 my $result1 = $mcpan->author('XSAWYERX'); 390 my $result2 = $mcpan->author( pauseid => 'XSAWYERX' ); 391 392 Searches MetaCPAN for a specific author. 393 394 You can do complex searches using 'search' parameter: 395 396 # example lifted from MetaCPAN docs 397 my $result = $mcpan->author( 398 search => { 399 q => 'profile.name:twitter', 400 size => 1, 401 }, 402 ); 403 404 =head2 fetch 405 406 my $result = $mcpan->fetch('/release/distribution/Moose'); 407 408 # with parameters 409 my $more = $mcpan->fetch( 410 '/release/distribution/Moose', 411 param => 'value', 412 ); 413 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. 415 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. 417 418 It accepts an additional hash as "GET" parameters. 419 420 =head2 post 421 422 # /release&content={"query":{"match_all":{}},"filter":{"prefix":{"archive":"Cache-Cache-1.06"}}} 423 my $result = $mcpan->post( 424 'release', 425 { 426 query => { match_all => {} }, 427 filter => { prefix => { archive => 'Cache-Cache-1.06' } }, 428 }, 429 ); 430 431 The POST equivalent of the "fetch()" method. It gets the path and JSON request. 432 433 =head1 THANKS 434 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. 437 438 =head1 AUTHOR 439 440 Nicholas R. Perez <nperez@cpan.org> 441 442 =head1 COPYRIGHT AND LICENSE 443 444 This software is copyright (c) 2013 by Nicholas R. Perez <nperez@cpan.org>. 445 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. 448 449 =cut 450METACPAN_API_TINY 451 452s/^ //mg for values %fatpacked; 453 454unshift @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; 462 }; 463 } 464 open my $fh, '<', \$fat 465 or die "FatPacker error loading $_[1] (could be a perl installation issue?)"; 466 return $fh; 467 } 468 return 469}; 470 471} # END OF FATPACK CODE 472 473 474use 5.010; 475use strict; 476use warnings; 477use Fatal qw(open close); 478 479use Getopt::Long; 480use Pod::Usage; 481use File::Basename; 482use File::Path qw(make_path); 483use Module::CoreList; 484use HTTP::Tiny; 485use Safe; 486use MetaCPAN::API::Tiny; 487use Digest::SHA qw(sha256_hex); 488use Text::Wrap; 489$Text::Wrap::columns = 62; 490 491# Below, 5.032 should be aligned with the version of perl actually 492# bundled in Buildroot: 493die <<"MSG" if $] < 5.032; 494This script needs a host perl with the same major version as Buildroot target perl. 495 496Your current host perl is: 497 $^X 498 version $] 499 500You may install a local one by running: 501 perlbrew install perl-5.32.0 502MSG 503 504my ($help, $man, $quiet, $force, $recommend, $test, $host); 505my $target = 1; 506GetOptions( 'help|?' => \$help, 507 'man' => \$man, 508 'quiet|q' => \$quiet, 509 'force|f' => \$force, 510 'host!' => \$host, 511 'target!' => \$target, 512 'recommend' => \$recommend, 513 'test' => \$test 514) or pod2usage(-exitval => 1); 515pod2usage(-exitval => 0) if $help; 516pod2usage(-exitval => 0, -verbose => 2) if $man; 517pod2usage(-exitval => 1) if scalar @ARGV == 0; 518 519my %dist; # name -> metacpan data 520my %need_target; # name -> 1 if target package is needed 521my %need_host; # name -> 1 if host package is needed 522my %need_dlopen; # name -> 1 if requires dynamic library 523my %is_xs; # name -> 1 if XS module 524my %deps_build; # name -> list of host dependencies 525my %deps_runtime; # name -> list of target dependencies 526my %license_files; # name -> hash of license files 527my %checksum; # author -> list of checksum 528my $mirror = 'http://cpan.metacpan.org'; # a CPAN mirror 529my $mcpan = MetaCPAN::API::Tiny->new(base_url => 'http://fastapi.metacpan.org/v1'); 530my $ua = HTTP::Tiny->new(); 531my $new_pkgs; 532 533my %white_list = ( 534 'ExtUtils-Config' => 1, 535 'ExtUtils-InstallPaths' => 1, 536 'ExtUtils-Helpers' => 1, 537 'File-ShareDir-Install' => 1, 538 'Module-Build' => 1, 539 'Module-Build-Tiny' => 1, 540); 541my @info = (); 542 543sub get_checksum { 544 my ($url) = @_; 545 my ($path) = $url =~ m|^[^:/?#]+://[^/?#]*([^?#]*)|; 546 my ($basename, $dirname) = fileparse( $path ); 547 unless ($checksum{$dirname}) { 548 my $url = $mirror . $dirname . q{CHECKSUMS}; 549 my $response = $ua->get($url); 550 $checksum{$dirname} = $response->{content}; 551 } 552 my $chksum = Safe->new->reval($checksum{$dirname}); 553 return $chksum->{$basename}, $basename; 554} 555 556sub is_xs { 557 my ($manifest) = @_; 558 # This heuristic determines if a module is a native extension, by searching 559 # some file extension types in the MANIFEST of the distribution. 560 # It was inspired by http://deps.cpantesters.org/static/purity.html 561 return $manifest =~ m/\.(swg|xs|c|h|i)[\n\s]/; 562} 563 564sub find_license_files { 565 my ($manifest) = @_; 566 my @license_files; 567 foreach (split /\n/, $manifest) { 568 next if m|/|; 569 s|\s+.*$||; 570 push @license_files, $_ if m/(ARTISTIC|COPYING|COPYRIGHT|GPL\S*|LICENSE|LICENCE)/i; 571 } 572 if (scalar @license_files == 0 && $manifest =~ m/(README)[\n\s]/i) { 573 @license_files = ($1); 574 } 575 if (scalar @license_files == 0 && $manifest =~ m/(README\.md)[\n\s]/i) { 576 @license_files = ($1); 577 } 578 if (scalar @license_files == 0 && $manifest =~ m/(README\.pod)[\n\s]/i) { 579 @license_files = ($1); 580 } 581 return @license_files; 582} 583 584sub want_test { 585 my ($distname) = @_; 586 return 1 if $need_dlopen{$distname} && scalar @{$deps_runtime{$distname}} > 0; 587} 588 589sub get_dependencies { 590 my ($distname) = @_; 591 my %dep = map { $_ => 1 } @{$deps_runtime{$distname}}; 592 for my $direct (@{$deps_runtime{$distname}}) { 593 for (get_dependencies( $direct )) { 594 $dep{$_} = 1; 595 } 596 } 597 return keys %dep; 598} 599 600sub get_indirect_dependencies { 601 my ($distname) = @_; 602 my %indirect; 603 my %direct = map { $_ => 1 } @{$deps_runtime{$distname}}; 604 for my $dep (get_dependencies( $distname )) { 605 $indirect{$dep} = 1 unless exists $direct{$dep}; 606 } 607 return keys %indirect; 608} 609 610sub fetch { 611 my ($name, $need_target, $need_host, $top) = @_; 612 $need_target{$name} = $need_target if $need_target; 613 $need_host{$name} = $need_host if $need_host; 614 unless ($dist{$name} && !$top) { 615 say qq{fetch ${name}} unless $quiet; 616 my $result = $mcpan->release( distribution => $name ); 617 my $main_module = $result->{main_module}; 618 push @info, qq{[$name] $main_module is a core module} 619 if $top && Module::CoreList::is_core( $main_module, undef, $] ); 620 $dist{$name} = $result; 621 $license_files{$name} = {}; 622 eval { 623 my $author = $result->{author}; 624 my $release = $name . q{-} . $result->{version}; 625 my $manifest = $mcpan->source( author => $author, release => $release, path => 'MANIFEST' ); 626 $need_dlopen{$name} = $is_xs{$name} = is_xs( $manifest ); 627 foreach my $fname (find_license_files( $manifest )) { 628 my $license = $mcpan->source( author => $author, release => $release, path => $fname ); 629 $license_files{$name}->{$fname} = sha256_hex( $license ); 630 } 631 }; 632 if ($@) { 633 warn $@; 634 } 635 my %build = (); 636 my %runtime = (); 637 my %optional = (); 638 foreach my $dep (@{$result->{dependency}}) { 639 my $modname = ${$dep}{module}; 640 next if $modname eq q{perl}; 641 next if $modname =~ m|^Alien|; 642 next if $modname =~ m|^Win32|; 643 next if !($test && $top) && $modname =~ m|^Test|; 644 next if Module::CoreList::is_core( $modname, undef, $] ); 645 # we could use the host Module::CoreList data, because host perl and 646 # target perl have the same major version 647 next if ${$dep}{phase} eq q{develop}; 648 next if ${$dep}{phase} eq q{x_Dist_Zilla}; 649 next if !($test && $top) && ${$dep}{phase} eq q{test}; 650 my $distname = $mcpan->module( $modname )->{distribution}; 651 if (${$dep}{phase} eq q{runtime}) { 652 if (${$dep}{relationship} eq q{requires}) { 653 $runtime{$distname} = 1; 654 } 655 else { 656 $optional{$distname} = 1 if $recommend && $top; 657 } 658 } 659 else { # configure, build 660 $build{$distname} = 1; 661 push @info, qq{[$name] suspicious dependency on $distname} 662 unless exists $white_list{$distname}; 663 } 664 } 665 $deps_build{$name} = [keys %build]; 666 $deps_runtime{$name} = [keys %runtime]; 667 foreach my $distname (@{$deps_build{$name}}) { 668 fetch( $distname, 0, 1 ); 669 } 670 foreach my $distname (@{$deps_runtime{$name}}) { 671 fetch( $distname, $need_target, $need_host ); 672 $need_dlopen{$name} ||= $need_dlopen{$distname}; 673 } 674 foreach my $distname (keys %optional) { 675 fetch( $distname, $need_target, $need_host ); 676 } 677 } 678 return; 679} 680 681foreach my $distname (@ARGV) { 682 # Command-line's distributions 683 fetch( $distname, !!$target, !!$host, 1 ); 684} 685say scalar keys %dist, q{ packages fetched.} unless $quiet; 686 687# Buildroot package name: lowercase 688sub fsname { 689 my $name = shift; 690 $name =~ s|_|-|g; 691 return q{perl-} . lc $name; 692} 693 694# Buildroot variable name: uppercase 695sub brname { 696 my $name = shift; 697 $name =~ s|-|_|g; 698 return uc $name; 699} 700 701# Buildroot requires license name as in http://spdx.org/licenses/ 702sub brlicense { 703 my $license = shift; 704 $license =~ s|apache_1_1|Apache-1.1|; 705 $license =~ s|apache_2_0|Apache-2.0|; 706 $license =~ s|artistic_2|Artistic-2.0|; 707 $license =~ s|artistic|Artistic-1.0|; 708 $license =~ s|lgpl_2_1|LGPL-2.1|; 709 $license =~ s|lgpl_3_0|LGPL-3.0|; 710 $license =~ s|gpl_2|GPL-2.0|; 711 $license =~ s|gpl_3|GPL-3.0|; 712 $license =~ s|mit|MIT|; 713 $license =~ s|mozilla_1_1|Mozilla-1.1|; 714 $license =~ s|openssl|OpenSSL|; 715 $license =~ s|perl_5|Artistic or GPL-1.0+|; 716 return $license; 717} 718 719while (my ($distname, $dist) = each %dist) { 720 my $fsname = fsname( $distname ); 721 my $dirname = q{package/} . $fsname; 722 my $cfgname = $dirname . q{/Config.in}; 723 my $mkname = $dirname . q{/} . $fsname . q{.mk}; 724 my $hashname = $dirname . q{/} . $fsname . q{.hash}; 725 my $brname = brname( $fsname ); 726 my $testdir = q{support/testing/tests/package}; 727 my $testname = $testdir . q{/test_} . lc $brname . q{.py}; 728 unless (-d $dirname) { 729 make_path $dirname; 730 $new_pkgs = 1; 731 } 732 if ($need_target{$distname} && ($force || !-f $cfgname)) { 733 $dist->{abstract} =~ s|\s+$||; 734 $dist->{abstract} .= q{.} unless $dist->{abstract} =~ m|\.$|; 735 my $abstract = wrap( q{}, qq{\t }, $dist->{abstract} ); 736 my $homepage = $dist->{resources}->{homepage} || qq{https://metacpan.org/release/${distname}}; 737 say qq{write ${cfgname}} unless $quiet; 738 open my $fh, q{>}, $cfgname; 739 say {$fh} qq{config BR2_PACKAGE_${brname}}; 740 say {$fh} qq{\tbool "${fsname}"}; 741 say {$fh} qq{\tdepends on !BR2_STATIC_LIBS} if $need_dlopen{$distname}; 742 foreach my $dep (sort @{$deps_runtime{$distname}}) { 743 my $brdep = brname( fsname( $dep ) ); 744 say {$fh} qq{\tselect BR2_PACKAGE_${brdep} # runtime}; 745 } 746 say {$fh} qq{\thelp}; 747 say {$fh} qq{\t ${abstract}\n} if $abstract; 748 say {$fh} qq{\t ${homepage}}; 749 if ($need_dlopen{$distname}) { 750 say {$fh} qq{\ncomment "${fsname} needs a toolchain w/ dynamic library"}; 751 say {$fh} qq{\tdepends on BR2_STATIC_LIBS}; 752 } 753 close $fh; 754 } 755 if ($force || !-f $mkname) { 756 my $version = $dist->{version}; 757 my ($path) = $dist->{download_url} =~ m|^[^:/?#]+://[^/?#]*([^?#]*)|; 758 # this URL contains only the scheme, auth and path parts (but no query and fragment parts) 759 # the scheme is not used, because the job is done by the BR download infrastructure 760 # the auth part is not used, because we use $(BR2_CPAN_MIRROR) 761 my ($filename, $directories, $suffix) = fileparse( $path, q{tar.gz}, q{tgz} ); 762 $directories =~ s|/$||; 763 my @dependencies = map( { q{host-} . fsname( $_ ); } sort @{$deps_build{$distname}} ); 764 my $dependencies = join qq{ \\\n\t}, @dependencies; 765 $dependencies = qq{\\\n\t} . $dependencies if scalar @dependencies > 1; 766 my @host_dependencies = map { q{host-} . fsname( $_ ); } sort( @{$deps_build{$distname}}, 767 @{$deps_runtime{$distname}} ); 768 my $host_dependencies = join qq{ \\\n\t}, @host_dependencies; 769 $host_dependencies = qq{\\\n\t} . $host_dependencies if scalar @host_dependencies > 1; 770 my $license = brlicense( ref $dist->{license} eq 'ARRAY' 771 ? join q{ or }, @{$dist->{license}} 772 : $dist->{license} ); 773 my $license_files = join q{ }, sort keys %{$license_files{$distname}}; 774 if ($license_files && (!$license || $license eq q{unknown})) { 775 push @info, qq{[$distname] undefined LICENSE, see $license_files}; 776 $license = q{???}; 777 } 778 say qq{write ${mkname}} unless $quiet; 779 open my $fh, q{>}, $mkname; 780 say {$fh} qq{################################################################################}; 781 say {$fh} qq{#}; 782 say {$fh} qq{# ${fsname}}; 783 say {$fh} qq{#}; 784 say {$fh} qq{################################################################################}; 785 say {$fh} qq{}; 786 say {$fh} qq{${brname}_VERSION = ${version}}; 787 say {$fh} qq{${brname}_SOURCE = ${distname}-\$(${brname}_VERSION).${suffix}}; 788 say {$fh} qq{${brname}_SITE = \$(BR2_CPAN_MIRROR)${directories}}; 789 say {$fh} qq{${brname}_DEPENDENCIES = ${dependencies}} if $need_target{$distname} && $dependencies; 790 say {$fh} qq{HOST_${brname}_DEPENDENCIES = ${host_dependencies}} if $need_host{$distname} && $host_dependencies; 791 say {$fh} qq{${brname}_LICENSE = ${license}} if $license; 792 say {$fh} qq{${brname}_LICENSE_FILES = ${license_files}} if $license_files; 793 say {$fh} qq{${brname}_DISTNAME = ${distname}}; 794 say {$fh} qq{}; 795 say {$fh} qq{\$(eval \$(perl-package))} if $need_target{$distname}; 796 say {$fh} qq{\$(eval \$(host-perl-package))} if $need_host{$distname}; 797 close $fh; 798 } 799 if ($force || !-f $hashname) { 800 my ($checksum, $filename) = get_checksum($dist->{download_url}); 801 my $md5 = $checksum->{md5}; 802 my $sha256 = $checksum->{sha256}; 803 say qq{write ${hashname}} unless $quiet; 804 open my $fh, q{>}, $hashname; 805 say {$fh} qq{# retrieved by scancpan from ${mirror}/}; 806 say {$fh} qq{md5 ${md5} ${filename}}; 807 say {$fh} qq{sha256 ${sha256} ${filename}}; 808 my %license_files = %{$license_files{$distname}}; 809 if (scalar keys %license_files) { 810 say {$fh} q{}; 811 say {$fh} qq{# computed by scancpan}; 812 foreach my $license (sort keys %license_files) { 813 my $digest = $license_files{$license}; 814 say {$fh} qq{sha256 ${digest} ${license}}; 815 } 816 } 817 close $fh; 818 } 819 if (want_test( $distname ) && ($force || !-f $testname)) { 820 my $classname = $distname; 821 $classname =~ s|-||g; 822 my $modname = $distname; 823 $modname =~ s|-|::|g; 824 my $mark = $is_xs{$distname} ? q{ XS} : q{}; 825 my @indirect = (get_indirect_dependencies( $distname )); 826 say qq{write ${testname}} unless $quiet; 827 make_path $testdir unless -d $testdir; 828 open my $fh, q{>}, $testname; 829 say {$fh} qq{from tests.package.test_perl import TestPerlBase}; 830 say {$fh} qq{}; 831 say {$fh} qq{}; 832 say {$fh} qq{class TestPerl${classname}(TestPerlBase):}; 833 say {$fh} qq{ """}; 834 say {$fh} qq{ package:}; 835 say {$fh} qq{ ${distname}${mark}}; 836 say {$fh} qq{ direct dependencies:}; 837 foreach my $dep (sort @{$deps_runtime{$distname}}) { 838 $mark = $is_xs{$dep} ? q{ XS} : q{}; 839 say {$fh} qq{ ${dep}${mark}}; 840 } 841 if (scalar @indirect > 0) { 842 say {$fh} qq{ indirect dependencies:}; 843 foreach my $dep (sort @indirect) { 844 $mark = $is_xs{$dep} ? q{ XS} : q{}; 845 say {$fh} qq{ ${dep}${mark}}; 846 } 847 } 848 say {$fh} qq{ """}; 849 say {$fh} qq{}; 850 say {$fh} qq{ config = TestPerlBase.config + \\}; 851 say {$fh} qq{ """}; 852 say {$fh} qq{ BR2_PACKAGE_PERL=y}; 853 say {$fh} qq{ BR2_PACKAGE_${brname}=y}; 854 say {$fh} qq{ """}; 855 say {$fh} qq{}; 856 say {$fh} qq{ def test_run(self):}; 857 say {$fh} qq{ self.login()}; 858 foreach my $dep (sort grep { $is_xs{$_} } @indirect) { 859 $dep =~ s|-|::|g; 860 say {$fh} qq{ self.module_test("${dep}")}; 861 } 862 foreach my $dep (sort grep { $is_xs{$_} } @{$deps_runtime{$distname}}) { 863 $dep =~ s|-|::|g; 864 say {$fh} qq{ self.module_test("${dep}")}; 865 } 866 say {$fh} qq{ self.module_test("${modname}")}; 867 close $fh; 868 } 869} 870 871if ($new_pkgs) { 872 my %pkg; 873 my $cfgname = q{package/Config.in}; 874 if (-f $cfgname) { 875 open my $fh, q{<}, $cfgname; 876 while (<$fh>) { 877 chomp; 878 $pkg{$_} = 1 if m|package/perl-|; 879 } 880 close $fh; 881 } 882 883 foreach my $distname (keys %need_target) { 884 my $fsname = fsname( $distname ); 885 $pkg{qq{\tsource "package/${fsname}/Config.in"}} = 1; 886 } 887 888 say qq{${cfgname} must contain the following lines:}; 889 say join qq{\n}, sort keys %pkg; 890} 891 892say join qq{\n}, @info; 893 894__END__ 895 896=head1 NAME 897 898utils/scancpan Try-Tiny Moo 899 900=head1 SYNOPSIS 901 902utils/scancpan [options] [distname ...] 903 904 Options: 905 -help 906 -man 907 -quiet 908 -force 909 -target/-notarget 910 -host/-nohost 911 -recommend 912 -test 913 914=head1 OPTIONS 915 916=over 8 917 918=item B<-help> 919 920Prints a brief help message and exits. 921 922=item B<-man> 923 924Prints the manual page and exits. 925 926=item B<-quiet> 927 928Executes without output 929 930=item B<-force> 931 932Forces the overwriting of existing files. 933 934=item B<-target/-notarget> 935 936Switches package generation for the target variant (the default is C<-target>). 937 938=item B<-host/-nohost> 939 940Switches package generation for the host variant (the default is C<-nohost>). 941 942=item B<-recommend> 943 944Adds I<recommended> dependencies. 945 946=item B<-test> 947 948Adds dependencies for test. 949 950=back 951 952=head1 DESCRIPTION 953 954This script creates templates of the Buildroot package files for all the 955Perl/CPAN distributions required by the specified distnames. The 956dependencies and metadata are fetched from https://metacpan.org/. 957 958After running this script, it is necessary to check the generated files. 959For distributions that link against a target library, you have to add the 960buildroot package name for that library to the DEPENDENCIES variable. 961 962See the Buildroot documentation for details on the usage of the Perl 963infrastructure. 964 965The major version of the host perl must be aligned on the target one, 966in order to work with the right CoreList data. 967 968=head1 LICENSE 969 970Copyright (C) 2013-2020 by Francois Perrad <francois.perrad@gadz.org> 971 972This program is free software; you can redistribute it and/or modify 973it under the terms of the GNU General Public License as published by 974the Free Software Foundation; either version 2 of the License, or 975(at your option) any later version. 976 977This program is distributed in the hope that it will be useful, 978but WITHOUT ANY WARRANTY; without even the implied warranty of 979MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 980General Public License for more details. 981 982You should have received a copy of the GNU General Public License 983along with this program; if not, write to the Free Software 984Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 985 986This script is a part of Buildroot. 987 988This script requires the module C<MetaCPAN::API::Tiny> (version 1.131730) 989which was included at the beginning of this file by the tool C<fatpack>. 990 991See L<https://metacpan.org/release/NPEREZ/MetaCPAN-API-Tiny-1.131730>. 992 993See L<https://metacpan.org/release/App-FatPacker>. 994 995These both libraries are free software and may be distributed under the same 996terms as perl itself. 997 998And perl may be distributed under the terms of Artistic v1 or GPL v1 license. 999 1000=cut 1001