mkppport

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