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