~ubuntu-branches/ubuntu/precise/perl/precise

use strict;

use warnings;

use Getopt::Long;

use File::Spec;

use File::Compare qw( compare );

use File::Copy qw( copy );

use File::Basename qw( dirname );

sub iterdirs(&);

my $rootdir = dirname($0);

unshift @INC, File::Spec->catdir($rootdir, qw(cpan ExtUtils-MakeMaker t lib));

eval q{ use MakeMaker::Test::Utils qw( which_perl ) };

$@ and die $@;

my %opt = (

  list   => File::Spec->catfile($rootdir, 'mkppport.lst'),

  clean  => 0,

);

unless ( GetOptions(\%opt, qw( clean list=s )) ) {

  require Pod::Usage;

  Pod::Usage::pod2usage(2);

}

my $absroot = File::Spec->rel2abs($rootdir);

my @destdirs = readlist($opt{list});

# Nothing to do...

unless (@destdirs) {

  print "no destination directories found in $opt{list}\n";

  exit 0;

}

# Remove all installed ppport.h files

if ($opt{clean}) {

  iterdirs {

    my($dir, $fulldir) = @_;

    my $dest = File::Spec->catfile($fulldir, 'ppport.h');

    if (-f $dest) {

      print "removing ppport.h for $dir\n";

      unlink $dest or warn "WARNING: could not remove $dest: $!\n";

      1 while unlink $dest;  # remove any remaining versions

    }

  };

  exit 0;

}

# Determine full perl location

my $perl = which_perl();

# We're now changing the directory, which confuses the deferred

# loading in Config.pm, so we better use an absolute @INC path

unshift @INC, File::Spec->catdir($absroot, 'lib');

# Change to Devel::PPPort directory, as it needs the stuff

# from the parts/ directory

chdir File::Spec->catdir($rootdir, 'cpan', 'Devel-PPPort');

# Capture and remove temporary files

my @unlink;

END {

  for my $file (@unlink) {

    print "removing temporary file $file\n";

    unlink $file or warn "WARNING: could not remove $file: $!\n";

    1 while unlink $file;  # remove any remaining versions

  }

}

# Try to create a ppport.h if it doesn't exist yet, and

# remember all files that need to be removed later.

unless (-e 'ppport.h') {

  unless (-e 'PPPort.pm') {

    run('PPPort_pm.PL');

    push @unlink, 'PPPort.pm';

  }

  run('ppport_h.PL');

  push @unlink, 'ppport.h';

}

# Now install the created ppport.h into extension directories

iterdirs {

  my($dir, $fulldir) = @_;

  my $dest = File::Spec->catfile($fulldir, 'ppport.h');

  if (compare('ppport.h', $dest)) {

    print "installing ppport.h for $dir\n";

    copy('ppport.h', $dest) or die "copying ppport.h to $dest failed: $!\n";

  }

  else {

    print "ppport.h in $dir is up-to-date\n";

  }

};

exit 0;

#---------------------------------------

# Iterate through extension directories

#---------------------------------------

sub iterdirs(&)

{

  my $code = shift;

  for my $dir (@destdirs) {

    my $fulldir = File::Spec->catdir($absroot, $dir);

    if (-d $fulldir) {

      $code->($dir, $fulldir);

    }

    else {

      warn "WARNING: no such directory: $fulldir\n";

    }

  }

}

#----------------------------------------

# Read the list of extension directories

#----------------------------------------

sub readlist

{

  my $list = shift;

  my @dirs;

  open LIST, $list or die "$list: $!\n";

  while (<LIST>) {

    chomp;

    /^\s*(?:$|#)/ or push @dirs, $_;

  }

  close LIST;

  return @dirs;

}

#----------------------------------------------

# Runs a script in the Devel::PPPort directory

#----------------------------------------------

sub run

{

  my @args = ("-I" . File::Spec->catdir((File::Spec->updir) x 2, 'lib'), @_);

  my $run = $perl =~ m/\s/ ? qq("$perl") : $perl;

  for (@args) {

    $_ = qq("$_") if $^O eq 'VMS' && /^[^"]/;

    $run .= " $_";

  }

  print "running $run\n";

  system $run and die "$run failed: $?\n";

}

__END__

=head1 NAME

mkppport - distribute ppport.h among extensions

=head1 SYNOPSIS

mkppport [B<--list>=I<file>] [B<--clean>]

=head1 DESCRIPTION

B<mkppport> generates a I<ppport.h> file using Devel::PPPort

and distributes it to the various extension directories that

need it to build.

=head1 OPTIONS

=over 4

=item B<--list>=I<file>

Name of the file that holds the list of extension directories

that I<ppport.h> should be distributed to.

This defaults to I<mkppport.lst> in the same directory as this

script.

=item B<--clean>

Run with this option to clean out all distributed I<ppport.h> files.

=back

=head1 COPYRIGHT

Copyright 2006 by Marcus Holland-Moritz <mhx@cpan.org>.

This program is free software; you may redistribute it

and/or modify it under the same terms as Perl itself.

=cut