use strict; use warnings; use Getopt::Long; use Pod::Usage; use File::Spec; use File::Compare qw( compare ); use File::Copy qw( copy ); use File::Basename qw( dirname ); sub iterdirs(&); my $rootdir = dirname($0); unshift @INC, File::Spec->catfile($rootdir, 't', 'lib'); eval q{ use MakeMaker::Test::Utils qw( which_perl ) }; $@ and die $@; my %opt = ( list => File::Spec->catfile($rootdir, 'mkppport.lst'), clean => 0, ); GetOptions(\%opt, qw( clean list=s )) or pod2usage(2); my $absroot = File::Spec->rel2abs($rootdir); my @destdirs = readlist($opt{list}); # Nothing to do... unless (@destdirs) { print "no destination directories found in $opt{list}\n"; exit 0; } # Remove all installed ppport.h files if ($opt{clean}) { iterdirs { my($dir, $fulldir) = @_; my $dest = File::Spec->catfile($fulldir, 'ppport.h'); if (-f $dest) { print "removing ppport.h for $dir\n"; unlink $dest or warn "WARNING: could not remove $dest: $!\n"; 1 while unlink $dest; # remove any remaining versions } }; exit 0; } # Determine full perl location my $perl = which_perl(); # We're now changing the directory, which confuses the deferred # loading in Config.pm, so we better use an absolute @INC path unshift @INC, File::Spec->catdir($absroot, 'lib'); # Change to Devel::PPPort directory, as it needs the stuff # from the parts/ directory chdir File::Spec->catdir($rootdir, 'ext', 'Devel', 'PPPort'); # Capture and remove temporary files my @unlink; END { for my $file (@unlink) { print "removing temporary file $file\n"; unlink $file or warn "WARNING: could not remove $file: $!\n"; 1 while unlink $file; # remove any remaining versions } } # Try to create a ppport.h if it doesn't exist yet, and # remember all files that need to be removed later. unless (-e 'ppport.h') { unless (-e 'PPPort.pm') { run('PPPort_pm.PL'); push @unlink, 'PPPort.pm'; } run('ppport_h.PL'); push @unlink, 'ppport.h'; } # Now install the created ppport.h into extension directories iterdirs { my($dir, $fulldir) = @_; my $dest = File::Spec->catfile($fulldir, 'ppport.h'); if (compare('ppport.h', $dest)) { print "installing ppport.h for $dir\n"; copy('ppport.h', $dest) or die "copying ppport.h to $dest failed: $!\n"; } else { print "ppport.h in $dir is up-to-date\n"; } }; exit 0; #--------------------------------------- # Iterate through extension directories #--------------------------------------- sub iterdirs(&) { my $code = shift; for my $dir (@destdirs) { my $fulldir = File::Spec->catdir($absroot, $dir); if (-d $fulldir) { $code->($dir, $fulldir); } else { warn "WARNING: no such directory: $fulldir\n"; } } } #---------------------------------------- # Read the list of extension directories #---------------------------------------- sub readlist { my $list = shift; my @dirs; open LIST, $list or die "$list: $!\n"; while () { chomp; /^\s*(?:$|#)/ or push @dirs, $_; } close LIST; return @dirs; } #---------------------------------------------- # Runs a script in the Devel::PPPort directory #---------------------------------------------- sub run { my @args = ("-I" . File::Spec->catdir((File::Spec->updir) x 3, 'lib'), @_); my $run = $perl =~ m/\s/ ? qq("$perl") : $perl; for (@args) { $_ = qq("$_") if $^O eq 'VMS' && /^[^"]/; $run .= " $_"; } print "running $run\n"; system $run and die "$run failed: $?\n"; } __END__ =head1 NAME mkppport - distribute ppport.h among extensions =head1 SYNOPSIS mkppport [B<--list>=I] [B<--clean>] =head1 DESCRIPTION B generates a I file using Devel::PPPort and distributes it to the various extension directories that need it to build. =head1 OPTIONS =over 4 =item B<--list>=I Name of the file that holds the list of extension directories that I should be distributed to. This defaults to I in the same directory as this script. =item B<--clean> Run with this option to clean out all distributed I files. =back =head1 COPYRIGHT Copyright 2006 by Marcus Holland-Moritz . This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself. =cut