Commit | Line | Data |
42e07562 |
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 |