mkppport

   1 use strict;
   2 use warnings;
   3
   4 use Getopt::Long;
   5 use Pod::Usage;
   6 use File::Spec;
   7 use File::Compare qw( compare );
   8 use File::Copy qw( copy );
   9 use File::Basename qw( dirname );
  10
  11 sub iterdirs(&);
  12
  13 my $rootdir = dirname($0);
  14
  15 unshift @INC, File::Spec->catdir($rootdir, qw(cpan ExtUtils-MakeMaker t lib));
  16
  17 eval q{ use MakeMaker::Test::Utils qw( which_perl ) };
  18 $@ and die $@;
  19
  20 my %opt = (
  21   list   => File::Spec->catfile($rootdir, 'mkppport.lst'),
  22   clean  => 0,
  23 );
  24
  25 GetOptions(\%opt, qw( clean list=s )) or pod2usage(2);
  26
  27 my $absroot = File::Spec->rel2abs($rootdir);
  28 my @destdirs = readlist($opt{list});
  29
  30 # Nothing to do...
  31 unless (@destdirs) {
  32   print "no destination directories found in $opt{list}\n";
  33   exit 0;
  34 }
  35
  36 # Remove all installed ppport.h files
  37 if ($opt{clean}) {
  38   iterdirs {
  39     my($dir, $fulldir) = @_;
  40     my $dest = File::Spec->catfile($fulldir, 'ppport.h');
  41     if (-f $dest) {
  42       print "removing ppport.h for $dir\n";
  43       unlink $dest or warn "WARNING: could not remove $dest: $!\n";
  44       1 while unlink $dest;  # remove any remaining versions
  45     }
  46   };
  47   exit 0;
  48 }
  49
  50 # Determine full perl location
  51 my $perl = which_perl();
  52
  53 # We're now changing the directory, which confuses the deferred
  54 # loading in Config.pm, so we better use an absolute @INC path
  55 unshift @INC, File::Spec->catdir($absroot, 'lib');
  56
  57 # Change to Devel::PPPort directory, as it needs the stuff
  58 # from the parts/ directory
  59 chdir File::Spec->catdir($rootdir, 'cpan', 'Devel-PPPort');
  60
  61 # Capture and remove temporary files
  62 my @unlink;
  63
  64 END {
  65   for my $file (@unlink) {
  66     print "removing temporary file $file\n";
  67     unlink $file or warn "WARNING: could not remove $file: $!\n";
  68     1 while unlink $file;  # remove any remaining versions
  69   }
  70 }
  71
  72 # Try to create a ppport.h if it doesn't exist yet, and
  73 # remember all files that need to be removed later.
  74 unless (-e 'ppport.h') {
  75   unless (-e 'PPPort.pm') {
  76     run('PPPort_pm.PL');
  77     push @unlink, 'PPPort.pm';
  78   }
  79   run('ppport_h.PL');
  80   push @unlink, 'ppport.h';
  81 }
  82
  83 # Now install the created ppport.h into extension directories
  84 iterdirs {
  85   my($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(&)
 102 {
 103   my $code = shift;
 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
 120 {
 121   my $list = shift;
 122   my @dirs;
 123   open LIST, $list or die "$list: $!\n";
 124   while (<LIST>) {
 125     chomp;
 126     /^\s*(?:$|#)/ or push @dirs, $_;
 127   }
 128   close LIST;
 129   return @dirs;
 130 }
 131
 132 #----------------------------------------------
 133 # Runs a script in the Devel::PPPort directory
 134 #----------------------------------------------
 135 sub run
 136 {
 137   my @args = ("-I" . File::Spec->catdir((File::Spec->updir) x 2, 'lib'), @_);
 138   my $run = $perl =~ m/\s/ ? qq("$perl") : $perl;
 139   for (@args) {
 140     $_ = qq("$_") if $^O eq 'VMS' && /^[^"]/;
 141     $run .= " $_";
 142   }
 143   print "running $run\n";
 144   system $run and die "$run failed: $?\n";
 145 }
 146
 147 __END__
 148
 149 =head1 NAME
 150
 151 mkppport - distribute ppport.h among extensions
 152
 153 =head1 SYNOPSIS
 154
 155 mkppport [B<--list>=I<file>] [B<--clean>]
 156
 157 =head1 DESCRIPTION
 158
 159 B<mkppport> generates a I<ppport.h> file using Devel::PPPort
 160 and distributes it to the various extension directories that
 161 need it to build.
 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 <mhx@cpan.org>.
 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