mkppport

   1 use strict;
   2 use warnings;
   3
   4 use Getopt::Long;
   5 use File::Spec;
   6 use File::Compare qw( compare );
   7 use File::Copy qw( copy );
   8 use File::Basename qw( dirname );
   9
  10 use feature 'signatures';
  11
  12 my $rootdir = dirname($0);
  13
  14 unshift @INC, File::Spec->catdir($rootdir, qw(cpan ExtUtils-MakeMaker t lib));
  15
  16 eval q{ use MakeMaker::Test::Utils qw( which_perl ) };
  17 $@ and die $@;
  18
  19 my %opt = (
  20   list   => File::Spec->catfile($rootdir, 'mkppport.lst'),
  21   clean  => 0,
  22 );
  23
  24 unless ( GetOptions(\%opt, qw( clean list=s )) ) {
  25   require Pod::Usage;
  26   Pod::Usage::pod2usage(2);
  27 }
  28
  29 my $absroot = File::Spec->rel2abs($rootdir);
  30 my @destdirs = readlist($opt{list});
  31
  32 # Nothing to do...
  33 unless (@destdirs) {
  34   print "no destination directories found in $opt{list}\n";
  35   exit 0;
  36 }
  37
  38 # Remove all installed ppport.h files
  39 if ($opt{clean}) {
  40   iterdirs( sub ($dir, $fulldir) {
  41     my $dest = File::Spec->catfile($fulldir, 'ppport.h');
  42     if (-f $dest) {
  43       print "removing ppport.h for $dir\n";
  44       unlink $dest or warn "WARNING: could not remove $dest: $!\n";
  45       1 while unlink $dest;  # remove any remaining versions
  46     }
  47   } );
  48   exit 0;
  49 }
  50
  51 # Determine full perl location
  52 my $perl = which_perl();
  53
  54 # We're now changing the directory, which confuses the deferred
  55 # loading in Config.pm, so we better use an absolute @INC path
  56 unshift @INC, File::Spec->catdir($absroot, 'lib');
  57
  58 # Change to Devel::PPPort directory, as it needs the stuff
  59 # from the parts/ directory
  60 chdir File::Spec->catdir($rootdir, 'dist', 'Devel-PPPort');
  61
  62 # Capture and remove temporary files
  63 my @unlink;
  64
  65 END {
  66   for my $file (@unlink) {
  67     print "removing temporary file $file\n";
  68     unlink $file or warn "WARNING: could not remove $file: $!\n";
  69     1 while unlink $file;  # remove any remaining versions
  70   }
  71 }
  72
  73 # Try to create a ppport.h if it doesn't exist yet, and
  74 # remember all files that need to be removed later.
  75 unless (-e 'ppport.h') {
  76   unless (-e 'PPPort.pm') {
  77     run('PPPort_pm.PL');
  78     push @unlink, 'PPPort.pm';
  79   }
  80   run('ppport_h.PL');
  81   push @unlink, 'ppport.h';
  82 }
  83
  84 # Now install the created ppport.h into extension directories
  85 iterdirs( sub ($dir, $fulldir) {
  86   my $dest = File::Spec->catfile($fulldir, 'ppport.h');
  87   if (compare('ppport.h', $dest)) {
  88     print "installing ppport.h for $dir\n";
  89     copy('ppport.h', $dest) or die "copying ppport.h to $dest failed: $!\n";
  90   }
  91   else {
  92     print "ppport.h in $dir is up-to-date\n";
  93   }
  94 } );
  95
  96 exit 0;
  97
  98 #---------------------------------------
  99 # Iterate through extension directories
 100 #---------------------------------------
 101 sub iterdirs($code)
 102 {
 103   for my $dir (@destdirs) {
 104     my $fulldir = File::Spec->catdir($absroot, $dir);
 105     if (-d $fulldir) {
 106       $code->($dir, $fulldir);
 107     }
 108     else {
 109       warn "WARNING: no such directory: $fulldir\n";
 110     }
 111   }
 112 }
 113
 114 #----------------------------------------
 115 # Read the list of extension directories
 116 #----------------------------------------
 117 sub readlist($list)
 118 {
 119   my @dirs;
 120   open LIST, $list or die "$list: $!\n";
 121   while (<LIST>) {
 122     chomp;
 123     /^\s*(?:$|#)/ or push @dirs, $_;
 124   }
 125   close LIST;
 126   return @dirs;
 127 }
 128
 129 #----------------------------------------------
 130 # Runs a script in the Devel::PPPort directory
 131 #----------------------------------------------
 132 sub run
 133 {
 134   my @args = ("-I" . File::Spec->catdir((File::Spec->updir) x 2, 'lib'), @_);
 135   my $run = $perl =~ m/\s/ ? qq("$perl") : $perl;
 136   for (@args) {
 137     $_ = qq("$_") if $^O eq 'VMS' && /^[^"]/;
 138     $run .= " $_";
 139   }
 140   print "running $run\n";
 141   system $run and die "$run failed: $?\n";
 142 }
 143
 144 __END__
 145
 146 =head1 NAME
 147
 148 mkppport - distribute ppport.h among extensions
 149
 150 =head1 SYNOPSIS
 151
 152 mkppport [B<--list>=I<file>] [B<--clean>]
 153
 154 =head1 DESCRIPTION
 155
 156 B<mkppport> generates a I<ppport.h> file using Devel::PPPort
 157 and distributes it to the various extension directories that
 158 need it to build.  On certain Win32 builds, this script is not
 159 used and an alternative mechanism is used to create I<ppport.h>.
 160
 161 =head1 OPTIONS
 162
 163 =over 4
 164
 165 =item B<--list>=I<file>
 166
 167 Name of the file that holds the list of extension directories
 168 that I<ppport.h> should be distributed to.
 169 This defaults to I<mkppport.lst> in the same directory as this
 170 script.
 171
 172 =item B<--clean>
 173
 174 Run with this option to clean out all distributed I<ppport.h> files.
 175
 176 =back
 177
 178 =head1 COPYRIGHT
 179
 180 Copyright 2006 by Marcus Holland-Moritz <mhx@cpan.org>.
 181
 182 This program is free software; you may redistribute it
 183 and/or modify it under the same terms as Perl itself.
 184
 185 =cut