#!/usr/bin/perl -w

################################################################################

#

#  regenerate -- regenerate baseline and todo files

#

################################################################################

#

#  Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz.

#  Version 2.x, Copyright (C) 2001, Paul Marquess.

#  Version 1.x, Copyright (C) 1999, Kenneth Albanowski.

#

#  This program is free software; you can redistribute it and/or

#  modify it under the same terms as Perl itself.

#

################################################################################

use strict;

use File::Path;

use File::Copy;

use Getopt::Long;

use Pod::Usage;

require './devel/devtools.pl';

our %opt = (

  check   => 1,

  verbose => 0,

);

GetOptions(\%opt, qw( check! verbose install=s blead=s blead-version=s )) or die pod2usage();

identify();

unless (-e 'parts/embed.fnc' and -e 'parts/apidoc.fnc') {

  print "\nOooops, $0 must be run from the Devel::PPPort root directory.\n";

  quit_now();

}

ask_or_quit("Are you sure you have updated parts/embed.fnc and parts/apidoc.fnc?");

my %files = map { ($_ => [glob "parts/$_/5*"]) } qw( base todo );

my(@notwr, @wr);

for my $f (map @$_, values %files) {

  push @{-w $f ? \@wr : \@notwr}, $f;

}

if (@notwr) {

  if (@wr) {

    print "\nThe following files are not writable:\n\n";

    print "    $_\n" for @notwr;

    print "\nAre you sure you have checked out these files?\n";

  }

  else {

    print "\nAll baseline / todo file are not writable.\n";

    ask_or_quit("Do you want to try to check out these files?");

    unless (runtool("wco", "-l", "-t", "locked by $0", @notwr)) {

      print "\nSomething went wrong while checking out the files.\n";

      quit_now();

    }

  }

}

for my $dir (qw( base todo )) {

  my $cur = "parts/$dir";

  my $old = "$cur-old";

  if (-e $old) {

    ask_or_quit("Do you want me to remove the old $old directory?");

    rmtree($old);

  }

  mkdir $old;

  print "\nBacking up $cur in $old.\n";

  for my $src (@{$files{$dir}}) {

    my $dst = $src;

    $dst =~ s/\Q$cur/$old/ or die "Ooops!";

    move($src, $dst) or die "Moving $src to $dst failed: $!\n";

  }

}

my @perlargs;

push @perlargs, "--install=$opt{install}" if exists $opt{install};

push @perlargs, "--blead=$opt{blead}" if exists $opt{blead};

my $T0 = time;

my @args = ddverbose();

push @args, '--nocheck' unless $opt{check};

push @args, "--blead-version=$opt{'blead-version'}" if exists $opt{'blead-version'};

push @args, @perlargs;

print "\nBuilding baseline files...\n\n";

unless (runperl('devel/mktodo', '--base', @args)) {

  print "\nSomething went wrong while building the baseline files.\n";

  quit_now();

}

print "\nMoving baseline files...\n\n";

for my $src (glob 'parts/todo/5*') {

  my $dst = $src;

  $dst =~ s/todo/base/ or die "Ooops!";

  move($src, $dst) or die "Moving $src to $dst failed: $!\n";

}

print "\nBuilding todo files...\n\n";

unless (runperl('devel/mktodo', @args)) {

  print "\nSomething went wrong while building the baseline files.\n";

  quit_now();

}

print "\nAdding remaining baseline info...\n\n";

unless (runperl('Makefile.PL') and

        runtool('make') and

        runperl('devel/scanprov', '--mode=write', @perlargs)) {

  print "\nSomething went wrong while adding the baseline info.\n";

  quit_now();

}

my($wall, $usr, $sys, $cusr, $csys) = (time - $T0, times);

my $cpu = sprintf "%.2f", $usr + $sys + $cusr + $csys;

$usr = sprintf "%.2f", $usr + $cusr;

$sys = sprintf "%.2f", $sys + $csys;

print <

API info regenerated successfully.

Finished in $wall wallclock secs ($usr usr + $sys sys = $cpu CPU)

Don't forget to check in the files in parts/base and parts/todo.

END

__END__

=head1 NAME

regenerate - Automatically regeneate Devel::PPPort's API information

=head1 SYNOPSIS

  regenerate [options]

  --nocheck      don't recheck symbols that caused an error

  --verbose      show verbose output

=head1 COPYRIGHT

Copyright (c) 2006-2013, Marcus Holland-Moritz.

This program is free software; you can redistribute it and/or

modify it under the same terms as Perl itself.

=head1 SEE ALSO

See L<Devel::PPPort> and L<HACKERS>.

=cut