dist/Devel-PPPort/devel/regenerate

   1 #!/usr/bin/perl -w
   2 ################################################################################
   3 #
   4 #  regenerate -- regenerate baseline and todo files
   5 #
   6 ################################################################################
   7 #
   8 #  Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz.
   9 #  Version 2.x, Copyright (C) 2001, Paul Marquess.
  10 #  Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
  11 #
  12 #  This program is free software; you can redistribute it and/or
  13 #  modify it under the same terms as Perl itself.
  14 #
  15 ################################################################################
  16
  17 use strict;
  18 use File::Path;
  19 use File::Copy;
  20 use Getopt::Long;
  21 use Pod::Usage;
  22
  23 require './devel/devtools.pl';
  24
  25 our %opt = (
  26   check   => 1,
  27   debug   => 0,
  28   verbose => 0,
  29 );
  30
  31 GetOptions(\%opt, qw( check! verbose install=s blead=s blead-version=s
  32                       debug=i debug-start=s)) or die pod2usage();
  33
  34 identify();
  35
  36 unless (-e 'parts/embed.fnc' and -e 'parts/apidoc.fnc') {
  37   print "\nOooops, $0 must be run from the Devel::PPPort root directory.\n";
  38   quit_now();
  39 }
  40
  41 ask_or_quit("Are you sure you have updated parts/embed.fnc and parts/apidoc.fnc?");
  42
  43 my %files = map { ($_ => [glob "parts/$_/5*"]) } qw( base todo );
  44
  45 my(@notwr, @wr);
  46 for my $f (map @$_, values %files) {
  47   push @{-w $f ? \@wr : \@notwr}, $f;
  48 }
  49
  50 if (@notwr) {
  51   if (@wr) {
  52     print "\nThe following files are not writable:\n\n";
  53     print "    $_\n" for @notwr;
  54     print "\nAre you sure you have checked out these files?\n";
  55   }
  56   else {
  57     print "\nAll baseline / todo file are not writable.\n";
  58     ask_or_quit("Do you want to try to check out these files?");
  59     unless (runtool("wco", "-l", "-t", "locked by $0", @notwr)) {
  60       print "\nSomething went wrong while checking out the files.\n";
  61       quit_now();
  62     }
  63   }
  64 }
  65
  66 for my $dir (qw( base todo )) {
  67   my $cur = "parts/$dir";
  68   my $old = "$cur-old";
  69   if (-e $old) {
  70     ask_or_quit("Do you want me to remove the old $old directory?");
  71     rmtree($old);
  72   }
  73   mkdir $old;
  74   print "\nBacking up $cur in $old.\n";
  75   for my $src (@{$files{$dir}}) {
  76     my $dst = $src;
  77     $dst =~ s/\Q$cur/$old/ or die "Ooops!";
  78     move($src, $dst) or die "Moving $src to $dst failed: $!\n";
  79   }
  80 }
  81
  82 my @perlargs;
  83 push @perlargs, "--debug=$opt{debug}" if $opt{debug};
  84 push @perlargs, "--install=$opt{install}" if $opt{install};
  85 push @perlargs, "--blead=$opt{blead}" if $opt{blead};
  86 push @perlargs, "--debug-start=$opt{'debug-start'}" if $opt{'debug-start'};
  87
  88 my $T0 = time;
  89 my @args = ddverbose();
  90 push @args, '--nocheck' unless $opt{check};
  91 push @args, "--blead-version=$opt{'blead-version'}" if $opt{'blead-version'};
  92 push @args, @perlargs;
  93
  94 # Find out what symbols were in what releases
  95 print "\nBuilding baseline files...\n\n";
  96
  97 unless (runperl('devel/mktodo', '--base', @args)) {
  98   print "\nSomething went wrong while building the baseline files.\n";
  99   quit_now();
 100 }
 101
 102 # Move them to parts/base
 103 print "\nMoving baseline files...\n\n";
 104
 105 for my $src (glob 'parts/todo/5*') {
 106   my $dst = $src;
 107   $dst =~ s/todo/base/ or die "Ooops!";
 108   move($src, $dst) or die "Moving $src to $dst failed: $!\n";
 109 }
 110
 111 # Then find out what ppport.h buys us by repeating the process above, but
 112 # using ppport.h
 113 print "\nBuilding todo files...\n\n";
 114
 115 unless (runperl('devel/mktodo', @args)) {
 116   print "\nSomething went wrong while building the todo files.\n";
 117   quit_now();
 118 }
 119
 120 print "\nAdding remaining baseline info...\n\n";
 121
 122 unless (runperl('Makefile.PL') and
 123         runtool('make') and
 124         runperl('devel/scanprov', '--mode=write', @perlargs)) {
 125   print "\nSomething went wrong while adding the baseline info.\n";
 126   quit_now();
 127 }
 128
 129 my($wall, $usr, $sys, $cusr, $csys) = (time - $T0, times);
 130 my $cpu = sprintf "%.2f", $usr + $sys + $cusr + $csys;
 131 $usr = sprintf "%.2f", $usr + $cusr;
 132 $sys = sprintf "%.2f", $sys + $csys;
 133
 134 print <<END;
 135
 136 API info regenerated successfully.
 137
 138 Finished in $wall wallclock secs ($usr usr + $sys sys = $cpu CPU)
 139
 140 Don't forget to check in the files in parts/base and parts/todo.
 141
 142 END
 143
 144 __END__
 145
 146 =head1 NAME
 147
 148 regenerate - Automatically regenerate Devel::PPPort's API information
 149
 150 =head1 SYNOPSIS
 151
 152   regenerate [options]
 153
 154   --nocheck      don't recheck symbols that caused an error
 155   --verbose      show verbose output
 156
 157 =head1 COPYRIGHT
 158
 159 Copyright (c) 2006-2013, Marcus Holland-Moritz.
 160
 161 This program is free software; you can redistribute it and/or
 162 modify it under the same terms as Perl itself.
 163
 164 =head1 SEE ALSO
 165
 166 See L<Devel::PPPort> and L<HACKERS>.
 167
 168 =cut