1#!perl 2 3use strict; 4use warnings; 5 6use Getopt::Long; 7use File::Spec; 8use File::Compare qw( compare ); 9use File::Copy qw( copy ); 10use File::Basename qw( dirname ); 11 12use feature 'signatures'; 13 14my $rootdir = dirname($0); 15 16unshift @INC, File::Spec->catdir($rootdir, qw(cpan ExtUtils-MakeMaker t lib)); 17 18eval q{ use MakeMaker::Test::Utils qw( which_perl ) }; 19$@ and die $@; 20 21my %opt = ( 22 list => File::Spec->catfile($rootdir, 'mkppport.lst'), 23 clean => 0, 24); 25 26unless ( GetOptions(\%opt, qw( clean list=s )) ) { 27 require Pod::Usage; 28 Pod::Usage::pod2usage(2); 29} 30 31my $absroot = File::Spec->rel2abs($rootdir); 32my @destdirs = readlist($opt{list}); 33 34# Nothing to do... 35unless (@destdirs) { 36 print "no destination directories found in $opt{list}\n"; 37 exit 0; 38} 39 40# Remove all installed ppport.h files 41if ($opt{clean}) { 42 iterdirs( sub ($dir, $fulldir) { 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 } 49 } ); 50 exit 0; 51} 52 53# Determine full perl location 54my $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 58unshift @INC, File::Spec->catdir($absroot, 'lib'); 59 60# Change to Devel::PPPort directory, as it needs the stuff 61# from the parts/ directory 62chdir File::Spec->catdir($rootdir, 'dist', 'Devel-PPPort'); 63 64# Capture and remove temporary files 65my @unlink; 66 67END { 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. 77unless (-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 87iterdirs( sub ($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 98exit 0; 99 100#--------------------------------------- 101# Iterate through extension directories 102#--------------------------------------- 103sub iterdirs($code) 104{ 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#---------------------------------------- 119sub readlist($list) 120{ 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#---------------------------------------------- 134sub run 135{ 136 my @args = ("-I" . File::Spec->catdir((File::Spec->updir) x 2, 'lib'), @_); 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 150mkppport - distribute ppport.h among extensions 151 152=head1 SYNOPSIS 153 154mkppport [B<--list>=I<file>] [B<--clean>] 155 156=head1 DESCRIPTION 157 158B<mkppport> generates a I<ppport.h> file using Devel::PPPort 159and distributes it to the various extension directories that 160need it to build. On certain Win32 builds, this script is not 161used and an alternative mechanism is used to create I<ppport.h>. 162 163=head1 OPTIONS 164 165=over 4 166 167=item B<--list>=I<file> 168 169Name of the file that holds the list of extension directories 170that I<ppport.h> should be distributed to. 171This defaults to I<mkppport.lst> in the same directory as this 172script. 173 174=item B<--clean> 175 176Run with this option to clean out all distributed I<ppport.h> files. 177 178=back 179 180=head1 COPYRIGHT 181 182Copyright 2006 by Marcus Holland-Moritz <mhx@cpan.org>. 183 184This program is free software; you may redistribute it 185and/or modify it under the same terms as Perl itself. 186 187=cut 188