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