Class-AutoDB

 view release on metacpan or  search on metacpan

lib/Class/AutoDB.pm  view on Meta::CPAN

Object deletion is a bit messy, since it is not a Perl concept.  In
standard Perl, an object exists until all references to the object
cease to exist.  As a result, the programmer never has to worry about
stale references.  The situation changes when we introduce object
deletion: it is now possible for a variable to contain a reference
pointing to an object that has been deleted; likewise, an object can
contain a reference (technically an Oid) pointing to a deleted object.

The closest Perl analog is L<weak
references|Scalar::Util/"weaken_REF">.  The standard Perl rule stated
above -- "an object exists until all references to the object cease to
exist" -- does not apply to weak references.  A weak reference can go
stale (in other words, point to an object that no longer exists). When
this happens, Perl sets the reference to undef, and any attempt to
access the object via the stale reference generates an error.

We adopt similar semantics for object deletion.  We do not convert
stale references to undef (would require delving into Perl internals
-- doable but not worth the effort), but we detect attempts to invoke
methods on deleted objects and 'confess' with appropriate error

lib/Class/AutoDB/Serialize.pm  view on Meta::CPAN

package Class::AutoDB::Serialize;

use vars qw(@ISA @AUTO_ATTRIBUTES @OTHER_ATTRIBUTES %SYNONYMS);
use strict;
use Class::AutoClass;
use Class::AutoDB::Globals;
use Class::AutoDB::Oid;
use DBI;
use Carp;
#use Scalar::Util qw(weaken);
use Scalar::Util qw(refaddr);
use Class::AutoDB::Dumper;
@ISA = qw(Class::AutoClass); # AutoClass must be first!!
@OTHER_ATTRIBUTES=qw(oid dbh);
Class::AutoClass::declare(__PACKAGE__);

my $DUMPER=new Class::AutoDB::Dumper([undef],['thaw']) ->
  Purity(1)->Indent(1)->
  Freezer('DUMPER_freeze')->Toaster('DUMPER_thaw');

lib/Class/AutoDB/Serialize.pm  view on Meta::CPAN

    #              of Serialize subclass. here, we only want true case if arg
    #              __object__ whose class is Serialize subclass
    if (UNIVERSAL::isa(ref $value,__PACKAGE__)) {
      $copy->{$key}=$value->DUMPER_freeze;
    } else {
      $copy->{$key}=$value;
    }
  }
  my $freeze=$DUMPER->Values([$copy])->Dump;
  really_store($self,$freeze);
  #  TODO: weaken($OID2OBJ->{$oid});
  $self;
}
sub fetch {			# allow call as object or class method, or function
  shift if $_[0] eq __PACKAGE__ || UNIVERSAL::isa($_[0],__PACKAGE__);
  my($oid)=@_;
  # three cases: (1) new oid, (2) Oid exists, (3) real object exists
  my $obj=$OID2OBJ->{$oid};
  if (!defined $obj) {		                                # case 1
    # NG 10-08-24: really_fetch never returns undef
    # $obj=really_fetch($oid) || return undef;
    $obj=really_fetch($oid);
    $OID2OBJ->{$oid}=$obj;
    $OBJ2OID->{refaddr $obj}=$oid;
#   weaken($OID2OBJ->{$oid});
  } elsif (UNIVERSAL::isa($obj,'Class::AutoDB::Oid')) { # case 2
    # NG 10-08-24: really_fetch never returns undef
    # $obj=really_fetch($oid,$obj) || return undef;
    $obj=really_fetch($oid,$obj);
# }		                        # case 3 -- nothing more to do
# NG 10-08-26: case now calls really_fetch to handle deleted objects. shouldn't hurt performance
#              too much, if at all, since I don't think this case arises in practice...  
  } else {
    $obj=really_fetch($oid,$obj);
  }

lib/Class/AutoDB/Serialize.pm  view on Meta::CPAN

  my $obj=$OID2OBJ->{$oid};
  # NG 10-09-13: yet another place where testing object messes up on Oid or OidDeleted
  #              'cuz 'bool' overloaded...
  my $ref=ref $obj;
  if (!$ref) {		                                # case 1
    # NG 10-08-24: really_thaw never returns undef
    # $obj=really_thaw($oid,$obj,$freeze) || return undef;
    $obj=really_thaw($oid,$obj,$freeze);
    $OID2OBJ->{$oid}=$obj;
    $OBJ2OID->{refaddr $obj}=$oid;
#   weaken($OID2OBJ->{$oid});
  } elsif ('Class::AutoDB::Oid' eq $ref) { # case 2
    # NG 10-08-24: really_thaw never returns undef
    # $obj=really_thaw($oid,$obj,$freeze) || return undef;
    $obj=really_thaw($oid,$obj,$freeze);
  }			                   # else case 3 or 4 -- nothing more to do
  $obj;
}
# returns number of objects deleted (0 or 1)
sub del {			# allow call as object or class method, or function
  shift if $_[0] eq __PACKAGE__ || UNIVERSAL::isa($_[0],__PACKAGE__);

lib/Class/AutoDB/ppport.h  view on Meta::CPAN

sv_pvutf8n_force||5.006000|
sv_pvutf8n||5.006000|
sv_pvutf8||5.006000|
sv_pv||5.006000|
sv_recode_to_utf8||5.007003|
sv_reftype|||
sv_release_COW|||
sv_replace|||
sv_report_used|||
sv_reset|||
sv_rvweaken||5.006000|
sv_setiv_mg|5.004050||p
sv_setiv|||
sv_setnv_mg|5.006000||p
sv_setnv|||
sv_setpv_mg|5.004050||p
sv_setpvf_mg_nocontext|||pvn
sv_setpvf_mg|5.006000|5.004000|pv
sv_setpvf_nocontext|||vn
sv_setpvf||5.004000|v
sv_setpviv_mg||5.008001|