mkppport

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