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