| 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->catfile($rootdir, '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, 'ext', '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 3, '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 |