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: 4 $
   9 #  $Author: mhx $
  10 #  $Date: 2005/01/31 08:10:49 +0100 $
  11 #
  12 ################################################################################
  13 #
  14 #  Version 3.x, Copyright (C) 2004-2005, 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 my %opt = (
  33   prefix => '/tmp/perl/install/<config>/<perl>',
  34   build  => '/tmp/perl/build/<config>',
  35   source => '/tmp/perl/source',
  36   force  => 0,
  37 );
  38
  39 my %config = (
  40   default     => {
  41                    config_args => '-des',
  42                  },
  43   thread      => {
  44                    config_args     => '-des -Dusethreads',
  45                    masked_versions => [ qr/^perl5\.00[01234]/ ],
  46                  },
  47   thread5005  => {
  48                    config_args     => '-des -Duse5005threads',
  49                    masked_versions => [ qr/^perl5\.00[012345]|^perl-5.(9|\d\d)/ ],
  50                  },
  51   debug       => {
  52                    config_args => '-des -Doptimize=-g',
  53                  },
  54 );
  55
  56 my @patch = (
  57   {
  58     perl => [
  59               qr/^perl5\.00[01234]/,
  60               qw/
  61                 perl5.005
  62                 perl5.005_01
  63                 perl5.005_02
  64                 perl5.005_03
  65               /,
  66             ],
  67     subs => [
  68               [ \&patch_db, 1 ],
  69             ],
  70   },
  71   {
  72     perl => [
  73               qw/
  74                 perl-5.6.0
  75                 perl-5.6.1
  76                 perl-5.7.0
  77                 perl-5.7.1
  78                 perl-5.7.2
  79                 perl-5.7.3
  80                 perl-5.8.0
  81               /,
  82             ],
  83     subs => [
  84               [ \&patch_db, 3 ],
  85             ],
  86   },
  87   {
  88     perl => [
  89               qr/^perl5\.004_0[1234]/,
  90             ],
  91     subs => [
  92               [ \&patch_doio ],
  93             ],
  94   },
  95 );
  96
  97 my(%perl, @perls);
  98
  99 GetOptions(\%opt, qw(
 100   config=s@
 101   prefix=s
 102   source=s
 103   perl=s@
 104   force
 105 )) or pod2usage(2);
 106
 107 if (exists $opt{config}) {
 108   for my $cfg (@{$opt{config}}) {
 109     exists $config{$cfg} or die "Unknown configuration: $cfg\n";
 110   }
 111 }
 112 else {
 113   $opt{config} = [sort keys %config];
 114 }
 115
 116 find(sub {
 117   /^(perl-?(5\..*))\.tar.gz$/ or return;
 118   $perl{$1} = { version => $2, source => $File::Find::name };
 119 }, $opt{source});
 120
 121 if (exists $opt{perl}) {
 122   for my $perl (@{$opt{perl}}) {
 123     my $p = $perl;
 124     exists $perl{$p} or $p = "perl$perl";
 125     exists $perl{$p} or $p = "perl-$perl";
 126     exists $perl{$p} or die "Cannot find perl: $perl\n";
 127     push @perls, $p;
 128   }
 129 }
 130 else {
 131   @perls = sort keys %perl;
 132 }
 133
 134 $ENV{PATH} = "~/bin:$ENV{PATH}";  # use ccache
 135
 136 my %current;
 137
 138 for my $cfg (@{$opt{config}}) {
 139   for my $perl (@perls) {
 140     my $config = $config{$cfg};
 141     %current = (config => $cfg, perl => $perl);
 142
 143     if (is($config->{masked_versions}, $perl)) {
 144       print STDERR "skipping $perl for configuration $cfg (masked)\n";
 145       next;
 146     }
 147
 148     if (-d expand($opt{prefix}) and !$opt{force}) {
 149       print STDERR "skipping $perl for configuration $cfg (already installed)\n";
 150       next;
 151     }
 152
 153     my $cwd = cwd;
 154
 155     my $build = expand($opt{build});
 156     -d $build or mkpath($build);
 157     chdir $build or die "chdir $build: $!\n";
 158
 159     print STDERR "building $perl with configuration $cfg\n";
 160     buildperl($perl, $config);
 161
 162     chdir $cwd or die "chdir $cwd: $!\n";
 163   }
 164 }
 165
 166 sub expand
 167 {
 168   my $in = shift;
 169   $in =~ s/(<(\w+)>)/exists $current{$2} ? $current{$2} : $1/eg;
 170   return $in;
 171 }
 172
 173 sub is
 174 {
 175   my($s1, $s2) = @_;
 176
 177   defined $s1 != defined $s2 and return 0;
 178
 179   ref $s2 and ($s1, $s2) = ($s2, $s1);
 180
 181   if (ref $s1) {
 182     if (ref $s1 eq 'ARRAY') {
 183       is($_, $s2) and return 1 for @$s1;
 184       return 0;
 185     }
 186     return $s2 =~ $s1;
 187   }
 188
 189   return $s1 eq $s2;
 190 }
 191
 192 sub buildperl
 193 {
 194   my($perl, $cfg) = @_;
 195
 196   my $d = extract_source($perl{$perl});
 197   chdir $d or die "chdir $d: $!\n";
 198
 199   patch_source($perl);
 200
 201   build_and_install($perl{$perl});
 202 }
 203
 204 sub extract_source
 205 {
 206   my $perl = shift;
 207   my $target = "perl-$perl->{version}";
 208
 209   for my $dir ("perl$perl->{version}", "perl-$perl->{version}") {
 210     if (-d $dir) {
 211       print "removing old build directory $dir\n";
 212       rmtree($dir);
 213     }
 214   }
 215
 216   print "extracting $perl->{source}\n";
 217
 218   run_or_die("tar xzf $perl->{source}");
 219
 220   if ($perl->{version} !~ /^\d+\.\d+\.\d+/ && -d "perl-$perl->{version}") {
 221     $target = "perl$perl->{version}";
 222     rename "perl-$perl->{version}", $target or die "rename: $!\n";
 223   }
 224
 225   -d $target or die "$target not found\n";
 226
 227   return $target;
 228 }
 229
 230 sub patch_source
 231 {
 232   my $perl = shift;
 233
 234   for my $p (@patch) {
 235     if (is($p->{perl}, $perl)) {
 236       for my $s (@{$p->{subs}}) {
 237         my($sub, @args) = @$s;
 238         $sub->(@args);
 239       }
 240     }
 241   }
 242 }
 243
 244 sub build_and_install
 245 {
 246   my $perl = shift;
 247   my $prefix = expand($opt{prefix});
 248
 249   print "building perl $perl->{version} ($current{config})\n";
 250
 251   run_or_die("./Configure $config{$current{config}}{config_args} -Dusedevel -Uinstallusrbinperl -Dprefix=$prefix");
 252   run_or_die("sed -i -e '/^.*<built-in>/d' -e '/^.*<command line>/d' makefile x2p/makefile");
 253   run_or_die("make all");
 254   # run("make test");
 255   run_or_die("make install");
 256 }
 257
 258 sub patch_db
 259 {
 260   my $ver = shift;
 261   print "patching DB_File\n";
 262   run_or_die("sed -i -e 's/<db.h>/<db$ver\\/db.h>/' ext/DB_File/DB_File.xs");
 263 }
 264
 265 sub patch_doio
 266 {
 267   patch('doio.c', <<'END');
 268 --- doio.c.org  2004-06-07 23:14:45.000000000 +0200
 269 +++ doio.c      2003-11-04 08:03:03.000000000 +0100
 270 @@ -75,6 +75,16 @@
 271  #  endif
 272  #endif
 273
 274 +#if _SEM_SEMUN_UNDEFINED
 275 +union semun
 276 +{
 277 +  int val;
 278 +  struct semid_ds *buf;
 279 +  unsigned short int *array;
 280 +  struct seminfo *__buf;
 281 +};
 282 +#endif
 283 +
 284  bool
 285  do_open(gv,name,len,as_raw,rawmode,rawperm,supplied_fp)
 286  GV *gv;
 287 END
 288 }
 289
 290 sub patch
 291 {
 292   my($file, $patch) = @_;
 293   print "patching $file\n";
 294   my $diff = "$file.diff";
 295   write_or_die($diff, $patch);
 296   run_or_die("patch -s -p0 <$diff");
 297   unlink $diff or die "unlink $diff: $!\n";
 298 }
 299
 300 sub write_or_die
 301 {
 302   my($file, $data) = @_;
 303   my $fh = new IO::File ">$file" or die "$file: $!\n";
 304   $fh->print($data);
 305 }
 306
 307 sub run_or_die
 308 {
 309   # print "[running @_]\n";
 310   system "@_" and die "@_: $?\n";
 311 }
 312
 313 sub run
 314 {
 315   # print "[running @_]\n";
 316   system "@_" and warn "@_: $?\n";
 317 }