utils/scancpan

   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'
   5 BEGIN {
   6 my %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} || 'https://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 <[email protected]>
 441
 442   =head1 COPYRIGHT AND LICENSE
 443
 444   This software is copyright (c) 2013 by Nicholas R. Perez <[email protected]>.
 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
 450 METACPAN_API_TINY
 451
 452 s/^  //mg for values %fatpacked;
 453
 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;
 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
 474 use 5.010;
 475 use strict;
 476 use warnings;
 477 use Fatal qw(open close);
 478
 479 use Getopt::Long;
 480 use Pod::Usage;
 481 use File::Basename;
 482 use File::Path qw(make_path);
 483 use Module::CoreList;
 484 use HTTP::Tiny;
 485 use Safe;
 486 use MetaCPAN::API::Tiny;
 487 use Digest::SHA qw(sha256_hex);
 488 use Text::Wrap;
 489 $Text::Wrap::columns = 62;
 490
 491 # Below, 5.036 should be aligned with the version of perl actually
 492 # bundled in Buildroot:
 493 die <<"MSG" if $] < 5.036;
 494 This script needs a host perl with the same major version as Buildroot target perl.
 495
 496 Your current host perl is:
 497     $^X
 498     version $]
 499
 500 You may install a local one by running:
 501     perlbrew install perl-5.36.0
 502 MSG
 503
 504 my ($help, $man, $quiet, $force, $recommend, $test, $host);
 505 my $target = 1;
 506 GetOptions( '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);
 515 pod2usage(-exitval => 0) if $help;
 516 pod2usage(-exitval => 0, -verbose => 2) if $man;
 517 pod2usage(-exitval => 1) if scalar @ARGV == 0;
 518
 519 my %dist;               # name -> metacpan data
 520 my %need_target;        # name -> 1 if target package is needed
 521 my %need_host;          # name -> 1 if host package is needed
 522 my %need_dlopen;        # name -> 1 if requires dynamic library
 523 my %is_xs;              # name -> 1 if XS module
 524 my %deps_build;         # name -> list of host dependencies
 525 my %deps_runtime;       # name -> list of target dependencies
 526 my %license_files;      # name -> hash of license files
 527 my %checksum;           # author -> list of checksum
 528 my $mirror = 'https://cpan.metacpan.org';        # a CPAN mirror
 529 my $mcpan = MetaCPAN::API::Tiny->new(base_url => 'https://fastapi.metacpan.org/v1');
 530 my $ua = HTTP::Tiny->new();
 531 my $new_pkgs;
 532
 533 my %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 );
 541 my @info = ();
 542
 543 sub 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
 556 sub 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
 564 sub 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
 584 sub want_test {
 585     my ($distname) = @_;
 586     return 1 if $need_dlopen{$distname} && scalar @{$deps_runtime{$distname}} > 0;
 587 }
 588
 589 sub 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
 600 sub 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
 610 sub 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
 681 foreach my $distname (@ARGV) {
 682     # Command-line's distributions
 683     fetch( $distname, !!$target, !!$host, 1 );
 684 }
 685 say scalar keys %dist, q{ packages fetched.} unless $quiet;
 686
 687 # Buildroot package name: lowercase
 688 sub fsname {
 689     my $name = shift;
 690     $name =~ s|_|-|g;
 691     return q{perl-} . lc $name;
 692 }
 693
 694 # Buildroot variable name: uppercase
 695 sub brname {
 696     my $name = shift;
 697     $name =~ s|-|_|g;
 698     return uc $name;
 699 }
 700
 701 # Buildroot requires license name as in https://spdx.org/licenses/
 702 sub 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
 719 while (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
 871 if ($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
 892 say join qq{\n}, @info;
 893
 894 __END__
 895
 896 =head1 NAME
 897
 898 utils/scancpan Try-Tiny Moo
 899
 900 =head1 SYNOPSIS
 901
 902 utils/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
 920 Prints a brief help message and exits.
 921
 922 =item B<-man>
 923
 924 Prints the manual page and exits.
 925
 926 =item B<-quiet>
 927
 928 Executes without output
 929
 930 =item B<-force>
 931
 932 Forces the overwriting of existing files.
 933
 934 =item B<-target/-notarget>
 935
 936 Switches package generation for the target variant (the default is C<-target>).
 937
 938 =item B<-host/-nohost>
 939
 940 Switches package generation for the host variant (the default is C<-nohost>).
 941
 942 =item B<-recommend>
 943
 944 Adds I<recommended> dependencies.
 945
 946 =item B<-test>
 947
 948 Adds dependencies for test.
 949
 950 =back
 951
 952 =head1 DESCRIPTION
 953
 954 This script creates templates of the Buildroot package files for all the
 955 Perl/CPAN distributions required by the specified distnames. The
 956 dependencies and metadata are fetched from https://metacpan.org/.
 957
 958 After running this script, it is necessary to check the generated files.
 959 For distributions that link against a target library, you have to add the
 960 buildroot package name for that library to the DEPENDENCIES variable.
 961
 962 See the Buildroot documentation for details on the usage of the Perl
 963 infrastructure.
 964
 965 The major version of the host perl must be aligned on the target one,
 966 in order to work with the right CoreList data.
 967
 968 =head1 LICENSE
 969
 970 Copyright (C) 2013-2023 by Francois Perrad <[email protected]>
 971
 972 This program is free software; you can redistribute it and/or modify
 973 it under the terms of the GNU General Public License as published by
 974 the Free Software Foundation; either version 2 of the License, or
 975 (at your option) any later version.
 976
 977 This program is distributed in the hope that it will be useful,
 978 but WITHOUT ANY WARRANTY; without even the implied warranty of
 979 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
 980 General Public License for more details.
 981
 982 You should have received a copy of the GNU General Public License
 983 along with this program; if not, write to the Free Software
 984 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
 985
 986 This script is a part of Buildroot.
 987
 988 This script requires the module C<MetaCPAN::API::Tiny> (version 1.131730)
 989 which was included at the beginning of this file by the tool C<fatpack>.
 990
 991 See L<https://metacpan.org/release/NPEREZ/MetaCPAN-API-Tiny-1.131730>.
 992
 993 See L<https://metacpan.org/release/App-FatPacker>.
 994
 995 These both libraries are free software and may be distributed under the same
 996 terms as perl itself.
 997
 998 And perl may be distributed under the terms of Artistic v1 or GPL v1 license.
 999
1000 =cut