Revert "Remove deprecation warnings related to $* and $#."
[perl.git] / mkppport
1 use strict;
2 use warnings;
3
4 use Getopt::Long;
5 use File::Spec;
6 use File::Compare qw( compare );
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->catdir($rootdir, qw(cpan ExtUtils-MakeMaker 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 unless ( GetOptions(\%opt, qw( clean list=s )) ) {
25   require Pod::Usage;
26   Pod::Usage::pod2usage(2);
27 }
28
29 my $absroot = File::Spec->rel2abs($rootdir);
30 my @destdirs = readlist($opt{list});
31
32 # Nothing to do...
33 unless (@destdirs) {
34   print "no destination directories found in $opt{list}\n";
35   exit 0;
36 }
37
38 # Remove all installed ppport.h files
39 if ($opt{clean}) {
40   iterdirs {
41     my($dir, $fulldir) = @_;
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     }
48   };
49   exit 0;
50 }
51
52 # Determine full perl location
53 my $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
57 unshift @INC, File::Spec->catdir($absroot, 'lib');
58
59 # Change to Devel::PPPort directory, as it needs the stuff
60 # from the parts/ directory
61 chdir File::Spec->catdir($rootdir, 'cpan', 'Devel-PPPort');
62
63 # Capture and remove temporary files
64 my @unlink;
65
66 END {
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.
76 unless (-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
86 iterdirs {
87   my($dir, $fulldir) = @_;
88   my $dest = File::Spec->catfile($fulldir, 'ppport.h');
89   if (compare('ppport.h', $dest)) {
90     print "installing ppport.h for $dir\n";
91     copy('ppport.h', $dest) or die "copying ppport.h to $dest failed: $!\n";
92   }
93   else {
94     print "ppport.h in $dir is up-to-date\n";
95   }
96 };
97
98 exit 0;
99
100 #---------------------------------------
101 # Iterate through extension directories
102 #---------------------------------------
103 sub iterdirs(&)
104 {
105   my $code = shift;
106   
107   for my $dir (@destdirs) {
108     my $fulldir = File::Spec->catdir($absroot, $dir);
109     if (-d $fulldir) {
110       $code->($dir, $fulldir);
111     }
112     else {
113       warn "WARNING: no such directory: $fulldir\n";
114     }
115   }
116 }
117
118 #----------------------------------------
119 # Read the list of extension directories
120 #----------------------------------------
121 sub readlist
122 {
123   my $list = shift;
124   my @dirs;
125   open LIST, $list or die "$list: $!\n";
126   while (<LIST>) {
127     chomp;
128     /^\s*(?:$|#)/ or push @dirs, $_;
129   }
130   close LIST;
131   return @dirs;
132 }
133
134 #----------------------------------------------
135 # Runs a script in the Devel::PPPort directory
136 #----------------------------------------------
137 sub run
138 {
139   my @args = ("-I" . File::Spec->catdir((File::Spec->updir) x 2, 'lib'), @_);
140   my $run = $perl =~ m/\s/ ? qq("$perl") : $perl;
141   for (@args) {
142     $_ = qq("$_") if $^O eq 'VMS' && /^[^"]/;
143     $run .= " $_";
144   }
145   print "running $run\n";
146   system $run and die "$run failed: $?\n";
147 }
148
149 __END__
150
151 =head1 NAME
152
153 mkppport - distribute ppport.h among extensions
154
155 =head1 SYNOPSIS
156
157 mkppport [B<--list>=I<file>] [B<--clean>]
158
159 =head1 DESCRIPTION
160
161 B<mkppport> generates a I<ppport.h> file using Devel::PPPort
162 and distributes it to the various extension directories that
163 need it to build.  On certain Win32 builds, this script is not
164 used and an alternative mechanism is used to create I<ppport.h>.
165
166 =head1 OPTIONS
167
168 =over 4
169
170 =item B<--list>=I<file>
171
172 Name of the file that holds the list of extension directories
173 that I<ppport.h> should be distributed to.
174 This defaults to I<mkppport.lst> in the same directory as this
175 script.
176
177 =item B<--clean>
178
179 Run with this option to clean out all distributed I<ppport.h> files.
180
181 =back
182
183 =head1 COPYRIGHT
184
185 Copyright 2006 by Marcus Holland-Moritz <mhx@cpan.org>.
186
187 This program is free software; you may redistribute it
188 and/or modify it under the same terms as Perl itself.
189
190 =cut