make require report too many open files error

[p5sagit/p5-mst-13.2.git] / ext / Devel / PPPort / devel / regenerate

#!/usr/bin/perl -w
################################################################################
#
#  regenerate -- regenerate baseline and todo files
#
################################################################################
#
#  $Revision: 2 $
#  $Author: mhx $
#  $Date: 2006/05/25 17:22:32 +0200 $
#
################################################################################
#
#  Version 3.x, Copyright (C) 2004-2006, Marcus Holland-Moritz.
#  Version 2.x, Copyright (C) 2001, Paul Marquess.
#  Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
#
#  This program is free software; you can redistribute it and/or
#  modify it under the same terms as Perl itself.
#
################################################################################

use strict;
use File::Path;
use File::Copy;
use Getopt::Long;
use Pod::Usage;

require 'devel/devtools.pl';

our %opt = (
  verbose => 0
);

GetOptions(\%opt, qw( verbose )) or die pod2usage();

identify();

unless (-e 'parts/embed.fnc' and -e 'parts/apidoc.fnc') {
  print "\nOooops, $0 must be run from the Devel::PPPort root directory.\n";
  quit_now();
}

ask_or_quit("Are you sure you have updated parts/embed.fnc and parts/apidoc.fnc?");

my %files = map { ($_ => [glob "parts/$_/5*"]) } qw( base todo );

my(@notwr, @wr);
for my $f (map @$_, values %files) {
  push @{-w $f ? \@wr : \@notwr}, $f;
}

if (@notwr) {
  if (@wr) {
    print "\nThe following files are not writable:\n\n";
    print "    $_\n" for @notwr;
    print "\nAre you sure you have checked out these files?\n";
  }
  else {
    print "\nAll baseline / todo file are not writable.\n";
    ask_or_quit("Do you want to try to check out these files?");
    unless (runtool("wco", "-l", "-t", "locked by $0", @notwr)) {
      print "\nSomething went wrong while checking out the files.\n";
      quit_now();
    }
  }
}

for my $dir (qw( base todo )) {
  my $cur = "parts/$dir";
  my $old = "$cur-old";
  if (-e $old) {
    ask_or_quit("Do you want me to remove the old $old directory?");
    rmtree($old);
  }
  mkdir $old;
  print "\nBacking up $cur in $old.\n";
  for my $src (@{$files{$dir}}) {
    my $dst = $src;
    $dst =~ s/\E$cur/$old/ or die "Ooops!";
    move($src, $dst) or die "Moving $src to $dst failed: $!\n";
  }
}

my $T0 = time;

print "\nBuilding baseline files...\n\n";

unless (runperl('devel/mktodo', '--base', ddverbose())) {
  print "\nSomething went wrong while building the baseline files.\n";
  quit_now();
}

print "\nMoving baseline files...\n\n";

for my $src (glob 'parts/todo/5*') {
  my $dst = $src;
  $dst =~ s/todo/base/ or die "Ooops!";
  move($src, $dst) or die "Moving $src to $dst failed: $!\n";
}

print "\nBuilding todo files...\n\n";

unless (runperl('devel/mktodo', ddverbose())) {
  print "\nSomething went wrong while building the baseline files.\n";
  quit_now();
}

print "\nAdding remaining baseline info...\n\n";

unless (runperl('Makefile.PL') and
        runtool('make') and
        runperl('devel/scanprov', 'write')) {
  print "\nSomething went wrong while adding the baseline info.\n";
  quit_now();
}

my($wall, $usr, $sys, $cusr, $csys) = (time - $T0, times);
my $cpu = sprintf "%.2f", $usr + $sys + $cusr + $csys;
$usr = sprintf "%.2f", $usr + $cusr;
$sys = sprintf "%.2f", $sys + $csys;

print <<END;

API info regenerated successfully.

Finished in $wall wallclock secs ($usr usr + $sys sys = $cpu CPU)

Don't forget to check in the files in parts/base and parts/todo.

END