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, 'cpan', '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.
 164
 165 =head1 OPTIONS
 166
 167 =over 4
 168
 169 =item B<--list>=I<file>
 170
 171 Name of the file that holds the list of extension directories
 172 that I<ppport.h> should be distributed to.
 173 This defaults to I<mkppport.lst> in the same directory as this
 174 script.
 175
 176 =item B<--clean>
 177
 178 Run with this option to clean out all distributed I<ppport.h> files.
 179
 180 =back
 181
 182 =head1 COPYRIGHT
 183
 184 Copyright 2006 by Marcus Holland-Moritz <mhx@cpan.org>.
 185
 186 This program is free software; you may redistribute it
 187 and/or modify it under the same terms as Perl itself.
 188
 189 =cut