Commit | Line | Data |
0c96388f |
1 | #!/usr/bin/perl -w |
2 | ################################################################################ |
3 | # |
4 | # regenerate -- regenerate baseline and todo files |
5 | # |
6 | ################################################################################ |
7 | # |
51d6c659 |
8 | # $Revision: 8 $ |
0c96388f |
9 | # $Author: mhx $ |
51d6c659 |
10 | # $Date: 2009/01/18 14:10:50 +0100 $ |
0c96388f |
11 | # |
12 | ################################################################################ |
13 | # |
51d6c659 |
14 | # Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. |
0c96388f |
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 = ( |
ba120f6f |
32 | check => 1, |
33 | verbose => 0, |
0c96388f |
34 | ); |
35 | |
ba120f6f |
36 | GetOptions(\%opt, qw( check! verbose )) or die pod2usage(); |
0c96388f |
37 | |
38 | identify(); |
39 | |
40 | unless (-e 'parts/embed.fnc' and -e 'parts/apidoc.fnc') { |
41 | print "\nOooops, $0 must be run from the Devel::PPPort root directory.\n"; |
42 | quit_now(); |
43 | } |
44 | |
45 | ask_or_quit("Are you sure you have updated parts/embed.fnc and parts/apidoc.fnc?"); |
46 | |
47 | my %files = map { ($_ => [glob "parts/$_/5*"]) } qw( base todo ); |
48 | |
49 | my(@notwr, @wr); |
50 | for my $f (map @$_, values %files) { |
51 | push @{-w $f ? \@wr : \@notwr}, $f; |
52 | } |
53 | |
54 | if (@notwr) { |
55 | if (@wr) { |
56 | print "\nThe following files are not writable:\n\n"; |
57 | print " $_\n" for @notwr; |
58 | print "\nAre you sure you have checked out these files?\n"; |
59 | } |
60 | else { |
61 | print "\nAll baseline / todo file are not writable.\n"; |
62 | ask_or_quit("Do you want to try to check out these files?"); |
63 | unless (runtool("wco", "-l", "-t", "locked by $0", @notwr)) { |
64 | print "\nSomething went wrong while checking out the files.\n"; |
65 | quit_now(); |
66 | } |
67 | } |
68 | } |
69 | |
70 | for my $dir (qw( base todo )) { |
71 | my $cur = "parts/$dir"; |
72 | my $old = "$cur-old"; |
73 | if (-e $old) { |
74 | ask_or_quit("Do you want me to remove the old $old directory?"); |
75 | rmtree($old); |
76 | } |
77 | mkdir $old; |
78 | print "\nBacking up $cur in $old.\n"; |
79 | for my $src (@{$files{$dir}}) { |
80 | my $dst = $src; |
81 | $dst =~ s/\E$cur/$old/ or die "Ooops!"; |
82 | move($src, $dst) or die "Moving $src to $dst failed: $!\n"; |
83 | } |
84 | } |
85 | |
86 | my $T0 = time; |
ba120f6f |
87 | my @args = ddverbose(); |
88 | push @args, '--nocheck' unless $opt{check}; |
0c96388f |
89 | |
90 | print "\nBuilding baseline files...\n\n"; |
91 | |
ba120f6f |
92 | unless (runperl('devel/mktodo', '--base', @args)) { |
0c96388f |
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 | |
ba120f6f |
107 | unless (runperl('devel/mktodo', @args)) { |
0c96388f |
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', 'write')) { |
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 | |
ba120f6f |
136 | __END__ |
137 | |
138 | =head1 NAME |
139 | |
140 | regenerate - Automatically regeneate 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 | |
51d6c659 |
151 | Copyright (c) 2006-2009, Marcus Holland-Moritz. |
ba120f6f |
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 |
161 | |