ext/Devel/PPPort/devel/regenerate

   1 #!/usr/bin/perl -w
   2 ################################################################################
   3 #
   4 #  regenerate -- regenerate baseline and todo files
   5 #
   6 ################################################################################
   7 #
   8 #  $Revision: 2 $
   9 #  $Author: mhx $
  10 #  $Date: 2006/05/25 17:22:32 +0200 $
  11 #
  12 ################################################################################
  13 #
  14 #  Version 3.x, Copyright (C) 2004-2006, Marcus Holland-Moritz.
  15 #  Version 2.x, Copyright (C) 2001, Paul Marquess.
  16 #  Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
  17 #
  18 #  This program is free software; you can redistribute it and/or
  19 #  modify it under the same terms as Perl itself.
  20 #
  21 ################################################################################
  22
  23 use strict;
  24 use File::Path;
  25 use File::Copy;
  26 use Getopt::Long;
  27 use Pod::Usage;
  28
  29 require 'devel/devtools.pl';
  30
  31 our %opt = (
  32   verbose => 0
  33 );
  34
  35 GetOptions(\%opt, qw( verbose )) or die pod2usage();
  36
  37 identify();
  38
  39 unless (-e 'parts/embed.fnc' and -e 'parts/apidoc.fnc') {
  40   print "\nOooops, $0 must be run from the Devel::PPPort root directory.\n";
  41   quit_now();
  42 }
  43
  44 ask_or_quit("Are you sure you have updated parts/embed.fnc and parts/apidoc.fnc?");
  45
  46 my %files = map { ($_ => [glob "parts/$_/5*"]) } qw( base todo );
  47
  48 my(@notwr, @wr);
  49 for my $f (map @$_, values %files) {
  50   push @{-w $f ? \@wr : \@notwr}, $f;
  51 }
  52
  53 if (@notwr) {
  54   if (@wr) {
  55     print "\nThe following files are not writable:\n\n";
  56     print "    $_\n" for @notwr;
  57     print "\nAre you sure you have checked out these files?\n";
  58   }
  59   else {
  60     print "\nAll baseline / todo file are not writable.\n";
  61     ask_or_quit("Do you want to try to check out these files?");
  62     unless (runtool("wco", "-l", "-t", "locked by $0", @notwr)) {
  63       print "\nSomething went wrong while checking out the files.\n";
  64       quit_now();
  65     }
  66   }
  67 }
  68
  69 for my $dir (qw( base todo )) {
  70   my $cur = "parts/$dir";
  71   my $old = "$cur-old";
  72   if (-e $old) {
  73     ask_or_quit("Do you want me to remove the old $old directory?");
  74     rmtree($old);
  75   }
  76   mkdir $old;
  77   print "\nBacking up $cur in $old.\n";
  78   for my $src (@{$files{$dir}}) {
  79     my $dst = $src;
  80     $dst =~ s/\E$cur/$old/ or die "Ooops!";
  81     move($src, $dst) or die "Moving $src to $dst failed: $!\n";
  82   }
  83 }
  84
  85 my $T0 = time;
  86
  87 print "\nBuilding baseline files...\n\n";
  88
  89 unless (runperl('devel/mktodo', '--base', ddverbose())) {
  90   print "\nSomething went wrong while building the baseline files.\n";
  91   quit_now();
  92 }
  93
  94 print "\nMoving baseline files...\n\n";
  95
  96 for my $src (glob 'parts/todo/5*') {
  97   my $dst = $src;
  98   $dst =~ s/todo/base/ or die "Ooops!";
  99   move($src, $dst) or die "Moving $src to $dst failed: $!\n";
 100 }
 101
 102 print "\nBuilding todo files...\n\n";
 103
 104 unless (runperl('devel/mktodo', ddverbose())) {
 105   print "\nSomething went wrong while building the baseline files.\n";
 106   quit_now();
 107 }
 108
 109 print "\nAdding remaining baseline info...\n\n";
 110
 111 unless (runperl('Makefile.PL') and
 112         runtool('make') and
 113         runperl('devel/scanprov', 'write')) {
 114   print "\nSomething went wrong while adding the baseline info.\n";
 115   quit_now();
 116 }
 117
 118 my($wall, $usr, $sys, $cusr, $csys) = (time - $T0, times);
 119 my $cpu = sprintf "%.2f", $usr + $sys + $cusr + $csys;
 120 $usr = sprintf "%.2f", $usr + $cusr;
 121 $sys = sprintf "%.2f", $sys + $csys;
 122
 123 print <<END;
 124
 125 API info regenerated successfully.
 126
 127 Finished in $wall wallclock secs ($usr usr + $sys sys = $cpu CPU)
 128
 129 Don't forget to check in the files in parts/base and parts/todo.
 130
 131 END
 132