Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: blead
Fetching contributors…

Cannot retrieve contributors at this time

188 lines (147 sloc) 4.309 kb
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->catdir($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 (<LIST>) {
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 2, '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<file>] [B<--clean>]
=head1 DESCRIPTION
B<mkppport> generates a I<ppport.h> 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<file>
Name of the file that holds the list of extension directories
that I<ppport.h> should be distributed to.
This defaults to I<mkppport.lst> in the same directory as this
script.
=item B<--clean>
Run with this option to clean out all distributed I<ppport.h> files.
=back
=head1 COPYRIGHT
Copyright 2006 by Marcus Holland-Moritz <mhx@cpan.org>.
This program is free software; you may redistribute it
and/or modify it under the same terms as Perl itself.
=cut
Jump to Line
Something went wrong with that request. Please try again.