dcdb-upgrade.perl

#!/usr/bin/perl -w

use lib qw(. dclib);
use version;
use DiaColloDB;
use DiaColloDB::Upgrade;
use File::Basename qw(basename);
use Getopt::Long qw(:config no_ignore_case);
use Pod::Usage;
use utf8;
use strict;

BEGIN {
  select(STDERR); $|=1; select(STDOUT); $|=1;
  binmode(STDOUT,':utf8');
}

##======================================================================
## Globals

##-- program vars
our $prog  = basename($0);

##-- upgrade options
our %uopts = (
	      backup=>1,
	      keep=>0,
	     );

##======================================================================
## command-line
my $act = 'upgrade'; ##-- one of: help list which check upgrade apply revert
my @upgrades = qw();
GetOptions(
	   'help|h' => sub { $act='help' },
	   'list-available|list-all|list|all|available' => sub { $act='list' },
	   'which|w|list-applied|applied|la' => sub { $act='which' },
	   'check|c' => => sub { $act='check' },
	   'upgrade|u' => sub { $act='upgrade' },
	   'force-apply|fa|apply|a=s' => sub { $act='apply'; @upgrades = grep {($_//'') ne ''} split(/[\s\,]+/,$_[1]) },
	   'revert|reverse|rollback|r' => sub { $act='revert' },
	   ##
	   'backup|b!' => \$uopts{backup},
	   'keep|k!'  => \$uopts{keep},
	  );

pod2usage({-exitval=>0,-verbose=>0}) if ($act eq 'help');
pod2usage({-exitval=>1,-verbose=>0,-msg=>"$prog: ERROR: no DBDIR specified!"}) if ($act ne 'list' && @ARGV < 1);
warn("$prog: WARNING: too many arguments for -list mode") if ($act eq 'list' && @ARGV);

##======================================================================
## MAIN

DiaColloDB->ensureLog();

my $up = 'DiaColloDB::Upgrade';
if ($act eq 'list') {
  ##-- list available upgrades
  print map {"$_\n"} $up->available();
  exit 0;
}

my $timer = DiaColloDB::Timer->start();
my $dbdir = shift;
$dbdir    =~ s{/+$}{};
my (@needed,@which);

if ($act =~ /^(?:check|upgrade)$/) {
  ##-- find applicable upgrades
  $up->info("checking applicable upgrades for $dbdir");
  @needed = $up->needed($dbdir, \%uopts, $up->available);
  if ($act eq 'check') {
    ##-- check: ostentatiously list applicable upgrades
    print "\n", (map {"$_\n"} @needed), "\n" if (@needed);
  } else {
    ##-- upgrade: log applicable upgrades (they'll be applied below)
    $up->info("found applicable upgrade package: $_") foreach (@needed);
  }
  if (!@needed) {
    $up->info("no applicable upgrades found for $dbdir");
  }
}
elsif ($act =~ /^which|revert$/) {
  $up->info("checking auto-applied upgrades for $dbdir");
  @which = $up->which($dbdir, \%uopts);
  if ($act eq 'which') {
    ##-- which: ostentatiously list applied upgrades
    my $fmt = "%-42s %-16s %-21s %-8s -> %-8s\n";
    print
      ("\n",
       sprintf($fmt, map {"#".uc($_)} qw(package by timestamp v_from v_to)),
       (map {
	 (my $by = ($_->{by}//'?')) =~ s/^DiaColloDB::Upgrade:://;
	 sprintf($fmt, ref($_), $by, map {($_//'?')} @$_{qw(timestamp version_from version_to)});
       } @which),
       "\n");
  }
  if (!@which) {
    $up->info("no auto-applied upgrades found for $dbdir");
  }
}


if ($act eq 'upgrade') {
  ##-- upgrade: apply available upgrades
  $up->upgrade($dbdir, \%uopts, @needed)
    or die("$0: upgrade failed for $dbdir");
}
elsif ($act eq 'apply') {
  ##-- apply: force-apply selected upgrades
  $up->upgrade($dbdir,\%uopts, @upgrades)
    or die("$0: force-apply upgrade(s) failed");
}
elsif ($act eq 'revert') {
  ##-- revert: un-apply most recent upgrade
  my $rb = $which[0];
  die("$0: no auto-upgrades to roll back!")
    if (!defined($rb));
  die("$0: no revert() method for class ", ref($rb))
    if (!UNIVERSAL::can($rb,'revert'));
  $rb->revert()
    or die("$0: revert failed for class ", ref($rb));
}

##-- all done
$up->info("operation '$act' completed in ", $timer->timestr);

__END__

###############################################################
## pods
###############################################################

=pod

=head1 NAME

dcdb-upgrade.perl - upgrade a DiaColloDB directory in-place

=head1 SYNOPSIS

 dcdb-upgrade.perl -list
 dcdb-upgrade.perl [OPTIONS] DBDIR

 Options:
   -h, -help       # this help message
   -l, -list       # list all available upgrade packages
   -w, -which      # list previous auto-upgrades to DBDIR
   -c, -check      # check applicability of available upgrades for DBDIR
   -u, -upgrade    # apply any applicable upgrades to DBDIR (default)
   -r, -revert     # revert the most recent upgrade to DBDIR
   -a, -apply PKGS # force-apply comma-separated upgrade package(s) to DBDIR
   -[no]backup     # do/don't create auto-backups (default=do)
   -[no]keep       # do/don't keep temporary files created by upgrade (default=don't)

=cut

###############################################################
## DESCRIPTION
###############################################################
=pod

=head1 DESCRIPTION

dcdb-upgrade.perl
checks for & applies automatic upgrades to a L<DiaColloDB|DiaColloDB>
database directory, using the L<DiaColloDB::Upgrade|DiaColloDB::Upgrade> API.
The DBDIR database is altered in-place, so it is safest
to make a backup of DBDIR before upgrading.

=cut

###############################################################
## OPTIONS AND ARGUMENTS
###############################################################
=pod

=head1 OPTIONS AND ARGUMENTS

=cut

###############################################################
# Arguments
###############################################################
=pod

=head2 Arguments

=over 4

=item DBDIR

L<DiaColloDB|DiaColloDB> database directory to be checked and/or upgraded.

=back

=cut

###############################################################
# Options
###############################################################
=pod

=head2 Options

=over 4

=item -h, -help

Display a brief help message and exit.

=item -l, -list

List all known L<DiaColloDB::Upgrade|DiaColloDB::Upgrade> packages.

=item -w, -which

List upgrades  previously applied to C<DBDIR>.

=item -c, -check

Check applicability of available upgrades to C<DBDIR>.

=item -u, -upgrade

Apply any applicable upgrades to F<DBDIR>;
this is the default mode of operation.
It is safest to make a manual backup of F<DBDIR> before upgrading,
although the L<DiaColloDB::Upgrade::Base|DiaColloDB::Upgrade::Base>
hierarchy should provide backup functionality for changed files.

=item -r, -revert

Revert the most recently applied upgrade to F<DBDIR>;
requires that a backup was auto-created by the L<DiaColloDB::Upgrade::Base|DiaColloDB::Upgrade::Base>
subclass implementing the most recent upgrade.

=item -a, -apply PKGS

Force-apply the comma- or space-separated list of
L<DiaColloDB::Upgrade|DiaColloDB::Upgrade>-compliant packages
C<PKGS> to F<DBDIR>.
Use with caution, no applicability checking is performed in this mode.

=back

=cut


###############################################################
# Bugs and Limitations
###############################################################
=pod

=head1 BUGS AND LIMITATIONS

Probably many.

=cut


###############################################################
# Footer
###############################################################
=pod

=head1 ACKNOWLEDGEMENTS

Perl by Larry Wall.

=head1 AUTHOR

Bryan Jurish E<lt>moocow@cpan.orgE<gt>

=head1 SEE ALSO

L<DiaColloDB::Upgrade(3pm)|DiaColloDB::Upgrade>,
L<DiaColloDB(3pm)|DiaColloDB>,
L<dcdb-info.perl(1)|dcdb-info.perl>,
perl(1).

=cut