1 files changed, 161 insertions, 0 deletions
diff --git a/ext/Devel-PPPort/devel/regenerate b/ext/Devel-PPPort/devel/regenerate
new file mode 100644
index 0000000000..31765055cd
--- /dev/null
+++ b/ext/Devel-PPPort/devel/regenerate
@@ -0,0 +1,161 @@
+#!/usr/bin/perl -w
+################################################################################
+#
+#  regenerate -- regenerate baseline and todo files
+#
+################################################################################
+#
+#  $Revision: 8 $
+#  $Author: mhx $
+#  $Date: 2009/01/18 14:10:50 +0100 $
+#
+################################################################################
+#
+#  Version 3.x, Copyright (C) 2004-2009, 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 = (
+  check   => 1,
+  verbose => 0,
+);
+
+GetOptions(\%opt, qw( check! 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;
+my @args = ddverbose();
+push @args, '--nocheck' unless $opt{check};
+
+print "\nBuilding baseline files...\n\n";
+
+unless (runperl('devel/mktodo', '--base', @args)) {
+  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', @args)) {
+  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
+
+__END__
+
+=head1 NAME
+
+regenerate - Automatically regeneate Devel::PPPort's API information
+
+=head1 SYNOPSIS
+
+  regenerate [options]
+
+  --nocheck      don't recheck symbols that caused an error
+  --verbose      show verbose output
+
+=head1 COPYRIGHT
+
+Copyright (c) 2006-2009, Marcus Holland-Moritz.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+See L<Devel::PPPort> and L<HACKERS>.
+
+=cut
+