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