ext/Devel/PPPort/devel/buildperl.pl

   1 #!/usr/bin/perl -w
   2 ################################################################################
   3 #
   4 #  buildperl.pl -- build various versions of perl automatically
   5 #
   6 ################################################################################
   7 #
   8 #  $Revision: 15 $
   9 #  $Author: mhx $
  10 #  $Date: 2009/01/18 14:10:50 +0100 $
  11 #
  12 ################################################################################
  13 #
  14 #  Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz.
  15 #  Version 2.x, Copyright (C) 2001, Paul Marquess.
  16 #  Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
  17 #
  18 #  This program is free software; you can redistribute it and/or
  19 #  modify it under the same terms as Perl itself.
  20 #
  21 ################################################################################
  22
  23 use strict;
  24 use Getopt::Long;
  25 use Pod::Usage;
  26 use File::Find;
  27 use File::Path;
  28 use Data::Dumper;
  29 use IO::File;
  30 use Cwd;
  31
  32 # TODO: - extra arguments to Configure
  33
  34 #
  35 #  --test-archives=1      check if archives can be read
  36 #  --test-archives=2      like 1, but also extract archives
  37 #  --test-archives=3      like 2, but also apply patches
  38 #
  39
  40 my %opt = (
  41   prefix    => '/tmp/perl/install/<config>/<perl>',
  42   build     => '/tmp/perl/build/<config>',
  43   source    => '/tmp/perl/source',
  44   force     => 0,
  45   test      => 0,
  46   install   => 1,
  47   oneshot   => 0,
  48   configure => 0,
  49   'test-archives' => 0,
  50 );
  51
  52 my %config = (
  53   default     => {
  54                    config_args => '-des',
  55                  },
  56   thread      => {
  57                    config_args     => '-des -Dusethreads',
  58                    masked_versions => [ qr/^5\.00[01234]/ ],
  59                  },
  60   thread5005  => {
  61                    config_args     => '-des -Duse5005threads',
  62                    masked_versions => [ qr/^5\.00[012345]|^5.(9|\d\d)/ ],
  63                  },
  64   debug       => {
  65                    config_args => '-des -Doptimize=-g',
  66                  },
  67 );
  68
  69 my @patch = (
  70   {
  71     perl => [
  72               qr/^5\.00[01234]/,
  73               qw/
  74                 5.005
  75                 5.005_01
  76                 5.005_02
  77                 5.005_03
  78               /,
  79             ],
  80     subs => [
  81               [ \&patch_db, 1 ],
  82             ],
  83   },
  84   {
  85     perl => [
  86               qw/
  87                 5.6.0
  88                 5.6.1
  89                 5.7.0
  90                 5.7.1
  91                 5.7.2
  92                 5.7.3
  93                 5.8.0
  94               /,
  95             ],
  96     subs => [
  97               [ \&patch_db, 3 ],
  98             ],
  99   },
 100   {
 101     perl => [
 102               qr/^5\.004_0[1234]$/,
 103             ],
 104     subs => [
 105               [ \&patch_doio ],
 106             ],
 107   },
 108   {
 109     perl => [
 110               qw/
 111                 5.005
 112                 5.005_01
 113                 5.005_02
 114               /,
 115             ],
 116     subs => [
 117               [ \&patch_sysv, old_format => 1 ],
 118             ],
 119   },
 120   {
 121     perl => [
 122               qw/
 123                 5.005_03
 124                 5.005_04
 125               /,
 126               qr/^5\.6\.[0-2]$/,
 127               qr/^5\.7\.[0-3]$/,
 128               qr/^5\.8\.[0-8]$/,
 129               qr/^5\.9\.[0-5]$/
 130             ],
 131     subs => [
 132               [ \&patch_sysv ],
 133             ],
 134   },
 135 );
 136
 137 my(%perl, @perls);
 138
 139 GetOptions(\%opt, qw(
 140   config=s@
 141   prefix=s
 142   build=s
 143   source=s
 144   perl=s@
 145   force
 146   test
 147   install!
 148   test-archives=i
 149   patch!
 150   oneshot
 151 )) or pod2usage(2);
 152
 153 my %current;
 154
 155 if ($opt{patch} || $opt{oneshot}) {
 156   @{$opt{perl}} == 1 or die "Exactly one --perl must be given with --patch or --oneshot\n";
 157   my $perl = $opt{perl}[0];
 158   patch_source($perl) if !exists $opt{patch} || $opt{patch};
 159   if (exists $opt{oneshot}) {
 160     eval { require String::ShellQuote };
 161     die "--oneshot requires String::ShellQuote to be installed\n" if $@;
 162     %current = (config => 'oneshot', version => $perl);
 163     $config{oneshot} = { config_args => String::ShellQuote::shell_quote(@ARGV) };
 164     build_and_install($perl{$perl});
 165   }
 166   exit 0;
 167 }
 168
 169 if (exists $opt{config}) {
 170   for my $cfg (@{$opt{config}}) {
 171     exists $config{$cfg} or die "Unknown configuration: $cfg\n";
 172   }
 173 }
 174 else {
 175   $opt{config} = [sort keys %config];
 176 }
 177
 178 find(sub {
 179   /^(perl-?(5\..*))\.tar\.(gz|bz2)$/ or return;
 180   $perl{$1} = { version => $2, source => $File::Find::name, compress => $3 };
 181 }, $opt{source});
 182
 183 if (exists $opt{perl}) {
 184   for my $perl (@{$opt{perl}}) {
 185     my $p = $perl;
 186     exists $perl{$p} or $p = "perl$perl";
 187     exists $perl{$p} or $p = "perl-$perl";
 188     exists $perl{$p} or die "Cannot find perl: $perl\n";
 189     push @perls, $p;
 190   }
 191 }
 192 else {
 193   @perls = sort keys %perl;
 194 }
 195
 196 if ($opt{'test-archives'}) {
 197   my $test = 'test';
 198   my $cwd = cwd;
 199   -d $test or mkpath($test);
 200   chdir $test or die "chdir $test: $!\n";
 201   for my $perl (@perls) {
 202     eval {
 203       my $d = extract_source($perl{$perl});
 204       if ($opt{'test-archives'} > 2) {
 205         my $cwd2 = cwd;
 206         chdir $d or die "chdir $d: $!\n";
 207         patch_source($perl{$perl}{version});
 208         chdir $cwd2 or die "chdir $cwd2:$!\n"
 209       }
 210       rmtree($d) if -e $d;
 211     };
 212     warn $@ if $@;
 213   }
 214   chdir $cwd or die "chdir $cwd: $!\n";
 215   print STDERR "cleaning up\n";
 216   rmtree($test);
 217   exit 0;
 218 }
 219
 220 for my $cfg (@{$opt{config}}) {
 221   for my $perl (@perls) {
 222     my $config = $config{$cfg};
 223     %current = (config => $cfg, perl => $perl, version => $perl{$perl}{version});
 224
 225     if (is($config->{masked_versions}, $current{version})) {
 226       print STDERR "skipping $perl for configuration $cfg (masked)\n";
 227       next;
 228     }
 229
 230     if (-d expand($opt{prefix}) and !$opt{force}) {
 231       print STDERR "skipping $perl for configuration $cfg (already installed)\n";
 232       next;
 233     }
 234
 235     my $cwd = cwd;
 236
 237     my $build = expand($opt{build});
 238     -d $build or mkpath($build);
 239     chdir $build or die "chdir $build: $!\n";
 240
 241     print STDERR "building $perl with configuration $cfg\n";
 242     buildperl($perl, $config);
 243
 244     chdir $cwd or die "chdir $cwd: $!\n";
 245   }
 246 }
 247
 248 sub expand
 249 {
 250   my $in = shift;
 251   $in =~ s/(<(\w+)>)/exists $current{$2} ? $current{$2} : $1/eg;
 252   return $in;
 253 }
 254
 255 sub is
 256 {
 257   my($s1, $s2) = @_;
 258
 259   defined $s1 != defined $s2 and return 0;
 260
 261   ref $s2 and ($s1, $s2) = ($s2, $s1);
 262
 263   if (ref $s1) {
 264     if (ref $s1 eq 'ARRAY') {
 265       is($_, $s2) and return 1 for @$s1;
 266       return 0;
 267     }
 268     return $s2 =~ $s1;
 269   }
 270
 271   return $s1 eq $s2;
 272 }
 273
 274 sub buildperl
 275 {
 276   my($perl, $cfg) = @_;
 277
 278   my $d = extract_source($perl{$perl});
 279   chdir $d or die "chdir $d: $!\n";
 280
 281   patch_source($perl{$perl}{version});
 282
 283   build_and_install($perl{$perl});
 284 }
 285
 286 sub extract_source
 287 {
 288   eval { require Archive::Tar };
 289   die "Archive processing requires Archive::Tar to be installed\n" if $@;
 290
 291   my $perl = shift;
 292
 293   my $what = $opt{'test-archives'} ? 'test' : 'read';
 294   print "${what}ing $perl->{source}\n";
 295
 296   my $target;
 297
 298   for my $f (Archive::Tar->list_archive($perl->{source})) {
 299     my($t) = $f =~ /^([^\\\/]+)/ or die "ooops, should always match...\n";
 300     die "refusing to extract $perl->{source}, as it would not extract to a single directory\n"
 301         if defined $target and $target ne $t;
 302     $target = $t;
 303   }
 304
 305   if ($opt{'test-archives'} == 0 || $opt{'test-archives'} > 1) {
 306     if (-d $target) {
 307       print "removing old build directory $target\n";
 308       rmtree($target);
 309     }
 310
 311     print "extracting $perl->{source}\n";
 312
 313     Archive::Tar->extract_archive($perl->{source})
 314         or die "extract failed: " . Archive::Tar->error() . "\n";
 315
 316     -d $target or die "oooops, $target not found\n";
 317   }
 318
 319   return $target;
 320 }
 321
 322 sub patch_source
 323 {
 324   my $version = shift;
 325
 326   for my $p (@patch) {
 327     if (is($p->{perl}, $version)) {
 328       for my $s (@{$p->{subs}}) {
 329         my($sub, @args) = @$s;
 330         $sub->(@args);
 331       }
 332     }
 333   }
 334 }
 335
 336 sub build_and_install
 337 {
 338   my $perl = shift;
 339   my $prefix = expand($opt{prefix});
 340
 341   print "building perl $perl->{version} ($current{config})\n";
 342
 343   run_or_die("./Configure $config{$current{config}}{config_args} -Dusedevel -Uinstallusrbinperl -Dprefix=$prefix");
 344   run_or_die("sed -i -e '/^.*<built-in>/d' -e '/^.*<command line>/d' makefile x2p/makefile");
 345   run_or_die("make all");
 346   run("make test") if $opt{test};
 347   if ($opt{install}) {
 348     run_or_die("make install");
 349   }
 350   else {
 351     print "\n*** NOT INSTALLING PERL ***\n\n";
 352   }
 353 }
 354
 355 sub patch_db
 356 {
 357   my $ver = shift;
 358   print "patching ext/DB_File/DB_File.xs\n";
 359   run_or_die("sed -i -e 's/<db.h>/<db$ver\\/db.h>/' ext/DB_File/DB_File.xs");
 360 }
 361
 362 sub patch_doio
 363 {
 364   patch(<<'END');
 365 --- doio.c.org  2004-06-07 23:14:45.000000000 +0200
 366 +++ doio.c      2003-11-04 08:03:03.000000000 +0100
 367 @@ -75,6 +75,16 @@
 368  #  endif
 369  #endif
 370
 371 +#if _SEM_SEMUN_UNDEFINED
 372 +union semun
 373 +{
 374 +  int val;
 375 +  struct semid_ds *buf;
 376 +  unsigned short int *array;
 377 +  struct seminfo *__buf;
 378 +};
 379 +#endif
 380 +
 381  bool
 382  do_open(gv,name,len,as_raw,rawmode,rawperm,supplied_fp)
 383  GV *gv;
 384 END
 385 }
 386
 387 sub patch_sysv
 388 {
 389   my %opt = @_;
 390
 391   # check if patching is required
 392   return if $^O ne 'linux' or -f '/usr/include/asm/page.h';
 393
 394   if ($opt{old_format}) {
 395     patch(<<'END');
 396 --- ext/IPC/SysV/SysV.xs.org    1998-07-20 10:20:07.000000000 +0200
 397 +++ ext/IPC/SysV/SysV.xs        2007-08-12 10:51:06.000000000 +0200
 398 @@ -3,9 +3,6 @@
 399  #include "XSUB.h"
 400
 401  #include <sys/types.h>
 402 -#ifdef __linux__
 403 -#include <asm/page.h>
 404 -#endif
 405  #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
 406  #include <sys/ipc.h>
 407  #ifdef HAS_MSG
 408 END
 409   }
 410   else {
 411     patch(<<'END');
 412 --- ext/IPC/SysV/SysV.xs.org    2007-08-11 00:12:46.000000000 +0200
 413 +++ ext/IPC/SysV/SysV.xs        2007-08-11 00:10:51.000000000 +0200
 414 @@ -3,9 +3,6 @@
 415  #include "XSUB.h"
 416
 417  #include <sys/types.h>
 418 -#ifdef __linux__
 419 -#   include <asm/page.h>
 420 -#endif
 421  #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
 422  #ifndef HAS_SEM
 423  #   include <sys/ipc.h>
 424 END
 425   }
 426 }
 427
 428 sub patch
 429 {
 430   my($patch) = @_;
 431   print "patching $_\n" for $patch =~ /^\+{3}\s+(\S+)/gm;
 432   my $diff = 'tmp.diff';
 433   write_or_die($diff, $patch);
 434   run_or_die("patch -s -p0 <$diff");
 435   unlink $diff or die "unlink $diff: $!\n";
 436 }
 437
 438 sub write_or_die
 439 {
 440   my($file, $data) = @_;
 441   my $fh = new IO::File ">$file" or die "$file: $!\n";
 442   $fh->print($data);
 443 }
 444
 445 sub run_or_die
 446 {
 447   # print "[running @_]\n";
 448   system "@_" and die "@_: $?\n";
 449 }
 450
 451 sub run
 452 {
 453   # print "[running @_]\n";
 454   system "@_" and warn "@_: $?\n";
 455 }
 456
 457 __END__
 458
 459 =head1 NAME
 460
 461 buildperl.pl - build/install perl distributions
 462
 463 =head1 SYNOPSIS
 464
 465   perl buildperl.pl [options]
 466
 467   --help                      show this help
 468
 469   --source=directory          directory containing source tarballs
 470                               [default: /tmp/perl/source]
 471
 472   --build=directory           directory used for building perls [EXPAND]
 473                               [default: /tmp/perl/build/<config>]
 474
 475   --prefix=directory          use this installation prefix [EXPAND]
 476                               [default: /tmp/perl/install/<config>/<perl>]
 477
 478   --config=configuration      build this configuration [MULTI]
 479                               [default: all possible configurations]
 480
 481   --perl=version              build this version of perl [MULTI]
 482                               [default: all possible versions]
 483
 484   --force                     rebuild and install already installed versions
 485
 486   --test                      run test suite after building
 487
 488   --noinstall                 don't install after building
 489
 490   --patch                     only patch the perl source in the current directory
 491
 492   --oneshot                   build from the perl source in the current directory
 493                               (extra arguments are passed to Configure)
 494
 495   options tagged with [MULTI] can be given multiple times
 496
 497   options tagged with [EXPAND] expand the following items
 498
 499     <perl>      versioned perl directory  (e.g. 'perl-5.6.1')
 500     <version>   perl version              (e.g. '5.6.1')
 501     <config>    name of the configuration (e.g. 'default')
 502
 503 =head1 EXAMPLES
 504
 505 The following examples assume that your Perl source tarballs are
 506 in F</tmp/perl/source>. If they are somewhere else, use the C<--source>
 507 option to specify a different source directory.
 508
 509 To build a default configuration of perl5.004_05 and install it
 510 to F</opt/perl5.004_05>, you would say:
 511
 512   buildperl.pl --prefix='/opt/<perl>' --perl=5.004_05 --config=default
 513
 514 To build debugging configurations of all perls in the source directory
 515 and install them to F</opt>, use:
 516
 517   buildperl.pl --prefix='/opt/<perl>' --config=debug
 518
 519 To build all configurations for perl-5.8.5 and perl-5.8.6, test them
 520 and don't install them, run:
 521
 522   buildperl.pl --perl=5.8.5 --perl=5.8.6 --test --noinstall
 523
 524 To build and install a single version of perl with special configuration
 525 options, use:
 526
 527   buildperl.pl --perl=5.6.0 --prefix=/opt/p560ld --oneshot -- -des -Duselongdouble
 528
 529 =head1 COPYRIGHT
 530
 531 Copyright (c) 2004-2009, Marcus Holland-Moritz.
 532
 533 This program is free software; you can redistribute it and/or
 534 modify it under the same terms as Perl itself.
 535
 536 =head1 SEE ALSO
 537
 538 See L<Devel::PPPort> and L<HACKERS>.
 539