1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
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
|
