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