xref: /openbsd/gnu/usr.bin/perl/mkppport (revision 8932bfb7) 
1use strict;
2use warnings;
3
4use Getopt::Long;
5use Pod::Usage;
6use File::Spec;
7use File::Compare qw( compare );
8use File::Copy qw( copy );
9use File::Basename qw( dirname );
10
11sub iterdirs(&);
12
13my $rootdir = dirname($0);
14
15unshift @INC, File::Spec->catdir($rootdir, qw(cpan ExtUtils-MakeMaker t lib));
16
17eval q{ use MakeMaker::Test::Utils qw( which_perl ) };
18$@ and die $@;
19
20my %opt = (
21  list   => File::Spec->catfile($rootdir, 'mkppport.lst'),
22  clean  => 0,
23);
24
25GetOptions(\%opt, qw( clean list=s )) or pod2usage(2);
26
27my $absroot = File::Spec->rel2abs($rootdir);
28my @destdirs = readlist($opt{list});
29
30# Nothing to do...
31unless (@destdirs) {
32  print "no destination directories found in $opt{list}\n";
33  exit 0;
34}
35
36# Remove all installed ppport.h files
37if ($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
51my $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
55unshift @INC, File::Spec->catdir($absroot, 'lib');
56
57# Change to Devel::PPPort directory, as it needs the stuff
58# from the parts/ directory
59chdir File::Spec->catdir($rootdir, 'cpan', 'Devel-PPPort');
60
61# Capture and remove temporary files
62my @unlink;
63
64END {
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.
74unless (-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
84iterdirs {
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
96exit 0;
97
98#---------------------------------------
99# Iterate through extension directories
100#---------------------------------------
101sub 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#----------------------------------------
119sub 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#----------------------------------------------
135sub 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
151mkppport - distribute ppport.h among extensions
152
153=head1 SYNOPSIS
154
155mkppport [B<--list>=I<file>] [B<--clean>]
156
157=head1 DESCRIPTION
158
159B<mkppport> generates a I<ppport.h> file using Devel::PPPort
160and distributes it to the various extension directories that
161need it to build.
162
163=head1 OPTIONS
164
165=over 4
166
167=item B<--list>=I<file>
168
169Name of the file that holds the list of extension directories
170that I<ppport.h> should be distributed to.
171This defaults to I<mkppport.lst> in the same directory as this
172script.
173
174=item B<--clean>
175
176Run with this option to clean out all distributed I<ppport.h> files.
177
178=back
179
180=head1 COPYRIGHT
181
182Copyright 2006 by Marcus Holland-Moritz <mhx@cpan.org>.
183
184This program is free software; you may redistribute it
185and/or modify it under the same terms as Perl itself.
186
187=cut
188