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 10sub iterdirs(&); 11 12my $rootdir = dirname($0); 13 14unshift @INC, File::Spec->catdir($rootdir, qw(cpan ExtUtils-MakeMaker t lib)); 15 16eval q{ use MakeMaker::Test::Utils qw( which_perl ) }; 17$@ and die $@; 18 19my %opt = ( 20 list => File::Spec->catfile($rootdir, 'mkppport.lst'), 21 clean => 0, 22); 23 24unless ( GetOptions(\%opt, qw( clean list=s )) ) { 25 require Pod::Usage; 26 Pod::Usage::pod2usage(2); 27} 28 29my $absroot = File::Spec->rel2abs($rootdir); 30my @destdirs = readlist($opt{list}); 31 32# Nothing to do... 33unless (@destdirs) { 34 print "no destination directories found in $opt{list}\n"; 35 exit 0; 36} 37 38# Remove all installed ppport.h files 39if ($opt{clean}) { 40 iterdirs { 41 my($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 { 87 my($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(&) 104{ 105 my $code = shift; 106 107 for my $dir (@destdirs) { 108 my $fulldir = File::Spec->catdir($absroot, $dir); 109 if (-d $fulldir) { 110 $code->($dir, $fulldir); 111 } 112 else { 113 warn "WARNING: no such directory: $fulldir\n"; 114 } 115 } 116} 117 118#---------------------------------------- 119# Read the list of extension directories 120#---------------------------------------- 121sub readlist 122{ 123 my $list = shift; 124 my @dirs; 125 open LIST, $list or die "$list: $!\n"; 126 while (<LIST>) { 127 chomp; 128 /^\s*(?:$|#)/ or push @dirs, $_; 129 } 130 close LIST; 131 return @dirs; 132} 133 134#---------------------------------------------- 135# Runs a script in the Devel::PPPort directory 136#---------------------------------------------- 137sub run 138{ 139 my @args = ("-I" . File::Spec->catdir((File::Spec->updir) x 2, 'lib'), @_); 140 my $run = $perl =~ m/\s/ ? qq("$perl") : $perl; 141 for (@args) { 142 $_ = qq("$_") if $^O eq 'VMS' && /^[^"]/; 143 $run .= " $_"; 144 } 145 print "running $run\n"; 146 system $run and die "$run failed: $?\n"; 147} 148 149__END__ 150 151=head1 NAME 152 153mkppport - distribute ppport.h among extensions 154 155=head1 SYNOPSIS 156 157mkppport [B<--list>=I<file>] [B<--clean>] 158 159=head1 DESCRIPTION 160 161B<mkppport> generates a I<ppport.h> file using Devel::PPPort 162and distributes it to the various extension directories that 163need it to build. On certain Win32 builds, this script is not 164used and an alternative mechanism is used to create I<ppport.h>. 165 166=head1 OPTIONS 167 168=over 4 169 170=item B<--list>=I<file> 171 172Name of the file that holds the list of extension directories 173that I<ppport.h> should be distributed to. 174This defaults to I<mkppport.lst> in the same directory as this 175script. 176 177=item B<--clean> 178 179Run with this option to clean out all distributed I<ppport.h> files. 180 181=back 182 183=head1 COPYRIGHT 184 185Copyright 2006 by Marcus Holland-Moritz <mhx@cpan.org>. 186 187This program is free software; you may redistribute it 188and/or modify it under the same terms as Perl itself. 189 190=cut 191