Commit | Line | Data |
---|---|---|
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 | ||
17 | use strict; | |
18 | use File::Path; | |
19 | use File::Copy; | |
20 | use Getopt::Long; | |
21 | use Pod::Usage; | |
22 | ||
3d7c117d | 23 | require './devel/devtools.pl'; |
0c96388f MHM |
24 | |
25 | our %opt = ( | |
ba120f6f MHM |
26 | check => 1, |
27 | verbose => 0, | |
0c96388f MHM |
28 | ); |
29 | ||
49ef49fe | 30 | GetOptions(\%opt, qw( check! verbose install=s blead=s blead-version=s )) or die pod2usage(); |
0c96388f MHM |
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; | |
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 |
80 | my @perlargs; |
81 | push @perlargs, "--install=$opt{install}" if exists $opt{install}; | |
82 | push @perlargs, "--blead=$opt{blead}" if exists $opt{blead}; | |
83 | ||
0c96388f | 84 | my $T0 = time; |
ba120f6f MHM |
85 | my @args = ddverbose(); |
86 | push @args, '--nocheck' unless $opt{check}; | |
49ef49fe CBW |
87 | push @args, "--blead-version=$opt{'blead-version'}" if exists $opt{'blead-version'}; |
88 | push @args, @perlargs; | |
0c96388f MHM |
89 | |
90 | print "\nBuilding baseline files...\n\n"; | |
91 | ||
ba120f6f | 92 | unless (runperl('devel/mktodo', '--base', @args)) { |
0c96388f MHM |
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 MHM |
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 | |
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 | ||
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 MHM |
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 | ||
b2049988 | 151 | Copyright (c) 2006-2013, Marcus Holland-Moritz. |
ba120f6f MHM |
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 |