The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Class::AutoDB::Registry;
use vars qw(@ISA @AUTO_ATTRIBUTES @OTHER_ATTRIBUTES %SYNONYMS %DEFAULTS);
use strict;
use Text::Abbrev;
use Class::AutoClass;
# use Hash::AutoHash::Args;
use Class::AutoDB::RegistryVersion;
use Class::AutoDB::RegistryDiff;
use Class::AutoDB::Registration;
use Class::AutoDB::Collection;
use Class::AutoDB::Serialize;
@ISA = qw(Class::AutoClass Class::AutoDB::Serialize);

# NG 09-12-19: changes for cleanup of user-object namespace
my $GLOBALS=Class::AutoDB::Globals->instance();
my $REGISTRY_OID=$GLOBALS->registry_oid;

# NG 11-01-07: name2coll seems to be unused. all 'coll' methods delegate to current
# @AUTO_ATTRIBUTES=qw(autodb name2coll current saved diff);
@AUTO_ATTRIBUTES=qw(autodb current saved diff);
@OTHER_ATTRIBUTES=qw(oid);
%SYNONYMS=();
%DEFAULTS=();
Class::AutoClass::declare(__PACKAGE__);

sub _init_self {
  my($self,$class,$args)=@_;
  return unless $class eq __PACKAGE__; # to prevent subclasses from re-running this
  $self->get;			# get or initialize saved version. also inits current version
}
sub oid {$REGISTRY_OID}		# do it this way so oid is set when Serialize
                                # constructor called
sub register {
  my $self=shift;
  $self->current->register(@_);
}
sub collections {
  my $self=shift;
  $self->current->collections;
}
sub collection {
  my $self=shift;
  $self->current->collection(@_);
}
sub class2collections {
  my $self=shift;
  $self->current->class2collections(@_);
}
sub class2transients {
  my $self=shift;
  $self->current->class2transients(@_);
}

sub merge {
  my($self)=@_;
  my $current=$self->current;
  my $saved=$self->saved;
  my $diff=new Class::AutoDB::RegistryDiff(-baseline=>$saved,-other=>$current);
  $self->diff($diff);		# hang onto this since it's expensive to compute
  $saved->merge($diff);
}

my @WHATS=qw(create drop alter);
my %WHATS=abbrev @WHATS;

sub schema {
  my($self,$what,$index_flag)=@_;
  $what or $what='create';
  $index_flag = defined $index_flag ? $index_flag : 1; # indexing is default operation
  $what=$WHATS{lc($what)} || $self->throw("Invalid \$what for schema: $what. Should be one of: @WHATS");
  my @sql;
  if ($what eq 'create') {	# create current collections
    push(@sql,map {$_->drop} $self->saved->collections); # drop existing collections first
    push(@sql,map {$_->create($index_flag)} $self->current->collections); # then create new ones
  } elsif ($what eq 'drop') {	# drop current & saved collections
    push(@sql,map {$_->drop} $self->saved->collections);
    push(@sql,map {$_->drop} $self->current->collections);
  } else {			# it's alter
    my $diff=$self->diff;
    my $new_collections=$diff->new_collections;
    push(@sql,map {$_->create} @$new_collections);
    my $expanded=$diff->expanded_diffs;
    for my $diff (@$expanded) {
      my $collection=$diff->other;
      push(@sql,$collection->alter($diff));
    }
  }
  wantarray? @sql: \@sql;
}
sub get {			# retrieve saved registry
  my($self)=@_;
  # save transient state across fetch
  my $autodb=$self->autodb;
  my $current=$self->current;
  # !! fetch overwrites entire object !!
  Class::AutoDB::Serialize::really_fetch($REGISTRY_OID,$self) if $autodb && $autodb->exists;
  # initialize saved if necessary
  $self->saved or $self->saved(new Class::AutoDB::RegistryVersion(-registry=>$self));
  # restore transient state. initialize current if necessary
  $self->autodb($autodb);
  $self->current($current || new Class::AutoDB::RegistryVersion(-registry=>$self));
}
sub put {			# store saved registry
  my($self)=@_;
  # save and clear transient state. TODO: use 'transients' when implemented
  my $autodb=$self->autodb;
  my $current=$self->current;
  my $diff=$self->diff;
  $self->autodb(undef);
  $self->current(undef);
  $self->diff(undef);
  $self->store;			# Class::AutoDB::Serialize::store
  # restore transient state
  $self->autodb($autodb);
  $self->current($current);
  $self->diff($diff);
}

sub _flatten {map {'ARRAY' eq ref $_? @$_: $_} @_;}

1;