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