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 sub iterdirs(&);
  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 {
  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
  53 my $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
  57 unshift @INC, File::Spec->catdir($absroot, 'lib');
  58
  59 # Change to Devel::PPPort directory, as it needs the stuff
  60 # from the parts/ directory
  61 chdir File::Spec->catdir($rootdir, 'dist', 'Devel-PPPort');
  62
  63 # Capture and remove temporary files
  64 my @unlink;
  65
  66 END {
  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.
  76 unless (-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
  86 iterdirs {
  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
  98 exit 0;
  99
 100 #---------------------------------------
 101 # Iterate through extension directories
 102 #---------------------------------------
 103 sub 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 #----------------------------------------
 121 sub 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 #----------------------------------------------
 137 sub 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
 153 mkppport - distribute ppport.h among extensions
 154
 155 =head1 SYNOPSIS
 156
 157 mkppport [B<--list>=I<file>] [B<--clean>]
 158
 159 =head1 DESCRIPTION
 160
 161 B<mkppport> generates a I<ppport.h> file using Devel::PPPort
 162 and distributes it to the various extension directories that
 163 need it to build.  On certain Win32 builds, this script is not
 164 used 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
 172 Name of the file that holds the list of extension directories
 173 that I<ppport.h> should be distributed to.
 174 This defaults to I<mkppport.lst> in the same directory as this
 175 script.
 176
 177 =item B<--clean>
 178
 179 Run with this option to clean out all distributed I<ppport.h> files.
 180
 181 =back
 182
 183 =head1 COPYRIGHT
 184
 185 Copyright 2006 by Marcus Holland-Moritz <mhx@cpan.org>.
 186
 187 This program is free software; you may redistribute it
 188 and/or modify it under the same terms as Perl itself.
 189
 190 =cut