1#!/usr/bin/perl -w
2################################################################################
3#
4#  buildperl.pl -- build various versions of perl automatically
5#
6################################################################################
7#
8#  $Revision: 1.2 $
9#  $Author: millert $
10#  $Date: 2006/03/28 19:23:02 $
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
23use strict;
24use Getopt::Long;
25use Pod::Usage;
26use File::Find;
27use File::Path;
28use Data::Dumper;
29use IO::File;
30use Cwd;
31
32my %opt = (
33  prefix => '/tmp/perl/install/<config>/<perl>',
34  build  => '/tmp/perl/build/<config>',
35  source => '/tmp/perl/source',
36  force  => 0,
37);
38
39my %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
56my @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
97my(%perl, @perls);
98
99GetOptions(\%opt, qw(
100  config=s@
101  prefix=s
102  source=s
103  perl=s@
104  force
105)) or pod2usage(2);
106
107if (exists $opt{config}) {
108  for my $cfg (@{$opt{config}}) {
109    exists $config{$cfg} or die "Unknown configuration: $cfg\n";
110  }
111}
112else {
113  $opt{config} = [sort keys %config];
114}
115
116find(sub {
117  /^(perl-?(5\..*))\.tar.gz$/ or return;
118  $perl{$1} = { version => $2, source => $File::Find::name };
119}, $opt{source});
120
121if (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}
130else {
131  @perls = sort keys %perl;
132}
133
134$ENV{PATH} = "~/bin:$ENV{PATH}";  # use ccache
135
136my %current;
137
138for 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
166sub expand
167{
168  my $in = shift;
169  $in =~ s/(<(\w+)>)/exists $current{$2} ? $current{$2} : $1/eg;
170  return $in;
171}
172
173sub 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
192sub 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
204sub 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
230sub 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
244sub 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
258sub 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
265sub 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;
287END
288}
289
290sub 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
300sub 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
307sub run_or_die
308{
309  # print "[running @_]\n";
310  system "@_" and die "@_: $?\n";
311}
312
313sub run
314{
315  # print "[running @_]\n";
316  system "@_" and warn "@_: $?\n";
317}
318