view release on metacpan or  search on metacpan

DiaColloDB/Upgrade/Base.pm  view on Meta::CPAN

  ##-- remove backup directory
  $up->trace("revert(): removing backup directory $backd");
  remove_tree($backd)
    or $up->logconfess("revert(): failed to remove backup directory $backd: $!");

  return 1;
}

## @files = $up->revert_created()
##  + returns list of files created by this upgrade, for use with default revert() implementation
sub revert_created {
  $_[0]->logconfess("revert_created() method not implemented");
}

## @files = $up->revert_updated()
##  + returns list of files updated by this upgrade, for use with default revert() implementation
sub revert_updated {
  $_[0]->logconfess("revert_updated() method not implemented");
}

##==============================================================================
## Utilities

## \%hdr = $CLASS_OR_OBJECT->dbheader($dbdir?)
##  + reads $dbdir/header.json
##  + default uses cached $CLASS_OR_OBJECT->{hdr} if available
sub dbheader {
  my ($up,$dbdir) = @_;
  $dbdir //= $up->{dbdir} if (ref($up));
  return $up->{hdr}
    if (ref($up) && defined($up->{hdr}) && ($up->{dbdir}//'') eq $dbdir);
  my $hdr = DiaColloDB::Utils::loadJsonFile("$dbdir/header.json")
      or $up->logconfess("dbheader(): failed to read header $dbdir/header.json: $!");
  return $hdr;
}

## \%uinfo = $up->uinfo($dbdir?,%info)
##  + returns a default upgrade-info structure for %info
##  + conventional keys %uinfo =
##    (
##     version_from => $vfrom,    ##-- source version (default='unknown')
##     version_to   => $vto,      ##-- target version (default=$CLASS_OR_OBJECT->_toversion)
##     timestamp    => $time,     ##-- timestamp (default=$up->{timestamp} || DiaColloDB::Utils::timestamp(time))
##     by           => $who,      ##-- user or script-name (default=$CLASS)
##    )
sub uinfo {
  my $up    = shift;
  my $dbdir = ((scalar(@_)%2)==0 ? undef : shift) // $up->{hdr};
  my $header = $up->{hdr} // ($dbdir ? $up->dbheader($dbdir) : {});
  return {
	  version_from=>($header->{version} // 'unknown'),
	  version_to=>$up->toversion,
	  timestamp=>($up->{timestamp} || DiaColloDB::Utils::timestamp(time)),
	  by=>$up->label,
	  @_
	 };
}

## $bool = $up->updateHeader(\%extra_uinfo, \%extra_header_data)
##  + updates header $dbdir/header.json, creating backup if requested
sub updateHeader {
  my ($up,$xinfo,$xhdr) = @_;
  my $dbdir = $up->{dbdir};

  ##-- backup old header if requested
  !$up->{backup}
    or DiaColloDB::Utils::copyto_a("$dbdir/header.json", $up->backupdir)
    or $up->logconfess("updateHeader(): failed to backup header to ".$up->backupdir.": $!");

  ##-- get upgrade info
  my $uinfo = $up->uinfo($dbdir, %{$xinfo//{}});
  return if (!defined($uinfo)); ##-- silent upgrade

  my $header   = $up->dbheader($dbdir);
  my $upgraded = ($header->{upgraded} //= []);
  unshift(@$upgraded, $uinfo);
  $header->{version} = $uinfo->{version_to} if ($uinfo->{version_to});
  @$header{keys %$xhdr} = values %$xhdr if ($xhdr);
  DiaColloDB::Utils::saveJsonFile($header, "$dbdir/header.json")
      or $up->logconfess("updateHeader(): failed to save header data to $dbdir/header.json: $!");
  return $up;
}


##==============================================================================
## Footer
1; ##-- be happy