This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to Devel::PPPort 3.00.
[perl5.git] / ext / Devel / PPPort / devel / buildperl.pl
CommitLineData
adfe19db
MHM
1#!/usr/bin/perl -w
2################################################################################
3#
4# buildperl.pl -- build various versions of perl automatically
5#
6################################################################################
7#
8# $Revision: 3 $
9# $Author: mhx $
10# $Date: 2004/08/13 12:50:19 +0200 $
11#
12################################################################################
13#
14# Version 3.x, Copyright (C) 2004, 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}