This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
msgrcv: properly downgrade the receive buffer
[perl5.git] / mkppport
CommitLineData
42e07562
MHM
1use strict;
2use warnings;
3
4use Getopt::Long;
42e07562 5use File::Spec;
16a92355 6use File::Compare qw( compare );
42e07562
MHM
7use File::Copy qw( copy );
8use File::Basename qw( dirname );
9
aa4b50cc
N
10use feature 'signatures';
11no warnings 'experimental::signatures';
42e07562
MHM
12
13my $rootdir = dirname($0);
14
9dafbe2f 15unshift @INC, File::Spec->catdir($rootdir, qw(cpan ExtUtils-MakeMaker t lib));
42e07562
MHM
16
17eval q{ use MakeMaker::Test::Utils qw( which_perl ) };
18$@ and die $@;
19
20my %opt = (
21 list => File::Spec->catfile($rootdir, 'mkppport.lst'),
22 clean => 0,
23);
24
463da0ac
CBW
25unless ( GetOptions(\%opt, qw( clean list=s )) ) {
26 require Pod::Usage;
27 Pod::Usage::pod2usage(2);
28}
42e07562
MHM
29
30my $absroot = File::Spec->rel2abs($rootdir);
31my @destdirs = readlist($opt{list});
32
33# Nothing to do...
34unless (@destdirs) {
35 print "no destination directories found in $opt{list}\n";
36 exit 0;
37}
38
39# Remove all installed ppport.h files
40if ($opt{clean}) {
aa4b50cc 41 iterdirs( sub ($dir, $fulldir) {
42e07562
MHM
42 my $dest = File::Spec->catfile($fulldir, 'ppport.h');
43 if (-f $dest) {
44 print "removing ppport.h for $dir\n";
45 unlink $dest or warn "WARNING: could not remove $dest: $!\n";
46 1 while unlink $dest; # remove any remaining versions
47 }
aa4b50cc 48 } );
42e07562
MHM
49 exit 0;
50}
51
52# Determine full perl location
53my $perl = which_perl();
54
55# We're now changing the directory, which confuses the deferred
56# loading in Config.pm, so we better use an absolute @INC path
57unshift @INC, File::Spec->catdir($absroot, 'lib');
58
59# Change to Devel::PPPort directory, as it needs the stuff
60# from the parts/ directory
7baf245a 61chdir File::Spec->catdir($rootdir, 'dist', 'Devel-PPPort');
42e07562
MHM
62
63# Capture and remove temporary files
64my @unlink;
65
66END {
67 for my $file (@unlink) {
68 print "removing temporary file $file\n";
69 unlink $file or warn "WARNING: could not remove $file: $!\n";
70 1 while unlink $file; # remove any remaining versions
71 }
72}
73
74# Try to create a ppport.h if it doesn't exist yet, and
75# remember all files that need to be removed later.
76unless (-e 'ppport.h') {
77 unless (-e 'PPPort.pm') {
78 run('PPPort_pm.PL');
79 push @unlink, 'PPPort.pm';
80 }
81 run('ppport_h.PL');
82 push @unlink, 'ppport.h';
83}
84
85# Now install the created ppport.h into extension directories
aa4b50cc 86iterdirs( sub ($dir, $fulldir) {
42e07562 87 my $dest = File::Spec->catfile($fulldir, 'ppport.h');
16a92355
MHM
88 if (compare('ppport.h', $dest)) {
89 print "installing ppport.h for $dir\n";
90 copy('ppport.h', $dest) or die "copying ppport.h to $dest failed: $!\n";
91 }
92 else {
93 print "ppport.h in $dir is up-to-date\n";
94 }
aa4b50cc 95} );
42e07562
MHM
96
97exit 0;
98
99#---------------------------------------
100# Iterate through extension directories
101#---------------------------------------
aa4b50cc 102sub iterdirs($code)
42e07562 103{
42e07562
MHM
104 for my $dir (@destdirs) {
105 my $fulldir = File::Spec->catdir($absroot, $dir);
106 if (-d $fulldir) {
107 $code->($dir, $fulldir);
108 }
109 else {
110 warn "WARNING: no such directory: $fulldir\n";
111 }
112 }
113}
114
115#----------------------------------------
116# Read the list of extension directories
117#----------------------------------------
aa4b50cc 118sub readlist($list)
42e07562 119{
42e07562
MHM
120 my @dirs;
121 open LIST, $list or die "$list: $!\n";
122 while (<LIST>) {
123 chomp;
124 /^\s*(?:$|#)/ or push @dirs, $_;
125 }
126 close LIST;
127 return @dirs;
128}
129
130#----------------------------------------------
131# Runs a script in the Devel::PPPort directory
132#----------------------------------------------
133sub run
134{
0ff33da8 135 my @args = ("-I" . File::Spec->catdir((File::Spec->updir) x 2, 'lib'), @_);
42e07562
MHM
136 my $run = $perl =~ m/\s/ ? qq("$perl") : $perl;
137 for (@args) {
138 $_ = qq("$_") if $^O eq 'VMS' && /^[^"]/;
139 $run .= " $_";
140 }
141 print "running $run\n";
142 system $run and die "$run failed: $?\n";
143}
144
145__END__
146
147=head1 NAME
148
149mkppport - distribute ppport.h among extensions
150
151=head1 SYNOPSIS
152
153mkppport [B<--list>=I<file>] [B<--clean>]
154
155=head1 DESCRIPTION
156
157B<mkppport> generates a I<ppport.h> file using Devel::PPPort
158and distributes it to the various extension directories that
3bdc51af
DD
159need it to build. On certain Win32 builds, this script is not
160used and an alternative mechanism is used to create I<ppport.h>.
42e07562
MHM
161
162=head1 OPTIONS
163
164=over 4
165
166=item B<--list>=I<file>
167
168Name of the file that holds the list of extension directories
169that I<ppport.h> should be distributed to.
170This defaults to I<mkppport.lst> in the same directory as this
171script.
172
173=item B<--clean>
174
175Run with this option to clean out all distributed I<ppport.h> files.
176
177=back
178
179=head1 COPYRIGHT
180
181Copyright 2006 by Marcus Holland-Moritz <mhx@cpan.org>.
182
183This program is free software; you may redistribute it
184and/or modify it under the same terms as Perl itself.
185
186=cut