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
17use strict;
18use File::Path;
19use File::Copy;
20use Getopt::Long;
21use Pod::Usage;
22
23require './devel/devtools.pl';
24
25our %opt = (
26  check   => 1,
27  verbose => 0,
28);
29
30GetOptions(\%opt, qw( check! verbose install=s blead=s blead-version=s )) or die pod2usage();
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;
75    $dst =~ s/\Q$cur/$old/ or die "Ooops!";
76    move($src, $dst) or die "Moving $src to $dst failed: $!\n";
77  }
78}
79
80my @perlargs;
81push @perlargs, "--install=$opt{install}" if exists $opt{install};
82push @perlargs, "--blead=$opt{blead}" if exists $opt{blead};
83
84my $T0 = time;
85my @args = ddverbose();
86push @args, '--nocheck' unless $opt{check};
87push @args, "--blead-version=$opt{'blead-version'}" if exists $opt{'blead-version'};
88push @args, @perlargs;
89
90print "\nBuilding baseline files...\n\n";
91
92unless (runperl('devel/mktodo', '--base', @args)) {
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
107unless (runperl('devel/mktodo', @args)) {
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
116        runperl('devel/scanprov', '--mode=write', @perlargs)) {
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
136__END__
137
138=head1 NAME
139
140regenerate - Automatically regenerate 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
151Copyright (c) 2006-2013, Marcus Holland-Moritz.
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
161