UMMF::Export::Perl::Tangram::Storage - Tangram Storage bridge for UMMF generated Perl code.

  use UMMF::Export::Perl::Tangram::Storage;

  $cls->get('name' => 'foo');
  $cls->get_or_new('name' => 'foo');
  $cls->get_or_error('name' => 'foo');
  $obj->__storage_insert();
  $obj->__storage_erase();
  $obj->__storage_update();

    $storage->flush_get_cache(@cls);

    $storage->flush_get_cache();

    $storage->flush_cache();

    my ($dsn, $user, $pass) = $storage->connect_opts();

    $storage->set_dbh($dbh);

    my $dbh = $storage->dbh();

    $self->insert(@objs);

    $self->update(@objs);

    $self->update_or_insert(@objs);

    $self->erase(@objs);

    my @objs = $self->load(@ids);

    my $id = $self->id($obj);
    my @ids = $self->id(@objs);

    my $cls_expr = $self->class($cls);

    my @objs = $self->select($cls_expr, $filter, @opts);

    my $cursor = $self->cursor($cls_expr, $filter, @opts);

    my $count = $self->count($filter, @opts);

    my $sum = $storage->sum($expr, $filter);
    my @sums = $storage->sum([$expr1, $expr2], $filter);

  my $result = $self->run_in_transaction($proc, @args);

    $storage->disconnect();

    my $objs = $self->get_all($cls, \%keys);
    my @objs = $self->get_all($cls, \%keys);

    my $objs = $self->get_all($cls, \%keys);

    my $objs = $self->get_foce($cls, \%keys);

    my $objs = $self->get_foce($cls, \%keys);

    my $objs = $self->get_or_new($cls, \%keys, \%inits);

    my $hash = $cls->__storage_opts;

    sub conn_opt_callback
    {
      my ($opts, $storage_conn_id) = @_;
      $opts->{'db'} = 'blahblah';
      ...;
    }
    $cls->__storage_set_opts_callback(\&func);

    $cls->__storage_set_conn_id('some_connection_name');

    my $storage = $cls_or_obj->__storage();

    my $storage = $cls_or_obj->__storage_disconnect();

    $cls_or_obj->__storage_flush_cache();

    $obj->__storage_update();

    $obj->__storage->update($obj);

    $obj->__storage_update_or_insert();

    $obj->__storage->update_or_insert($obj);

    $obj->__storage_erase;

    $obj->__storage->erase($obj);

    $obj->__storage_insert();

    $obj->__storage->insert($obj);

    my @objs = $cls->get_all(%key);

    $cls->__storage->get_all($cls, \%key);

    my $obj = $cls->get(%key);

    my $obj = $cls->__storage->get($cls, \%key);

    my $obj = $cls->get_or_error(%key);

    my $obj = $cls->__storage->get_or_error($cls, \%key);

    my $obj = $cls->get_or_new(%key);

    my $obj = $cls->__storage->get_or_new($cls, \%key);

    my $obj = $cls->get_or_new(\%key, \%init);

    my $obj = $cls->__storage->get_or_init($cls, \%key, \%init);

    my $obj = $cls->get_force(%key);

    my $obj = $cls->__storage->get_force($cls, \%key);

package UMMF::Export::Perl::Tangram::Storage;

use warnings;
use strict;

our $AUTHOR = q{ kstephens@users.sourceforge.net 2004/03/29 };
our $VERSION = do { my @r = (q$Revision: 1.23 $ =~ /\d+/g); sprintf "%d." . "%03d" x $#r, @r };

#######################################################################

use base qw(UMMF::Core::Object);

#######################################################################

use UMMF::Export::Perl::Tangram::Schema;

use Tangram;
use Tangram::Core;
use Tangram::Storage;
use Tangram::Schema;
use Tangram::Relational;
use Tangram::mysql;
use DBI;
use Carp qw(confess croak);

#######################################################################


my %empty; # DO NOT MODIFY.

# Defaults for connection
my @opts_name = qw(dsn driver host port db user pass opts debug);
our %connect_opts;


#######################################################################


sub initialize
{
  my ($self) = @_;

  # Initialize connect defaults.
  for my $n ( @opts_name ) {
    $connect_opts{$n} ||= $ENV{'UMMF_STORAGE_' . uc($n)};
  }
  $connect_opts{'pass'}   ||= undef;
  $connect_opts{'opts'}   ||= '';

  # schema.pl generated by UMMF::Export::Perl::Tangram::Schema.
  $self->{'schema_hash_dir'} ||= $connect_opts{'schema_hash_dir'} || $ENV{'UMMF_STORAGE_SCHEMA_DIR'} || './gen/perl';
  $self->{'schema_hash_pkg'} ||= $connect_opts{'schema_hash_pkg'} || $ENV{'UMMF_STORAGE_SCHEMA'};
  $self->{'schema_hash_file'} = $self->{'schema_hash_pkg'};
  if ( $self->{'schema_hash_pkg'} =~ '::' ) {
    $self->{'schema_hash_file'} =~ s@::@/@sg;
    $self->{'schema_hash_file'} = "$self->{schema_hash_dir}/$self->{schema_hash_file}.pm";
    $self->{'schema_var'} = '$schema';
  } else {
    $self->{'schema_hash_pkg'} = undef;
    $self->{'schema_var'} = '$main::schema';
  }
  
  
  # Initalize state.
  $self->{'cache'} = { };
  $self->{'schema'} = undef;
  $self->{'storage'} = undef;

  # Debugging.
  $self->{'debug'} = $connect_opts{'debug'}
    if defined $connect_opts{'debug'};
  $self->{'debug'} = $ENV{'UMMF_STORAGE_DEBUG'} || 0
    unless defined $self->{'debug'};

  print STDERR "pid $$: New $self$$\n" if $self->{'debug'};

  $self;
}

sub flush_get_cache
{
  my ($self, @cls) = @_;

  if ( @cls ) {
    for my $cls ( @cls ) {
      delete $self->{'cache'}{ref($cls) || $cls};
    }
  } else {
    $self->{'cache'} = { };
  }

  $self;
}

#'emacs
sub flush_cache
{
  my ($self, @cls) = @_;

  $self->flush_get_cache(@cls);

  my $storage = $self->{'storage'};
  if ( $storage ) {
    # $DB::single = 1;

    # Get a list of all objects to disassemble,
    # i.e. objects that may be pinned down by references
    # in the storage cache.
    my @objects = grep($_, values %{$storage->{objects}});

    # Unload the objects from the Tangram::Storage.
    $storage->unload;

    # Disassemble them, if possible.
    # print STDERR "Disassembling " . scalar @objects . " objects\n";

    for my $obj ( @objects ) {
      untie(%$obj);

      $obj->__ummf_disassemble()
	if UNIVERSAL::can($obj, '__ummf_disassemble');
    }

    # print STDERR "Done.\n";
  }

  $self;
}


#######################################################################
# DBD object accessor.
#

sub connect_opts
{
  my ($self) = @_;

  # Select defaults or specifics.
  my %opts = (
	      # Super defaults.
	      'driver' => 'mysql',
	      'host'   => 'localhost',
	      'db'     => 'test',
	      'opts'   => '',
	      'port'   => '',
	     );
  for my $n ( @opts_name ) {
    $opts{$n} = $connect_opts{$n}
      if $connect_opts{$n};
    $opts{$n} = $self->{$n}
      if defined $self->{$n};
  }

  # Compute dsn from common opts: host, db.
  $opts{'dsn'} ||= "dbi:{driver}:{host}{db}{port}{opts}";
  $opts{'dsn'} =~ s/{driver}/$opts{'driver'}                           /sge;
  $opts{'dsn'} =~ s/{host}/  $opts{'host'} ? "host=$opts{host};"   : ''/sge;
  $opts{'dsn'} =~ s/{port}/  $opts{'port'} ? "port=$opts{port};"   : ''/sge;
  $opts{'dsn'} =~ s/{db}/    $opts{'db'}   ? "database=$opts{db};" : ''/sge;
  $opts{'dsn'} =~ s/{opts}/  $opts{'opts'} ? "$opts{opts};"        : ''/sge;

  # Return connection parameters for 
  # use with Tangram::Storage->connect() and DBI->connect().
  my @connect_opts =
  (
   $opts{'dsn'},
   $opts{'user'},
   $opts{'pass'},
  );

  if ( $self->{'debug'} ) {
    local $" = ' ';
    no warnings;
    print STDERR "pid $$: Storage: DSN: @connect_opts\n";
    # exit 1;
  }
  
  @connect_opts;
}

sub set_dbh
{
  my ($self, $dbh) = @_;

  my $x = \$self->{'dbh'};
  no warnings;

  if ( $$x ne $dbh ) {
    if ( $$x ) {
      $$x->disconnect if $self->{'dbh_owned'} = 1;
      $$x = undef;
    }
    $$x = $dbh;
  }
  $self->{'dbh_owned'} = 0;

  $self;
}

sub dbh
{
  my ($self) = @_;

  my $x = \$self->{'dbh'};
  unless ( $$x ) {
    my @opts = $self->connect_opts;
    # DBI->trace(1);
    $$x = DBI->connect(@opts) 
      || confess("Cannot connect to db $opts[0] $opts[1]: $!");
    $self->{'dbh_owned'} = 1;

    # $DB::single = 1;
  }

  $$x;
}


#######################################################################
# Tangram::Schema object accessor.
#


my %use;
my %schema_hash_cache;
sub schema_hash_cached
{
  my ($self) = @_;

  my $x = \$schema_hash_cache{$self->{'schema_hash_pkg'} || $self->{'schema_hash_file'}};
  unless ( $$x ) {
    print STDERR "pid $$: Loading $self->{schema_hash_pkg}\n" if $self->{'debug'};

    if ( $self->{'schema_hash_pkg'} ) {
      unless ( $use{$self->{'schema_hash_pkg'}} ++ ) {
	eval('use ' . $self->{'schema_hash_pkg'} . ';');
	# $DB::single = 1 if $@;
	confess($@) if $@;
      }

      $$x = $self->{'schema_hash_pkg'}->tangram_schema_hash() ||
	confess("no \$main::schema defined by $self->{schema_hash_pkg}");
    } else {
      # This should not be used anymore.
      # Force reload by not allowing updates to %INC.
      $main::schema = undef;

      # Save %INC.
      my %INC_ = %INC;

      require $self->{'schema_hash_file'};

      # Restore %INC.
      %INC = %INC_;
      
      $$x = $main::schema || 
	confess("no \$main::schema defined by $self->{schema_hash_file}");
    
      $main::schema = undef;
    }
    
    my $s = $$x;
    # Find all the required classes.

    # Tangram types.
    my @type = values %{$s->{'.ummf'}{'TYPES'}};
    @type = map(ref($_) ? $_->[1] : $_, @type);

    # Problem-domain classes.
    my @cls = keys %{$s->{'classes'}};

    # Make them all unique.
    my @use = (@type, @cls);
    my %use = map(($_ => $_), @use);

    # Filter out naughty types.
    delete $use{'Tangram::IntrHash'};
    delete $use{'Tangram::IntrRef'};

    @use = sort grep($_, values %use);
    
    # Use them all.
    my $expr = join("\n", map(qq{use $_;}, @use));
    # print STDERR "$expr\n";
    eval $expr;
    die("In:\n$expr\n$@") if $@;
  }

  $$x;
}


sub schema_hash
{
  my ($self) = @_;

  my $x = \$self->{'schema_hash'};
  unless ( $$x ) {
    # Load schema hash from schema_hash_file.
    # $DB::single = 1;
    $$x = $self->schema_hash_cached();
    # $DB::single = 1;
  }

  $$x;
}


my %schema_cache;
sub schema_cached
{
  my ($self) = @_;

  my $x = \$schema_cache{$self->{'schema_hash_pkg'} || $self->{'schema_hash_file'}};
  unless ( $$x ) {
    my $schema_hash = $self->schema_hash;
    my $dbh = $self->dbh;
    my $do;

    # $DB::single = 1;

    # Load/store class ids in DB!
    my $s = UMMF::Export::Perl::Tangram::Schema->new();
    $s->manage_class_ids(
		       $schema_hash,
		       $do,
		       $dbh,
		      );
    # $DB::single = 1;

    eval {
      $$x = Tangram::Schema->new($schema_hash, 
				 #$self->dbh # future class/id mapping table.
				);
      print STDERR "pid $$: Created Tangram::Schema from $self->{schema_hash_pkg} : $$x\n" if $self->{'debug'};
      # $DB::single = 1;
    };
    if ( $@ ) {
      $DB::single = 1;
      confess($@);
    }
  }

  $$x;
}



sub schema
{
  my ($self) = @_;

  my $x = \$self->{'schema'};
  unless ( $$x ) {
    $$x = $self->schema_cached();
  }

  $$x;
}


#######################################################################
# Tangram::Storage object accessor.
#


sub storage
{
  my ($self) = @_;

  my $x = \$self->{'storage'};
  unless ( $$x ) {
    # $DB::single = 1;

    eval {
      my ($dsn, $user, $pass) = $self->connect_opts();
      my $class;
      $class = 'Tangram::mysql' if $dsn =~ /:mysql/;
      $class ||= 'Tangram::Relational';
      $$x = $class->connect($self->schema,
			    $dsn, $user, $pass,
			    {
			     'dbh' => $self->dbh,
			    }
			   );
      
      print STDERR "pid $$: Created Tangram::Storage: $$x\n" if $self->{'debug'};
    };
    if ( $@ ) {
      confess($@);
    }
  }

  $$x;
}


#######################################################################

sub insert
{
  my ($self, @obj) = @_;

  local $Tangram::TRACE = \*STDERR
    if $self->{'debug'};

  $self->flush_get_cache(@obj) if @obj;

  $self->storage->insert(@obj);
}

sub update
{
  my ($self, @obj) = @_;

  local $Tangram::TRACE = \*STDERR
    if $self->{'debug'};

  $self->flush_get_cache(@obj) if @obj;

  $self->storage->update(@obj);
}

sub update_or_insert
{
  my ($self, @obj) = @_;

  my $storage = $self->storage;
  for my $obj ( @obj ) {
    # $DB::single = 1;

    if ( $storage->id($obj) ) {
      $self->update($obj);
    } else {
      $self->insert($obj);
    }
  }

  $self;
}

sub erase
{
  my ($self, @obj) = @_;

  local $Tangram::TRACE = \*STDERR
    if $self->{'debug'};

  $self->flush_get_cache(@obj) if @obj;

  $self->storage->erase(@obj);
}

sub load
{
  my ($self, @id) = @_;

  local $Tangram::TRACE = \*STDERR
    if $self->{'debug'};

  $self->storage->load(@id);
}

sub id
{
  my ($self, @obj) = @_;

  $self->storage->id(@obj);
}

sub class
{
  my ($self, @cls) = @_;

  # $DB::single = 1;
  $self->storage->remote(@cls);
}

sub select
{
  my ($self, @args) = @_;

  local $Tangram::TRACE = \*STDERR
    if $self->{'debug'};

  $self->storage->select(@args);
}

sub cursor
{
  my ($self, @args) = @_;

  local $Tangram::TRACE = \*STDERR
    if $self->{'debug'};

  $self->storage->cursor(@args);
}

sub count
{
  my ($self, @args) = @_;

  local $Tangram::TRACE = \*STDERR
    if $self->{'debug'};

  $self->storage->count(@args);
}

sub sum
{
  my ($self, @args) = @_;

  local $Tangram::TRACE = \*STDERR
    if $self->{'debug'};

  $self->storage->sum(@args);
}


#######################################################################

sub run_in_transaction
{
  my ($self, $proc, @args) = @_;

  # $DB::single = 1;

  my $dbh = $self->dbh || die("Cannot get dbh");
  #DBI->trace(1);
  #local $dbh->{TraceLevel} = "1|SQL";

  my $result;

  # Turn of AutoCommit (enable transaction commit/rollback).
  # my $AutoCommit_save = $dbh->{AutoCommit};
  # $dbh->{AutoCommit} = 0;
  # croaks with Transactions not supported by database:
  # possibly old version of libmysql.a?!?!?
  my $sql;
  eval {
    #$DB::single = 1;
    # Begin transaction.
    if ( ! $self->{'in_transaction'} ++ ) {
      #$DB::single = 1;
      $dbh->do($sql = 'BEGIN') || die("Cannot $sql: " . $dbh->errstr);
    }

    # Execute insert/update procedure.
    $result = $proc->(@args);

    # Check for untrapped DBI error that did not do a die().
    die("Unexpected DBI::errstr: " . $dbh->errstr) if $dbh->errstr;
  };
  # Save exception.
  my $exc = $@;
  if ( $exc ) {
    # Rollback transaction!
    #$dbh->rollback() || croak("Could not rollback transaction: " . $dbh->errstr);
    if ( ! -- $self->{'in_transaction'} ) {
      $DB::single = 1;
      $dbh->do($sql = 'ROLLBACK') || die("Cannot $sql: " . $dbh->errstr);
    }

    # Rethrow exception.
    croak($exc);
  } else {
    # Ok, commit transaction.

    # Commit
    #$dbh->commit() || croak("Could not commit transaction: " . $dbh->errstr);
    if ( ! -- $self->{'in_transaction'} ) {
      # $DB::single = 1;
      $dbh->do($sql = 'COMMIT') || die("Cannot $sql: " . $dbh->errstr);
    }
  }

  $result;
}


#######################################################################

sub disconnect
{
  my ($self) = @_;

  # $DB::single = 1;
  $self->flush_cache;

  my $x = \$self->{'storage'};
  if ( $$x ) {
    $$x->disconnect();
    $$x = undef;
  }

  $x = \$self->{'dbh'};
  if ( $$x && $self->{'dbh_owned'} ) {
    $$x->disconnect();
    $$x = undef;
  }

  $self->{'schema_hash'} = undef;
  $self->{'schema'} = undef;

  $self;
}

sub DESTROY
{
  my ($self) = @_;

  $self->disconnect;
}


#######################################################################
# Interface to meta-object layer.
#

sub get_all
{
  my ($self, $cls, $keys) = @_;

  $self->_get_all($cls, $keys);
}

sub get
{
  my ($self, $cls, $keys) = @_;

  my $objs = $self->_get_all($cls, $keys);

  if ( @$objs > 1 ) {
    my @keys = %$keys;
    local $" = ' ';
    confess("Non-unique get $cls with @keys, found " . @$objs);
  }

  $objs->[0];
}

sub get_force
{
  my ($self, $cls, $keys) = @_;

  my $objs = $self->_lookup_storage($cls, $keys, 2);

  if ( @$objs > 1 ) {
    local $" = ' ';
    die("Non-unique get $cls with @{%$keys}, found " . @$objs);
  }

  $objs->[0];
}

sub get_or_error
{
  my ($self, $cls, $keys) = @_;

  my $obj;
  unless ( $obj = $self->get($cls, $keys) ) {
    local $" = ' ';
    my @keys = %$keys;
    $DB::single = 1;
    die("Cannot get $cls with @keys");
  }

  $obj;
}

sub get_or_new
{
  my ($self, $cls, $keys, $inits) = @_;

  # Lookup in cache.
  my ($cachep, $cache) = $self->_lookup($cls, $keys);
  my $obj0 = $cache && $cache->[0];

  # $DB::single = 1;

  # If no object exists, install a new one.
  my $install_cache;
  unless ( $obj0 ) {
    # Create new object.
    $obj0 = $cls->new(%$keys, %{$inits || \%empty});

    if ( 1 ) {
      my @keys = %$keys;
      # local $" = ' ';
      # print STDERR "$self get_or_new $cls(@keys) => new $obj0\n";
    }

    # Schedule object for storage.
    $self->_insert_storage($obj0);

    # Force installation of new object in cache.
    $install_cache = 1;
  }

  # No cache entry or force cache install?
  if ( $install_cache || ! $$cachep ) {
    # Make a new main cache entry.
    $self->_install_cache($cls, $keys, $cachep, [ $obj0 ]);
  }

  # Return found or new object.
  $obj0;
}



sub _get_all
{
  my ($self, $cls, $keys) = @_;

  no warnings;

  # Lookup in cache.
  my ($cachep, $cache) = $self->_lookup($cls, $keys);
  my $obj0 = $cache && $cache->[0];

  # No cache entry?
  unless ( $$cachep ) {
    # Install results in cache.
    $self->_install_cache($cls, $keys, $cachep, $cache);
  }

  # Return results.
  wantarray ? @$cache : $cache;
}


sub _lookup
{
  my ($self, $cls, $keys) = @_;

  # Lookup in cache?
  my $cachep = $self->_lookup_cache($cls, $keys);
  my $cache = $$cachep;

  # Nothing in cache?
  unless ( $cache ) {
    # Lookup in storage.
    $cache = $self->_lookup_storage($cls, $keys);
  }

  # $DB::single = 1;

  # Return cache pointer and cache value.
  ($cachep, $cache);
}


sub _lookup_cache
{
  my ($self, $cls, $keys) = @_;

  no warnings; # Use of uninitialized value in join or string ...

  # $DB::single = 1;

  # Force $self to be class name.
  $cls = ref $cls || $cls;

  # Look up based on keys.
  my @key = sort keys %$keys;
  my $key = join("\0", @key);
  my $val = join("\0", map($keys->{$_}, @key));
  my $cachep = \$self->{'cache'}{$cls}{$key}{$val};

  $cachep;
}


sub _install_cache
{
  my ($self, $cls, $keys, $cachep, $objs) = @_;

  my $cc = $self->{'cache'}{$cls};

  # Add all objects to all keys entry.
  push(@$$cachep, @$objs);

  if ( keys %$keys > 1 ) {
    # Add to individual keys entry.
    for my $k ( keys %$keys ) {
      push(@{$cc->{$k}{$keys->{$k}} ||= [ ]}, @$objs);
    }
  }

  $self;
}


sub _lookup_storage
{
  my ($self, $cls, $keys, $count) = @_;

  my @obj;

  # Testing.
  # return wantarray ? @obj : \@obj;

  # local $self->{'debug'} = 1;

  local $Tangram::TRACE = \*STDERR
    if $self->{'debug'};

  # $DB::single = 1 if $self->{'debug'};

  # Create class object placeholder.
  my $cls_obj = $self->class($cls);

  # Build expression to search for all $cls where each
  # key/val is equal.
  my $expr;

  my ($key, $val);
  while ( ($key, $val) = each %$keys ) {
    my $e = $cls_obj->{$key} eq $val;
    $expr = defined $expr ? ($expr & $e) : $e; 
  }
  # Execute query.
  @obj = $self->select($cls_obj, $expr);

  # $DB::single = 1;

  wantarray ? @obj : \@obj;
}


sub _insert_storage
{
  my ($self, @obj) = @_;

  # print STDERR "$self _insert_storage(@obj)\n";

  local $Tangram::TRACE = \*STDERR
    if $self->{'debug'};

  # $DB::single = 1;
  $self->storage->insert(@obj);

  1;
}


#############################################################
# Interface to UML-generated code.
#

# FIX ME!!! UGLY!!!!
# This totally relys on that all generated code uses
# UML::__ObjectBase as a base class!
#
# This class should be used something like:
#
#    use UMMF::Export::Perl::Tangram::Storage qw(My::Crazy::Prefix::__ObjectBase)
#
# For use with code generated with
#
#    ummf -e Perl -p My::Crazy::Prefix ...
#
# Some kinda "sub import" that will evaluate the following code in the correct package.
#
# See UMMF::Export::Template::sub template_vars for commentary.
#   -- ks 2005/10/16
#

package UML::__ObjectBase;

# UMMF::Export::Perl::Tangram::Storage Instance.
our $storage;
our %storage_by_id;
our $storage_conn_id = '';


# Configuration.
our $storage_class ||= 'UMMF::Export::Perl::Tangram::Storage';
our %storage_opts;
our $storage_opts_callback;


# Storage object accessors.

sub __storage_opts
{
  # Do the callback, if defined.
  my $opts = $storage_opts{$storage_conn_id} ||= { };
  if ( $storage_opts_callback ) {
    $storage_opts_callback->($opts, $storage_conn_id);
  }
  $opts;
}

sub __storage_set_opts_callback
{
  my ($self, $x) = @_;

  $storage_opts_callback = $x;
}

sub __storage_set_conn_id
{
  my ($self, $id) = @_;

  my $x = $storage_conn_id;

  $storage_conn_id = $id;
  $storage = undef; # Force look up by new $storage_conn_id in __storage() below
  $x;
}

sub __storage
{
  $storage ||= $storage_by_id{$storage_conn_id}
           ||= $storage_class->new(%{__storage_opts()}); 
}

sub __storage_disconnect
{
  if ( $storage ) {
    $storage->disconnect;
  }

  # Clear out the storage config opts
  if ( $storage_opts_callback ) {
    # %storage_opts = ();
  }

  $storage = undef;
}

sub __storage_flush_cache
{
  if ( $storage ) {
    $storage->flush_cache;
  }
}

sub __storage_update
{
  my ($self) = @_;

  __storage->update($self);
}

sub __storage_update_or_insert
{
  my ($self) = @_;

  __storage->update_or_insert($self);
}

sub __storage_erase
{
  my ($self) = @_;

  __storage->erase($self);
}

sub __storage_insert
{
  my ($self) = @_;

  __storage->insert($self);
}

sub get_all
{
  my ($self, %key) = @_;

  __storage->get_all($self, \%key);
}

sub get
{
  my ($self, %key) = @_;

  __storage->get($self, \%key);
}

sub get_or_error
{
  my ($self, %key) = @_;

  __storage->get_or_error($self, \%key);
}

sub get_or_new
{
  my ($self, %key) = @_;

  __storage->get_or_new($self, \%key);
}

sub get_or_init
{
  my ($self, $keys, $inits) = @_;

  __storage->get_or_new($self, $keys, $inits);
}

sub get_force
{
  my ($self, %key) = @_;

  __storage->get_force($self, \%key);
}




# use Tangram::Expr;

# eval q{
# package Tangram::Expr;

# sub sum
# {
# 	my ($self, $val) = @_;

# $DB::single = 1;

# 	$self->{storage}
# 		->expr(Tangram::Integer->instance, "SUM($self->{expr})",
# 				$self->objects );
# }
# }; die($@) if $@;

#######################################################################

1;

#######################################################################


### Keep these comments at end of file: kstephens@users.sourceforge.net 2004/03/29 ###
### Local Variables: ###
### mode:perl ###
### perl-indent-level:2 ###
### perl-continued-statement-offset:0 ###
### perl-brace-offset:0 ###
### perl-label-offset:0 ###
### End: ###