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