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