|
Packit |
7d6a7d |
#!/usr/bin/perl -w
|
|
Packit |
7d6a7d |
################################################################################
|
|
Packit |
7d6a7d |
#
|
|
Packit |
7d6a7d |
# regenerate -- regenerate baseline and todo files
|
|
Packit |
7d6a7d |
#
|
|
Packit |
7d6a7d |
################################################################################
|
|
Packit |
7d6a7d |
#
|
|
Packit |
7d6a7d |
# Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz.
|
|
Packit |
7d6a7d |
# Version 2.x, Copyright (C) 2001, Paul Marquess.
|
|
Packit |
7d6a7d |
# Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
|
|
Packit |
7d6a7d |
#
|
|
Packit |
7d6a7d |
# This program is free software; you can redistribute it and/or
|
|
Packit |
7d6a7d |
# modify it under the same terms as Perl itself.
|
|
Packit |
7d6a7d |
#
|
|
Packit |
7d6a7d |
################################################################################
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
use strict;
|
|
Packit |
7d6a7d |
use File::Path;
|
|
Packit |
7d6a7d |
use File::Copy;
|
|
Packit |
7d6a7d |
use Getopt::Long;
|
|
Packit |
7d6a7d |
use Pod::Usage;
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
require './devel/devtools.pl';
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
our %opt = (
|
|
Packit |
7d6a7d |
check => 1,
|
|
Packit |
7d6a7d |
verbose => 0,
|
|
Packit |
7d6a7d |
);
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
GetOptions(\%opt, qw( check! verbose install=s blead=s blead-version=s )) or die pod2usage();
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
identify();
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
unless (-e 'parts/embed.fnc' and -e 'parts/apidoc.fnc') {
|
|
Packit |
7d6a7d |
print "\nOooops, $0 must be run from the Devel::PPPort root directory.\n";
|
|
Packit |
7d6a7d |
quit_now();
|
|
Packit |
7d6a7d |
}
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
ask_or_quit("Are you sure you have updated parts/embed.fnc and parts/apidoc.fnc?");
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
my %files = map { ($_ => [glob "parts/$_/5*"]) } qw( base todo );
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
my(@notwr, @wr);
|
|
Packit |
7d6a7d |
for my $f (map @$_, values %files) {
|
|
Packit |
7d6a7d |
push @{-w $f ? \@wr : \@notwr}, $f;
|
|
Packit |
7d6a7d |
}
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
if (@notwr) {
|
|
Packit |
7d6a7d |
if (@wr) {
|
|
Packit |
7d6a7d |
print "\nThe following files are not writable:\n\n";
|
|
Packit |
7d6a7d |
print " $_\n" for @notwr;
|
|
Packit |
7d6a7d |
print "\nAre you sure you have checked out these files?\n";
|
|
Packit |
7d6a7d |
}
|
|
Packit |
7d6a7d |
else {
|
|
Packit |
7d6a7d |
print "\nAll baseline / todo file are not writable.\n";
|
|
Packit |
7d6a7d |
ask_or_quit("Do you want to try to check out these files?");
|
|
Packit |
7d6a7d |
unless (runtool("wco", "-l", "-t", "locked by $0", @notwr)) {
|
|
Packit |
7d6a7d |
print "\nSomething went wrong while checking out the files.\n";
|
|
Packit |
7d6a7d |
quit_now();
|
|
Packit |
7d6a7d |
}
|
|
Packit |
7d6a7d |
}
|
|
Packit |
7d6a7d |
}
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
for my $dir (qw( base todo )) {
|
|
Packit |
7d6a7d |
my $cur = "parts/$dir";
|
|
Packit |
7d6a7d |
my $old = "$cur-old";
|
|
Packit |
7d6a7d |
if (-e $old) {
|
|
Packit |
7d6a7d |
ask_or_quit("Do you want me to remove the old $old directory?");
|
|
Packit |
7d6a7d |
rmtree($old);
|
|
Packit |
7d6a7d |
}
|
|
Packit |
7d6a7d |
mkdir $old;
|
|
Packit |
7d6a7d |
print "\nBacking up $cur in $old.\n";
|
|
Packit |
7d6a7d |
for my $src (@{$files{$dir}}) {
|
|
Packit |
7d6a7d |
my $dst = $src;
|
|
Packit |
7d6a7d |
$dst =~ s/\Q$cur/$old/ or die "Ooops!";
|
|
Packit |
7d6a7d |
move($src, $dst) or die "Moving $src to $dst failed: $!\n";
|
|
Packit |
7d6a7d |
}
|
|
Packit |
7d6a7d |
}
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
my @perlargs;
|
|
Packit |
7d6a7d |
push @perlargs, "--install=$opt{install}" if exists $opt{install};
|
|
Packit |
7d6a7d |
push @perlargs, "--blead=$opt{blead}" if exists $opt{blead};
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
my $T0 = time;
|
|
Packit |
7d6a7d |
my @args = ddverbose();
|
|
Packit |
7d6a7d |
push @args, '--nocheck' unless $opt{check};
|
|
Packit |
7d6a7d |
push @args, "--blead-version=$opt{'blead-version'}" if exists $opt{'blead-version'};
|
|
Packit |
7d6a7d |
push @args, @perlargs;
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
print "\nBuilding baseline files...\n\n";
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
unless (runperl('devel/mktodo', '--base', @args)) {
|
|
Packit |
7d6a7d |
print "\nSomething went wrong while building the baseline files.\n";
|
|
Packit |
7d6a7d |
quit_now();
|
|
Packit |
7d6a7d |
}
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
print "\nMoving baseline files...\n\n";
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
for my $src (glob 'parts/todo/5*') {
|
|
Packit |
7d6a7d |
my $dst = $src;
|
|
Packit |
7d6a7d |
$dst =~ s/todo/base/ or die "Ooops!";
|
|
Packit |
7d6a7d |
move($src, $dst) or die "Moving $src to $dst failed: $!\n";
|
|
Packit |
7d6a7d |
}
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
print "\nBuilding todo files...\n\n";
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
unless (runperl('devel/mktodo', @args)) {
|
|
Packit |
7d6a7d |
print "\nSomething went wrong while building the baseline files.\n";
|
|
Packit |
7d6a7d |
quit_now();
|
|
Packit |
7d6a7d |
}
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
print "\nAdding remaining baseline info...\n\n";
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
unless (runperl('Makefile.PL') and
|
|
Packit |
7d6a7d |
runtool('make') and
|
|
Packit |
7d6a7d |
runperl('devel/scanprov', '--mode=write', @perlargs)) {
|
|
Packit |
7d6a7d |
print "\nSomething went wrong while adding the baseline info.\n";
|
|
Packit |
7d6a7d |
quit_now();
|
|
Packit |
7d6a7d |
}
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
my($wall, $usr, $sys, $cusr, $csys) = (time - $T0, times);
|
|
Packit |
7d6a7d |
my $cpu = sprintf "%.2f", $usr + $sys + $cusr + $csys;
|
|
Packit |
7d6a7d |
$usr = sprintf "%.2f", $usr + $cusr;
|
|
Packit |
7d6a7d |
$sys = sprintf "%.2f", $sys + $csys;
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
print <
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
API info regenerated successfully.
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
Finished in $wall wallclock secs ($usr usr + $sys sys = $cpu CPU)
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
Don't forget to check in the files in parts/base and parts/todo.
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
END
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
__END__
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
=head1 NAME
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
regenerate - Automatically regeneate Devel::PPPort's API information
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
=head1 SYNOPSIS
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
regenerate [options]
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
--nocheck don't recheck symbols that caused an error
|
|
Packit |
7d6a7d |
--verbose show verbose output
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
=head1 COPYRIGHT
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
Copyright (c) 2006-2013, Marcus Holland-Moritz.
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
This program is free software; you can redistribute it and/or
|
|
Packit |
7d6a7d |
modify it under the same terms as Perl itself.
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
=head1 SEE ALSO
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
See L<Devel::PPPort> and L<HACKERS>.
|
|
Packit |
7d6a7d |
|
|
Packit |
7d6a7d |
=cut
|