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