The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Class::AutoDB::Oid;
use Class::AutoDB::Serialize;
use Class::AutoDB::Globals;
use Scalar::Util qw(refaddr);

my $GLOBALS=Class::AutoDB::Globals->instance();
my $OID2OBJ=$GLOBALS->oid2obj;
my $OBJ2OID=$GLOBALS->obj2oid;

sub DUMPER_freeze {return $_[0];}
sub DUMPER_thaw {
  my($self)=@_;
  my $oid=$self->{_OID};
  #print "<<< Class::AutoDB::Oid::DUMPER_thaw $self ($oid)\n";  
  my $obj=$OID2OBJ->{$oid};
  # NG 10-09-11: yet another place where testing object messes up on Oid or OidDeleted,
  #              'cuz 'bool' overloaded...
  # return $obj if $obj;
  return $obj if ref $obj;
  $OID2OBJ->{$oid}=$self;	# save for next time -- to preserve shared object structure
  $OBJ2OID->{refaddr $self}=$oid;
  $self;
}
# AutoClass defines a 'class' method and AutoDB::Object defines 'oid' method
# but invoking on Oid forces a fetch.
# We override methods here to avoid fetch.
# NG 09-11-12: AutoClass no longer defines class
# NG 09-12-19: Object->oid now deprecated. I say this to clarify comment above
# sub class {$_[0]->{_CLASS};}
sub oid {$_[0]->{_OID};}

# AutoDB::Object defines 'put' method but invoking on Oid forces a fetch.
# If object not in memory, put is unncessary anyway
# NG 09-12-19: Object->put now deprecated. I say this to clarify comment above
sub put {
  # NG 10-08-27: entire subroutine is exercise in futile paranoia.
  #              can only get here if object is Oid in which case 'put' is nop
  # my $self=shift;
  # my $oid=$self->oid;
  # my $obj=$OID2OBJ->{$self->oid};
  # return if !$obj || UNIVERSAL::isa($obj,'Class::AutoDB::Oid');
  # return $obj->put(@_);
}

# NG 10-09-09: decided to remove is_extant, is_deleted, del to avoid polluting namespace further
# # NG 10-08-27: part of support for deleted objects
# #              have to fetch object since that's the only way to know whether it's deleted.
# #              probably not too big a performance hit, since application is likely to
# #              access object pretty soon anyway...
# sub is_extant {
#   my $self=shift;
#   my $oid=$self->oid;
#   Class::AutoDB::Serialize::fetch($oid); # changes $self to real object or OidDeleted
#   ref $self ne 'Class::AutoDB::OidDeleted';
# }
# sub is_deleted {!shift->is_extant}

# # perfectly fine to call del on Oid. 
# # pass though to AutoDB if it exists. else, Serialize::del is the best we can do
# sub del {
#   my $self=shift;
#   my $autodb=$GLOBALS->autodb;
#   $autodb? $autodb->del($self): Class::AutoDB::Serialize->del($self->oid);
# }

use vars qw($AUTOLOAD);
sub AUTOLOAD {
  my $self=shift;
  my $method=$AUTOLOAD;
  $method=~s/^.*:://;             # strip class qualification
  return if $method eq 'DESTROY'; # the books say you should do this
  my $oid=$self->{_OID};

  ####################
  # use object's class if not already done
  # Caution: this all works fine if people follow the Perl convention of
  #  placing module Foo in file Foo.pm.  Else, there's no easy way to
  #  translate a classname into a string that can be 'used'
  # The test 'unless ${$class.'::'}{AUTODB}' cause the 'use' to be skipped if
  #  the class is already loaded.  This should reduce the opportunities
  #  for messing up the class-to-file translation.
  # Note that %{$class.'::'} is the symbol table for the class. There seem
  # to be many cases in which perl creates skeleton symbol tables for a
  # class. By looking for the AUTODB slot, I'm trying to make sure that the
  # body of the class has been used.

  # NG 09-01-14: fixed dumb ass bug: the eval "use..." below is, of course, not run 
  #   if the class is already loaded.  This means that the value of $@ is not reset
  #   by the eval.  So, if it had a true value before the eval, it will have the 
  #   same value afterwards causing the error code to be run!
  #   FIX: changed "use" to "require" (which returns true on success) and use the
  #   return value to control whether error code run
  #  eval "use $class" unless ${$class.'::'}{AUTODB};
  my $class=$self->{_CLASS};
  unless (${$class.'::'}{AUTODB}) {
    eval "require $class" or die $@;
  }
  
  ####################
  my $obj=Class::AutoDB::Serialize::fetch($oid);

  return $obj->$method(@_);
}
####################
# NG 05-12-26
# Fetch object when used as string, so serialized objects will work as expected
# when used as hash keys. Body of code same as AUTOLOAD. 
# TODO: refactor someday
sub stringify {
  my $self=shift;
  my($oid,$class)=@$self{qw(_OID _CLASS)};

  # NG 09-01-14: fixed dumb ass bug: see abouve 
  # eval "use $class" unless ${$class.'::'}{AUTODB};
  unless (${$class.'::'}{AUTODB}) {
    eval "require $class" or die $@;
  }
  my $obj=Class::AutoDB::Serialize::fetch($oid);
  "$obj";
}
# NG 10-09-11: removed eq, ne. Perl autogenerates from stringify
# NG 10-09-11: changed bool to force fetch
# NG 10-09-17: added '0+' (convert to number), since Perls >= 5.10 stringify objects otherwise
use overload
  '""' => \&stringify,
  '0+' => sub {refaddr($_[0])},
  'bool'=>sub {length(stringify($_[0]))>0},
  fallback => 'TRUE';
####################
1;