This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Spelling correction.
[perl5.git] / 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   verbose => 0,
28 );
29
30 GetOptions(\%opt, qw( check! verbose install=s blead=s blead-version=s )) or die pod2usage();
31
32 identify();
33
34 unless (-e 'parts/embed.fnc' and -e 'parts/apidoc.fnc') {
35   print "\nOooops, $0 must be run from the Devel::PPPort root directory.\n";
36   quit_now();
37 }
38
39 ask_or_quit("Are you sure you have updated parts/embed.fnc and parts/apidoc.fnc?");
40
41 my %files = map { ($_ => [glob "parts/$_/5*"]) } qw( base todo );
42
43 my(@notwr, @wr);
44 for my $f (map @$_, values %files) {
45   push @{-w $f ? \@wr : \@notwr}, $f;
46 }
47
48 if (@notwr) {
49   if (@wr) {
50     print "\nThe following files are not writable:\n\n";
51     print "    $_\n" for @notwr;
52     print "\nAre you sure you have checked out these files?\n";
53   }
54   else {
55     print "\nAll baseline / todo file are not writable.\n";
56     ask_or_quit("Do you want to try to check out these files?");
57     unless (runtool("wco", "-l", "-t", "locked by $0", @notwr)) {
58       print "\nSomething went wrong while checking out the files.\n";
59       quit_now();
60     }
61   }
62 }
63
64 for my $dir (qw( base todo )) {
65   my $cur = "parts/$dir";
66   my $old = "$cur-old";
67   if (-e $old) {
68     ask_or_quit("Do you want me to remove the old $old directory?");
69     rmtree($old);
70   }
71   mkdir $old;
72   print "\nBacking up $cur in $old.\n";
73   for my $src (@{$files{$dir}}) {
74     my $dst = $src;
75     $dst =~ s/\Q$cur/$old/ or die "Ooops!";
76     move($src, $dst) or die "Moving $src to $dst failed: $!\n";
77   }
78 }
79
80 my @perlargs;
81 push @perlargs, "--install=$opt{install}" if exists $opt{install};
82 push @perlargs, "--blead=$opt{blead}" if exists $opt{blead};
83
84 my $T0 = time;
85 my @args = ddverbose();
86 push @args, '--nocheck' unless $opt{check};
87 push @args, "--blead-version=$opt{'blead-version'}" if exists $opt{'blead-version'};
88 push @args, @perlargs;
89
90 print "\nBuilding baseline files...\n\n";
91
92 unless (runperl('devel/mktodo', '--base', @args)) {
93   print "\nSomething went wrong while building the baseline files.\n";
94   quit_now();
95 }
96
97 print "\nMoving baseline files...\n\n";
98
99 for my $src (glob 'parts/todo/5*') {
100   my $dst = $src;
101   $dst =~ s/todo/base/ or die "Ooops!";
102   move($src, $dst) or die "Moving $src to $dst failed: $!\n";
103 }
104
105 print "\nBuilding todo files...\n\n";
106
107 unless (runperl('devel/mktodo', @args)) {
108   print "\nSomething went wrong while building the baseline files.\n";
109   quit_now();
110 }
111
112 print "\nAdding remaining baseline info...\n\n";
113
114 unless (runperl('Makefile.PL') and
115         runtool('make') and
116         runperl('devel/scanprov', '--mode=write', @perlargs)) {
117   print "\nSomething went wrong while adding the baseline info.\n";
118   quit_now();
119 }
120
121 my($wall, $usr, $sys, $cusr, $csys) = (time - $T0, times);
122 my $cpu = sprintf "%.2f", $usr + $sys + $cusr + $csys;
123 $usr = sprintf "%.2f", $usr + $cusr;
124 $sys = sprintf "%.2f", $sys + $csys;
125
126 print <<END;
127
128 API info regenerated successfully.
129
130 Finished in $wall wallclock secs ($usr usr + $sys sys = $cpu CPU)
131
132 Don't forget to check in the files in parts/base and parts/todo.
133
134 END
135
136 __END__
137
138 =head1 NAME
139
140 regenerate - Automatically regenerate Devel::PPPort's API information
141
142 =head1 SYNOPSIS
143
144   regenerate [options]
145
146   --nocheck      don't recheck symbols that caused an error
147   --verbose      show verbose output
148
149 =head1 COPYRIGHT
150
151 Copyright (c) 2006-2013, Marcus Holland-Moritz.
152
153 This program is free software; you can redistribute it and/or
154 modify it under the same terms as Perl itself.
155
156 =head1 SEE ALSO
157
158 See L<Devel::PPPort> and L<HACKERS>.
159
160 =cut