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