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
CommitLineData
0c96388f
MHM
1#!/usr/bin/perl -w
2################################################################################
3#
4# regenerate -- regenerate baseline and todo files
5#
6################################################################################
7#
b2049988 8# Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz.
0c96388f
MHM
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
17use strict;
18use File::Path;
19use File::Copy;
20use Getopt::Long;
21use Pod::Usage;
22
3d7c117d 23require './devel/devtools.pl';
0c96388f
MHM
24
25our %opt = (
ba120f6f
MHM
26 check => 1,
27 verbose => 0,
0c96388f
MHM
28);
29
49ef49fe 30GetOptions(\%opt, qw( check! verbose install=s blead=s blead-version=s )) or die pod2usage();
0c96388f
MHM
31
32identify();
33
34unless (-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
39ask_or_quit("Are you sure you have updated parts/embed.fnc and parts/apidoc.fnc?");
40
41my %files = map { ($_ => [glob "parts/$_/5*"]) } qw( base todo );
42
43my(@notwr, @wr);
44for my $f (map @$_, values %files) {
45 push @{-w $f ? \@wr : \@notwr}, $f;
46}
47
48if (@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
64for 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;
744ef08f 75 $dst =~ s/\Q$cur/$old/ or die "Ooops!";
0c96388f
MHM
76 move($src, $dst) or die "Moving $src to $dst failed: $!\n";
77 }
78}
79
49ef49fe
CBW
80my @perlargs;
81push @perlargs, "--install=$opt{install}" if exists $opt{install};
82push @perlargs, "--blead=$opt{blead}" if exists $opt{blead};
83
0c96388f 84my $T0 = time;
ba120f6f
MHM
85my @args = ddverbose();
86push @args, '--nocheck' unless $opt{check};
49ef49fe
CBW
87push @args, "--blead-version=$opt{'blead-version'}" if exists $opt{'blead-version'};
88push @args, @perlargs;
0c96388f
MHM
89
90print "\nBuilding baseline files...\n\n";
91
ba120f6f 92unless (runperl('devel/mktodo', '--base', @args)) {
0c96388f
MHM
93 print "\nSomething went wrong while building the baseline files.\n";
94 quit_now();
95}
96
97print "\nMoving baseline files...\n\n";
98
99for 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
105print "\nBuilding todo files...\n\n";
106
ba120f6f 107unless (runperl('devel/mktodo', @args)) {
0c96388f
MHM
108 print "\nSomething went wrong while building the baseline files.\n";
109 quit_now();
110}
111
112print "\nAdding remaining baseline info...\n\n";
113
114unless (runperl('Makefile.PL') and
115 runtool('make') and
49ef49fe 116 runperl('devel/scanprov', '--mode=write', @perlargs)) {
0c96388f
MHM
117 print "\nSomething went wrong while adding the baseline info.\n";
118 quit_now();
119}
120
121my($wall, $usr, $sys, $cusr, $csys) = (time - $T0, times);
122my $cpu = sprintf "%.2f", $usr + $sys + $cusr + $csys;
123$usr = sprintf "%.2f", $usr + $cusr;
124$sys = sprintf "%.2f", $sys + $csys;
125
126print <<END;
127
128API info regenerated successfully.
129
130Finished in $wall wallclock secs ($usr usr + $sys sys = $cpu CPU)
131
132Don't forget to check in the files in parts/base and parts/todo.
133
134END
135
ba120f6f
MHM
136__END__
137
138=head1 NAME
139
c4a2ac43 140regenerate - Automatically regenerate Devel::PPPort's API information
ba120f6f
MHM
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
b2049988 151Copyright (c) 2006-2013, Marcus Holland-Moritz.
ba120f6f
MHM
152
153This program is free software; you can redistribute it and/or
154modify it under the same terms as Perl itself.
155
156=head1 SEE ALSO
157
158See L<Devel::PPPort> and L<HACKERS>.
159
160=cut