pldcpan.pl

   1 #!/usr/bin/perl -w
   2 # Requirements:
   3 # perl-Pod-Tree perl-Archive-Any perl-Template-Toolkit perl-YAML perl-IO-String
   4 # perl-File-Find-Rule perl-Module-CoreList
   5
   6 =head1 NAME
   7
   8 pldcpan - A Perl module packager
   9
  10 =head1 SYNOPSIS
  11
  12     pldcpan.pl [ OPTIONS ] DIST [ DIST2 DIST3 ... ]
  13
  14 =head1 DESCRIPTION
  15
  16 This program uncompresses given archives in the current directory and -- more
  17 or less successfully -- attempts to write corresponding perl-*.spec files.
  18
  19 DIST can be a directory, a compressed archive, URL to fetch or module name
  20 (Foo::Bar) to be found on metacpan.org.
  21
  22 =head1 TODO
  23
  24 Some things we're working on/thinking about:
  25
  26 =over
  27
  28 =item 1.
  29
  30 use poldek to search whether dir should be packaged:
  31
  32      $ poldek -q --cmd search -f /usr/share/perl5/vendor_perl/Text
  33      perl-base-5.8.7-4
  34
  35 =item 2.
  36
  37 first could be checked if the dir is contained by perl-base (will be faster than querying poldek)
  38
  39 =item 3.
  40
  41 Detect Module::AutoInstall and add --skipdeps to Makefile.PL.
  42
  43 =back
  44
  45 =head1 BUGS
  46
  47 Every software has bugs, if you find one and it's really annoying for you, try
  48 opening bugreport at: F<http://bugs.pld-linux.org>
  49
  50 =head1 AUTHOR
  51
  52 Radoslaw Zielinski <radek@pld-linux.org>.
  53 This manual page was composed by Elan Ruusamae <glen@pld-linux.org>
  54
  55 =head1 LICENSE AND COPYRIGHT
  56
  57 Copyright (c) 2004-2008 PLD Linux Distribution
  58
  59 This product is free and distributed under the Gnu Public License (GPL).
  60
  61 =cut
  62
  63
  64 use strict;
  65
  66 use Cwd qw( getcwd );
  67 use Getopt::Long qw( GetOptions );
  68 use IPC::Run qw( run timeout );
  69 use Pod::Select qw( podselect );
  70 use YAML::Any qw(LoadFile);
  71
  72 use Pod::Tree        ();
  73 use Archive::Any     ();
  74 use Template         ();
  75 use Digest::MD5      ();
  76 use IO::String       ();
  77 use File::Find::Rule ();
  78 use Module::CoreList ();
  79 use LWP::Simple      ();
  80
  81 our $VERSION = 1.65;
  82 our %opts;
  83 GetOptions(\%opts, 'verbose|v', 'modulebuild|B', 'makemaker|M', 'force');
  84 eval "use Data::Dump qw(pp);" if $opts{verbose};
  85 die $@                        if $@;
  86
  87 unless (@ARGV) {
  88         die <<'EOF';
  89 usage:
  90         pldcpan.pl [ OPTIONS ] DIST [ DIST2 DIST3 ... ]
  91
  92 options:
  93         -v|--verbose      shout, and shout loud
  94         -B|--modulebuild  prefer Module::Build (default)
  95         -M|--makemaker    prefer ExtUtils::MakeMaker
  96            --force        overwrite existing *.spec files
  97
  98 This program uncompresses given archives in the current directory
  99 and -- more or less successfully -- attempts to write corresponding
 100 perl-*.spec files.
 101
 102 DIST can be a directory, a compressed archive, URL to fetch or module
 103 name (Foo::Bar) to be found on metacpan.org.
 104
 105 $Id$
 106 EOF
 107 }
 108
 109 # get maximum information from directory name
 110 sub test_directory {
 111         my $fooball = shift;
 112         my $info    = shift;
 113         return $info->{_tests}->{directory}
 114           if defined $info->{_tests}->{directory};
 115
 116         #       FIXME: use -v  (hmm, what did I meant?)
 117         unless (
 118                 $fooball =~ m#^
 119                 (?:.*/)?
 120                 (
 121                   [a-z][a-z\d]*
 122                   (?:
 123                         ([-_])[a-z][a-z\d]*
 124                         (?: \2[a-z][a-z\d]*)*
 125                   )?
 126                 )
 127                 -
 128                 v?(\d[\d._-]*[a-z]?\d*)
 129                 /*$ #ix
 130           )
 131         {
 132                 warn " -- cannot resolve name and version: '$fooball'\n";
 133                 return $info->{_tests}->{directory} = 0;
 134         }
 135
 136         $info->{ballname} = $1;
 137         $info->{namme}    = $1;
 138         $info->{version}  = $3;
 139         {
 140                 my $separ = $2;
 141                 @{$info}{qw(pdir pnam)} = $separ
 142                   ? (split /$separ/, $info->{ballname}, 2)
 143                   : ($info->{ballname}, undef);
 144                 $info->{parts} =
 145                   [$separ ? (split /$separ/, $info->{ballname}) : ($info->{ballname})];
 146         }
 147         $info->{parts_joined} = join '::', @{ $info->{parts} };
 148         $info->{_tests}->{directory} = 1;
 149 }
 150
 151 sub test_archive_name {
 152         my (undef, $info) = @_;
 153         return $info->{_tests}->{archive_name}
 154           if defined $info->{_tests}->{archive_name};
 155         (my $d = shift) =~
 156           s/\.(?:(?:tar\.)?(?:gz|bz2|Z)|tar|tgz|zip|rar|arj|lha)$//;
 157         $info->{_tests}->{archive_name} = test_directory($d, @_);
 158 }
 159
 160 sub test_has_tests {
 161         my $info = shift;
 162         return $info->{_tests}->{has_tests}
 163           if defined $info->{_tests}->{has_tests};
 164         die "not a directory ($info->{dir})!" unless -d $info->{dir};
 165
 166         if (-d "$info->{dir}/t" || -f "$info->{dir}/test.pl") {
 167                 $info->{tests}++;
 168                 return $info->{_tests}->{has_tests} = 1;
 169         }
 170         $info->{_tests}->{has_tests} = 0;
 171 }
 172
 173 sub test_has_examples {
 174         my $info = shift;
 175         return $info->{_tests}->{has_examples}
 176           if defined $info->{_tests}->{has_examples};
 177         die "not a directory ($info->{dir})!" unless -d $info->{dir};
 178
 179         $info->{examples} =
 180           [grep -e,
 181                 map { $_, lc $_, uc $_ } qw(Example Examples Eg Sample Samples)];
 182         $info->{_tests}->{has_examples} = @{ $info->{examples} } ? 1 : 0;
 183 }
 184
 185 sub test_has_doc_files {
 186         my $info = shift;
 187         return $info->{_tests}->{has_doc_files}
 188           if defined $info->{_tests}->{has_doc_files};
 189         die "not a directory ($info->{dir})!" unless -d $info->{dir};
 190         my %tmp;
 191         $info->{doc_files} = [
 192                 grep -e,
 193                 grep !$tmp{$_}++,
 194                 map { $_, "$_.txt", "$_.TXT" }
 195                 map { $_, lc $_, uc $_ }
 196                   qw(AUTHORS BUGS ChangeLog Changes CREDITS doc docs documentation EXTRAS
 197                   GOALS HACKING HISTORY INSTALL NEW NEWS NOTES PATCHING README DISCLAIMER
 198                   ToDo)
 199         ];
 200         $info->{_tests}->{has_doc_files} = @{ $info->{doc_files} } ? 1 : 0;
 201 }
 202
 203 sub test_license {
 204         my $info = shift;
 205         return $info->{_tests}->{license}
 206           if defined $info->{_tests}->{license};
 207         if (load_META_yml($info) && $info->{META_yml}->{license}) {
 208                 $info->{license} =
 209                   $info->{META_yml}->{license} =~ /^l?gpl$/
 210                   ? uc $info->{META_yml}->{license}
 211                   : $info->{META_yml}->{license};
 212         # This depends on test_find_summ_descr2
 213         } elsif (my $license = $info->{pod_license}) {
 214                 $info->{license} = 'perl' if $license =~ /same terms as perl/i;
 215         }
 216         $info->{_tests}->{license} = $info->{license} ? 1 : 0;
 217 }
 218
 219 sub load_META_yml {
 220         my $info = shift;
 221         return $info->{_tests}->{license}
 222           if defined $info->{_tests}->{license};
 223         if (-f 'META.yml') {
 224                 $info->{META_yml} = LoadFile('META.yml');
 225         }
 226
 227         _remove_core_meta_requires($info, 'requires');
 228         _remove_core_meta_requires($info, 'build_requires');
 229
 230         $info->{_tests}->{license} = $info->{META_yml} ? 1 : 0;
 231 }
 232
 233 sub _remove_core_meta_requires {
 234         my ($info, $key) = @_;
 235
 236         return if ref($info->{META_yml}->{$key}) ne 'HASH';
 237
 238         # avoid perl(perl) >= 5.6... requires
 239         delete $info->{META_yml}->{$key}->{perl};
 240
 241         while (my ($module, $version) = each %{ $info->{META_yml}->{$key} }) {
 242                 my $result;
 243                 print "Checking dependency: $module $version\n" if $opts{verbose};
 244                 if ($version) {
 245                         $result = Module::CoreList->first_release($module, $version);
 246                 } else {
 247                         $result = Module::CoreList->first_release($module);
 248                 }
 249                 # $] - perl version
 250                 if ( $result and $result < $] ) {
 251                         if ($opts{verbose}) {
 252                                 print "Module $module availablie in core since $result, skipping\n"
 253                         }
 254                         delete $info->{META_yml}->{$key}->{$module};
 255                 }
 256         }
 257 }
 258
 259 sub test_find_pod_file {
 260         my $info = shift;
 261         return $info->{_tests}->{find_pod_file}
 262           if defined $info->{_tests}->{find_pod_file};
 263         die "not a directory ($info->{dir})!" unless -d $info->{dir};
 264
 265         my $pod_file;
 266
 267         my $mfile = @{ $info->{parts} }[-1];
 268         if (!defined $mfile) {
 269                 warn " .. unable to search for \$pod_file without parts\n";
 270                 return $info->{_tests}->{find_pod_file} = 0;
 271         }
 272
 273         my ($pm, $pod);
 274         for my $f ( grep !m#/t/#, File::Find::Rule->file->name( "$mfile.pod", "$mfile.pm", )->in( $info->{dir} ) ) {
 275                 $pod = $f if $f =~ /\.pod$/;
 276                 $pm  = $f if $f =~ /\.pm$/;
 277         }
 278         $pod_file = $pod ? $pod : $pm;
 279         if (   !$pod_file
 280                 && load_META_yml($info)
 281                 && exists $info->{META_yml}->{version_from})
 282         {
 283                 $pod_file = $info->{META_yml}->{version_from};
 284         }
 285
 286         unless ($pod_file) {
 287                 warn " -- no \$pod_file <@{$info->{parts}}>\n";
 288                 return $info->{_tests}->{find_pod_file} = 0;
 289         }
 290
 291         my $tree = new Pod::Tree;
 292         $tree->load_file($pod_file);
 293         unless ($tree->has_pod) {
 294                 warn " ,, no POD in $pod_file\n";
 295                 return $info->{_tests}->{find_pod_file} = 0;
 296         }
 297
 298         $info->{_podtree}                = $tree;
 299         $info->{pod_file}                = $pod_file;
 300         $info->{_tests}->{find_pod_file} = 1;
 301 }
 302
 303 # workaround for Pod::Parser not supporting "\r\n" line endings
 304 {
 305         no warnings 'redefine';
 306
 307         sub Pod::Parser::preprocess_line {
 308                 (my $text = $_[1]) =~ y/\r//d;
 309                 $text;
 310         }
 311 }
 312
 313 sub test_find_summ_descr2 {
 314         my $info = shift;
 315
 316         return $info->{_tests}->{find_summ_descr} = 0
 317           unless test_find_pod_file($info);
 318
 319         my $tree = $info->{_podtree};
 320         my $handler = _get_node_handler();
 321         $tree->walk( $handler );
 322         ($info->{summary}, $info->{descr}, $info->{pod_license}) = $handler->('data');
 323 }
 324
 325 # This subroutine return closure to be used as a node handler in Pod::Tree walk() method
 326 sub _get_node_handler {
 327         # state informaion
 328         my $next_is_summary;
 329         my $we_are_in_license;
 330         my $we_are_in_description;
 331         my $nodes_since_description_start;
 332         # data we will return
 333         my ($summary, $description, $license);
 334
 335         return sub {
 336                 my $node = shift;
 337
 338                 # If not called with a node, then return collected data
 339                 if (!ref $node) {
 340                         $summary =~ s/^ \s* (.*?) \s* $/$1/gxm;
 341                         return ($summary, $description, $license);
 342                 }
 343
 344                 # We want to dive into root node. Note that this is the only
 345                 # place we ever descend into tree
 346                 return 1 if $node->is_root;
 347
 348                 # If we have encountered any head command then abort collecting
 349                 # summary and description
 350                 my $command = $node->get_command;
 351                 if ($node->is_command and $command =~ /head/) {
 352                         if ($command eq 'head1' or $nodes_since_description_start > 3) {
 353                                 $we_are_in_description  = 0;
 354                         }
 355                         $next_is_summary = 0;
 356                         $we_are_in_license = 0;
 357                 }
 358
 359                 # If previous element started an summary section, then treat
 360                 # this one as summary text.
 361                 if ($next_is_summary) {
 362                         ($summary = $node->get_deep_text) =~ y/\r//d;
 363                         $summary =~ s/^\s+(.*?)\s+$/$1/;
 364                         $next_is_summary = 0;
 365                         return;
 366                 }
 367                 if ($we_are_in_license) {
 368                         ($license .= $node->get_text) =~ y/\r//d;
 369                         return;
 370                 }
 371
 372                 # If we started collecting description then add any ordinary
 373                 # node to collected description
 374                 if ($we_are_in_description) {
 375                         if ($nodes_since_description_start > 5) {
 376                                 $we_are_in_description = 0;
 377                         }
 378                         elsif ($node->is_ordinary or $node->is_verbatim) {
 379                                 ($description .= $node->get_deep_text) =~ y/\r//d;
 380                                 $nodes_since_description_start++;
 381                         }
 382                         else {
 383                                 return;
 384                         }
 385                 }
 386
 387                 # OK, next will be sumary text
 388                 if ($node->is_c_head1 and $node->get_text =~ /^\s*NAME\s*$/) {
 389                         $next_is_summary = 1;
 390                 }
 391                 # OK, description nodes will proceeed (until another head command)
 392                 if ($node->is_c_head1 and $node->get_text =~ /DESCRIPTION/) {
 393                         $we_are_in_description = 1;
 394                         $nodes_since_description_start = 1;
 395                 }
 396                 if ($node->is_c_head1 and $node->get_text =~ /LICENSE|COPYRIGHT/) {
 397                         $we_are_in_license = 1;
 398                 }
 399                 return;
 400         }
 401 }
 402
 403 sub test_find_summ_descr {
 404         my $info = shift;
 405         return $info->{_tests}->{find_summ_descr}
 406           if defined $info->{_tests}->{find_summ_descr};
 407         return $info->{_tests}->{find_summ_descr} = 0
 408           unless test_find_pod_file($info);
 409
 410         #       my $parser = new Pod::Select;
 411         #       $parser->parse_from_file($info->{pod_file});
 412         for my $sec ({ h => 'summary', s => 'NAME' },
 413                 { h => 'descr', s => 'DESCRIPTION' })
 414         {
 415                 my $H = new IO::String \$info->{ $sec->{h} };
 416                 podselect({ -output => $H, -sections => [$sec->{s}] },
 417                         $info->{pod_file});
 418                 $H->close;
 419                 $info->{ $sec->{h} } =~ s/^\s*=head.*//;
 420         }
 421
 422 =begin comment
 423
 424         my $tree = new Pod::Tree;
 425         $tree->load_file($info->{pod_file});
 426         unless ($tree->has_pod) {
 427                 warn " ,, no POD in $info->{pod_file}\n";
 428                 return $info->{_tests}->{find_summ_descr} = 0;
 429         }
 430
 431         my $root = $tree->get_root;
 432         $info->{$_} = '' for qw/summary descr/;
 433
 434         my $state;
 435         for my $n (@{ $root->get_children }) {
 436                 if ($n->is_c_head1) {
 437                         undef $state;
 438                         $state = 'summary'
 439                           if $n->get_text =~ /^\s*NAME\b/ && !$info->{summary};
 440                         $state = 'descr'
 441                           if $n->get_text =~ /^\s*DESCRIPTION\b/ && !$info->{descr};
 442                         next;
 443                 }
 444                 $info->{$state} .= $n->get_text if $state;
 445         }
 446
 447 =cut
 448
 449         $info->{summary} =~ y/\r\n\t /    /s;
 450         $info->{$_} =~ s/^\s+|\s+$//g for qw/summary descr/;
 451
 452         warn " ,, no summary in $info->{pod_file}\n"     unless $info->{summary};
 453         warn " ,, no description in $info->{pod_file}\n" unless $info->{descr};
 454
 455 =begin comment
 456
 457         my $file < io($info->{pod_file});
 458         $file =~ y/\r//d;
 459         if ($file =~ /(?:^|\n)=head\d\s+NAME[\t ]*\n\s*(.+)\n+(?:=|$)/) {
 460                 $info->{summary} = $1;
 461                 $info->{summary} =~ s/\s+$//g;
 462         }
 463         else {
 464                 warn " ,, no summary: $_\n";
 465                 $info->{summary} = '';
 466         }
 467         if ($file =~ /\n=head\d DESCRIPTION\s*\n\s*((?:(?<!=head).+\n){1,15})/) {
 468                 $info->{descr} = $1;
 469                 my $tmp;
 470                 run ['fmt'], \$info->{descr}, \$tmp;
 471                 $info->{descr} = $tmp if length $tmp;
 472                 $info->{descr} =~ s/\s+$//g;
 473         }
 474         else {
 475                 warn " ,, no description: $_\n";
 476                 $info->{descr} = '';
 477         }
 478
 479 =cut
 480
 481         $info->{_tests}->{find_summ_descr} =
 482           ($info->{summary} || $info->{descr}) ? 1 : 0;
 483 }
 484
 485 sub test_build_style {
 486         my $info = shift;
 487         return $info->{_tests}->{build_style}
 488           if defined $info->{_tests}->{build_style};
 489         $info->{uses_makemaker}    = -e 'Makefile.PL';
 490         $info->{uses_module_build} = -e 'Build.PL';
 491         $info->{uses_makemaker}    = 0
 492           if $opts{modulebuild} && $info->{uses_module_build};
 493         $info->{uses_module_build} = 0
 494           if $opts{makemaker} && $info->{uses_makemaker};
 495         $info->{_tests}->{build_style} =
 496           ($info->{uses_module_build} || $info->{uses_makemaker}) ? 1 : 0;
 497 }
 498
 499 sub gen_tarname_unexp {
 500         my $info = shift;
 501         return
 502           unless exists $info->{tarname} && test_directory($info->{dir}, $info);
 503         (my $tmp = $info->{tarname}) =~ s#.*/##;
 504         $info->{tarname_unexp} = unexpand_macros($info, $tmp);
 505 }
 506
 507 sub unexpand_macros {
 508         my $info  = shift;
 509         my $value = shift;
 510         $value =~ s/\Q$info->{pdir}\E/%{pdir}/;
 511         $value =~ s/\Q$info->{pnam}\E/%{pnam}/ if $info->{pnam};
 512         $value =~ s/\Q$info->{version}\E/%{version}/;
 513         $value;
 514 }
 515
 516 sub test_is_xs {
 517         my $info = shift;
 518         return $info->{_tests}->{is_xs}
 519           if defined $info->{_tests}->{is_xs};
 520
 521         # Ugly bitch.
 522         $info->{_tests}->{is_xs} = ( <*.c> || <*.xs> || <*/*.c> || <*/*.xs> || <*/*/*.c> || <*/*/*.xs> ) ? 1 : 0;
 523 }
 524
 525 sub run_configure {
 526         my $info = shift;
 527         test_build_style($info);
 528         return $info->{_tests}->{run_configure}
 529           if defined $info->{_tests}->{run_configure};
 530
 531         $info->{tmp_destdir} = getcwd() . "/pldcpan_destdir_$$";
 532         system(qw(rm -rf), $info->{tmp_destdir}) if -e $info->{tmp_destdir};
 533         my @cmd;
 534         if ($info->{_tests}->{build_style}) {
 535                 @cmd =
 536                   $info->{uses_makemaker}
 537                   ? qw(perl Makefile.PL INSTALLDIRS=vendor)
 538                   : (
 539                         qw(perl Build.PL installdirs=vendor config="optimize='%{rpmcflags}'"),
 540                         qw(destdir='$info->{tmp_destdir}')
 541                   );
 542         }
 543         else {
 544                 @cmd = (
 545                         qw(perl -MExtUtils::MakeMaker -wle),
 546                         qq#WriteMakefile(NAME=>"$info->{parts_joined}")#,
 547                         qw(INSTALLDIRS=>vendor)
 548                 );
 549         }
 550         $info->{_tests}->{run_configure} = run \@cmd, \undef, \my $out, \my $err,
 551           timeout(20);
 552 }
 553
 554 sub run_build {
 555         my $info = shift;
 556         return $info->{_tests}->{run_build} if defined $info->{_tests}->{run_build};
 557         return $info->{_tests}->{run_build} = 0 unless run_configure($info);
 558
 559         my @cmd;
 560         if ($info->{_tests}->{build_style}) {
 561                 @cmd =
 562                   $info->{uses_makemaker}
 563                   ? qw(make)
 564                   : qw(perl ./Build);
 565         }
 566         else {
 567                 @cmd = qw(make);
 568         }
 569         $info->{_tests}->{run_build} = run \@cmd, \undef, \my $out, \my $err,
 570           timeout(60);
 571 }
 572
 573 sub run_test {
 574         my $info = shift;
 575         return $info->{_tests}->{run_test} if defined $info->{_tests}->{run_test};
 576         return $info->{_tests}->{run_test} = 0 unless run_build($info);
 577
 578         my @cmd;
 579         if ($info->{_tests}->{build_style}) {
 580                 @cmd =
 581                   $info->{uses_makemaker}
 582                   ? qw(make test)
 583                   : qw(perl ./Build test);
 584         }
 585         else {
 586                 @cmd = qw(make test);
 587         }
 588         $info->{_tests}->{run_test} = run \@cmd, \undef, \my $out, \my $err,
 589           timeout(360);
 590 }
 591
 592 sub run_install {
 593         my $info = shift;
 594         return $info->{_tests}->{run_install}
 595           if defined $info->{_tests}->{run_install};
 596         return $info->{_tests}->{run_install} = 0 unless run_build($info);
 597
 598         my @cmd;
 599         if ($info->{_tests}->{build_style}) {
 600                 @cmd =
 601                   $info->{uses_makemaker}
 602                   ? (qw(make install), "DESTDIR='$info->{tmp_destdir}'")
 603                   : qw(perl ./Build install);
 604         }
 605         else {
 606                 @cmd = (qw(make install), "DESTDIR='$info->{tmp_destdir}'");
 607         }
 608         die "nfy";
 609 }
 610
 611 sub find_files {
 612         my $info = shift;
 613         return $info->{_tests}->{find_files}
 614           if defined $info->{_tests}->{find_files};
 615         return $info->{_tests}->{find_files} = 0 unless run_install($info);
 616         die "nfy";
 617 }
 618
 619 sub build_reqs_list {
 620         my $info = shift;
 621         my $rr   = $info->{META_yml}->{requires};
 622         my $br   = $info->{META_yml}->{build_requires};
 623         my %RR   = map format_r_or_br( $_, $rr->{$_} ), keys %$rr;
 624         my %BR   = map format_r_or_br( $_, $br->{$_} ), keys %$br;
 625         $info->{requires}       = \%RR;
 626         $info->{build_requires} = \%BR;
 627 }
 628
 629 sub format_r_or_br {
 630         my ( $package, $version ) = @_;
 631         my $rpmreq = "perl($package)";
 632         ( my $possible = "perl-$package" ) =~ s/::/-/g;
 633         if (   run( [ 'rpm', '-q', $possible ], \my ( undef, $out, $err ) )
 634                 or run( [ 'rpm', '-q', '--whatprovides', $possible ], \my ( undef, $out2, $err2 ) ) )
 635         {
 636                 return $possible => $version;    # we have this package or it is provided by something else
 637         }
 638         elsif ( run( [ 'rpm', '-q', '--qf', '%{NAME}\n', '--whatprovides', $rpmreq ], \my ( undef, $out3, $err3 ) ) ) {
 639                 my @providers = grep !/^perl-(?:base|modules|devel)$/, split /\s+/, $out3;    # might be more than one
 640                 return unless @providers;                                                     # core, ignore
 641                 return $providers[0] => $version if @providers == 1;
 642         }
 643         return $rpmreq => $version;                                                       # fallback
 644 }
 645
 646 for my $arg (@ARGV) {
 647         my $info = { _tests => {} };
 648
 649         if (-e $arg) {
 650                 ## local file; otherwise... hackish trash code :-]
 651                 ## TODO: %pdir / %pnam in %URL
 652         }
 653         elsif (my ($tarname) =
 654                 $arg =~ m# ^ (?:https?|ftp):// [^/]+/ (?:[^/]+/)* ([^/]+) $ #x)
 655         {
 656                 $info->{url} = $arg;
 657                 warn " -- fetching '$tarname'\n";
 658                 my $response = LWP::Simple::mirror($info->{url}, $tarname);
 659                 if (HTTP::Status::is_error($response)) {
 660                         warn " !! fetching '$tarname' failed: code $response. omiting.\n";
 661                         next;
 662                 }
 663                 $arg = $tarname;
 664         }
 665         elsif ($arg =~ /^[a-z\d_]+(?:(?:::|-)[a-z\d_]+)*$/i) {
 666                 my $dist = $arg;
 667                 $dist =~ s/-/::/g if $dist =~ /-/;
 668                 warn " -- searching for '$dist' on metacpan.org\n";
 669                 my $scpan = LWP::Simple::get("https://fastapi.metacpan.org/v1/download_url/$dist");
 670                 if (   !defined $scpan
 671                         || $scpan =~ /Not found/
 672                         || $scpan !~ m#"download_url" : ".*/authors/id/([^"]+/([^/"]+))"#)
 673                 {
 674                         warn " !! searching for '$dist' on metacpan.org failed\n";
 675                         next;
 676                 }
 677                 $info->{url} = "http://www.cpan.org/modules/by-authors/id/$1";
 678                 my ($tarname) = $2;
 679                 warn " .. found $info->{url}\n";
 680                 my $response = LWP::Simple::mirror($info->{url}, $tarname);
 681                 if (HTTP::Status::is_error($response)) {
 682                         warn " !! fetching '$tarname' failed: code $response. omiting.\n";
 683                         next;
 684                 }
 685                 $arg = $tarname;
 686         }
 687         else {
 688                 warn " !! omiting '$arg': !-e or bad URL\n";
 689                 next;
 690         }
 691
 692         if (-d $arg) {
 693                 $info->{dir} = $arg =~ m#^/# ? $arg : getcwd() . "/$arg";
 694                 test_directory($arg, $info);
 695         }
 696         else {
 697                 open my $fh, $arg or die "can't open <$arg>: $!";
 698                 $info->{source0md5} = Digest::MD5->new->addfile($fh)->hexdigest;
 699                 close $fh or die "close <$arg>: $!";
 700
 701                 $info->{tarname} = $arg;
 702                 my $arch = Archive::Any->new($arg);
 703                 unless ($arch) {
 704                         warn " -- unpacking failed, omiting $arg";
 705                         next;
 706                 }
 707                 if ($arch->is_naughty) {
 708                         warn " !! Archive::Any says, that $arg is_naughty. omiting.\n";
 709                         next;
 710                 }
 711                 test_archive_name($arg, $info);
 712                 if ($info->{is_impolite} = $arch->is_impolite) {
 713                         if (!$info->{_tests}->{archive_name}) {
 714                                 warn
 715                                   "test_archive_name failed and $arg is_impolite; giving up\n";
 716                                 next;
 717                         }
 718                         $info->{dir} = getcwd() . "/$info->{ballname}-$info->{version}";
 719                         mkdir $info->{dir} or die "can't mkdir <$info->{dir}>, $arg!";
 720                         $arch->extract($info->{dir}) or die "Ni! $arg\n";
 721                 }
 722                 else {
 723                         ($arch->files)[0] =~ m#^(?:\.?/)?([^/]+)(?:/|$)#
 724                           or die "can't resolve dir from content of $arg";
 725                         $info->{dir} = getcwd() . "/$1";
 726                         $arch->extract or die "Nii! $arg\n";
 727                 }
 728         }
 729
 730         test_find_pod_file($info);
 731
 732         my $basedir = getcwd;
 733
 734         $info->{dir} =~ s{/*$}{};
 735         die " !! not a directory: $info->{dir}" unless -d $info->{dir};
 736         warn " .. processing $info->{dir}\n";
 737         chdir $info->{dir};
 738
 739 #       test_find_summ_descr($info);
 740         test_find_summ_descr2($info);
 741         test_license($info);
 742         test_is_xs($info);
 743         test_has_tests($info);
 744         test_has_examples($info);
 745         test_has_doc_files($info);
 746         test_build_style($info);
 747         gen_tarname_unexp($info);
 748         build_reqs_list($info);
 749
 750         $info->{dir} =~ s#.*/##;
 751         $info->{dir_unexp} = unexpand_macros($info, $info->{dir});
 752
 753         # try to fixup the URL
 754         if ($info->{url} && $info->{url} =~ m,/by-authors/id/, && $info->{pdir}) {
 755                 my $base_url = "http://www.cpan.org/modules/by-module/$info->{pdir}/";
 756                 if (LWP::Simple::head($base_url . $info->{tarname})) {
 757                         $info->{url} = $base_url . unexpand_macros($info, $info->{tarname});
 758                 }
 759         }
 760
 761         chdir $basedir;
 762
 763         # hack for TT
 764         $info = {
 765                 %$info,
 766                 map { ; "test_$_" => $info->{_tests}->{$_} }
 767                   keys %{ $info->{_tests} }
 768         };
 769
 770         pp($info) if $opts{verbose};
 771
 772         die " !! I find the idea of overwriting perl.spec disgusting."
 773           unless @{ $info->{parts} };
 774         my $spec = join('-', "$basedir/perl", @{ $info->{parts} }) . '.spec';
 775         warn " .. writing to '$spec'" . (-e $spec ? " ... which exists...\n" : "\n");
 776         die " !! I'm not to overwriting '$spec' without --force\n"
 777           if -e $spec && !$opts{force};
 778
 779         my $rotfl = tell DATA;
 780         my $tmpl  =
 781           Template->new(
 782                 { INTERPOLATE => 0, POST_CHOMP => 0, EVAL_PERL => 1, ABSOLUTE => 1 });
 783         $tmpl->process(\*DATA, $info, $spec)
 784           || warn "error parsing $info->{dir}: "
 785           . $tmpl->error->type . "\n"
 786           . $tmpl->error->info . "\n"
 787           . $tmpl->error . "\n";
 788         seek DATA, $rotfl, 0;
 789 }
 790
 791 # vim: ts=4 sw=4 noet noai nosi cin
 792 __DATA__
 793 #
 794 # Conditional build:
 795 %bcond_without  tests           # do not perform "make test"
 796 #
 797 %define         pdir    [% pdir %]
 798 [% IF pnam -%]
 799 %define         pnam    [% pnam %]
 800 [% END -%]
 801 Summary:        [% summary.replace('[\r\n\t ]+', ' ') |trim %]
 802 #Summary(pl.UTF-8):
 803 Name:           perl-[% pdir %][% IF pnam %]-[% pnam %][% END %]
 804 Version:        [% version %]
 805 Release:        1
 806 [% IF test_license && license == 'perl' -%]
 807 # same as perl
 808 License:        GPL v1+ or Artistic
 809 [% ELSIF test_license -%]
 810 License:        [% license %]
 811 [% ELSE -%]
 812 # same as perl (REMOVE THIS LINE IF NOT TRUE)
 813 #License:       GPL v1+ or Artistic
 814 [% END -%]
 815 Group:          Development/Languages/Perl
 816 [% IF url -%]
 817 Source0:        [% url %]
 818 [% ELSIF tarname -%]
 819 Source0:        http://www.cpan.org/modules/by-module/[% pdir %]/[% tarname_unexp %]
 820 [% ELSIF pnam -%]
 821 Source0:        http://www.cpan.org/modules/by-module/[% pdir %]/%{pdir}-%{pnam}-%{version}.tar.gz
 822 [% ELSE -%]
 823 Source0:        http://www.cpan.org/modules/by-module/[% pdir %]/%{pdir}-%{version}.tar.gz
 824 [% END -%]
 825 [% IF source0md5 -%]
 826 # Source0-md5:  [% source0md5 %]
 827 [% END -%]
 828 # generic URL, check or change before uncommenting
 829 [% IF pnam -%]
 830 #URL:           https://metacpan.org/release/[% pdir %]-[% pnam %]
 831 [% ELSE -%]
 832 #URL:           https://metacpan.org/release/[% pdir %]
 833 [% END -%]
 834 [% IF uses_module_build -%]
 835 [% req = 'perl-Module-Build' -%]
 836 BuildRequires:  perl-Module-Build[% ' >= ' _ build_requires.$req IF build_requires.$req %]
 837 [% build_requires.delete('perl-Module-Build') -%]
 838 [% END -%]
 839 BuildRequires:  perl-devel >= 1:5.8.0
 840 BuildRequires:  rpm-perlprov >= 4.1-13
 841 BuildRequires:  rpmbuild(macros) >= 1.745
 842 [% IF test_has_tests -%]
 843 %if %{with tests}
 844 [% FOREACH req IN requires.keys.sort -%]
 845 BuildRequires:  [% req %][% ' >= ' _ requires.$req IF requires.$req %]
 846 [% END -%]
 847 [% FOREACH req IN build_requires.keys.sort -%]
 848 [% NEXT IF requires.exists(req) -%]
 849 BuildRequires:  [% req %][% ' >= ' _ build_requires.$req IF build_requires.$req %]
 850 [% END -%]
 851 %endif
 852 [% END -%]
 853 [% IF !test_is_xs -%]
 854 BuildArch:      noarch
 855 [% END -%]
 856 BuildRoot:      %{tmpdir}/%{name}-%{version}-root-%(id -u -n)
 857
 858 %description
 859 [% descr %]
 860
 861 # %description -l pl.UTF-8
 862 # TODO
 863
 864 %prep
 865 %setup -q -n [% dir_unexp %][% IF is_impolite %]-c[% END %]
 866
 867 %build
 868 [%- IF uses_module_build %]
 869 %{__perl} Build.PL \
 870 [%- IF test_is_xs %]
 871         config="optimize='%{rpmcflags}'" \
 872 [%- END %]
 873         destdir=$RPM_BUILD_ROOT \
 874         installdirs=vendor
 875 ./Build
 876
 877 %{?with_tests:./Build test}
 878 [%- ELSIF uses_makemaker %]
 879 %{__perl} Makefile.PL \
 880         INSTALLDIRS=vendor
 881 %{__make}[% IF test_is_xs -%] \
 882         CC="%{__cc}" \
 883         OPTIMIZE="%{rpmcflags}"[% END %]
 884
 885 %{?with_tests:%{__make} test}
 886 [%- ELSE %]
 887 %{__perl} -MExtUtils::MakeMaker -wle 'WriteMakefile(NAME=>"[% parts_joined %]")' \
 888         INSTALLDIRS=vendor
 889 %{__make}[% IF test_is_xs -%] \
 890         CC="%{__cc}" \
 891         OPTIMIZE="%{rpmcflags}"[% END %]
 892
 893 %{?with_tests:%{__make} test}
 894 [%- END %]
 895
 896 %install
 897 rm -rf $RPM_BUILD_ROOT
 898
 899 [% IF uses_module_build || !uses_makemaker -%]
 900 ./Build install
 901 [% ELSE -%]
 902 %{__make} pure_install \
 903         DESTDIR=$RPM_BUILD_ROOT
 904 [% END -%]
 905 [% IF test_has_examples -%]
 906
 907 install -d $RPM_BUILD_ROOT%{_examplesdir}/%{name}-%{version}
 908 [% FOREACH eg = examples -%]
 909 cp -a [% eg %] $RPM_BUILD_ROOT%{_examplesdir}/%{name}-%{version}
 910 [% END -%]
 911 [% END -%]
 912
 913 %clean
 914 rm -rf $RPM_BUILD_ROOT
 915
 916 %files
 917 %defattr(644,root,root,755)
 918 [% IF test_has_doc_files -%]
 919 %doc[% FOREACH doc = doc_files %] [% doc %][% END %]
 920 [% END -%]
 921 [% IF test_is_xs -%]
 922 %{perl_vendorarch}/[% pdir %]/*.pm
 923 %dir %{perl_vendorarch}/auto/[% pdir %]/[% pnam %]
 924 %{perl_vendorarch}/auto/[% pdir %]/[% pnam %]/*.bs
 925 %attr(755,root,root) %{perl_vendorarch}/auto/[% pdir %]/[% pnam %]/*.so
 926 [% ELSE -%]
 927 [%- number = parts.size - 1 -%]
 928 %{perl_vendorlib}/[% parts.first(number).join('/') %]/*.pm
 929 %{perl_vendorlib}/[% pdir %]/[% parts.last(number).join('/') %]
 930 [% END -%]
 931 %{_mandir}/man3/*
 932 [% IF test_has_examples -%]
 933 %{_examplesdir}/%{name}-%{version}
 934 [% END -%]