File Coverage

blib/lib/Pixie/Store.pm

Criterion	Covered	Total	%
statement	105	106	99.0
branch	14	16	87.5
condition	2	2	100.0
subroutine	37	38	97.3
pod	9	25	36.0
total	167	187	89.3

=head1 NAME

Pixie::Store -- Factory & abstract base class for Pixie stores

=head1 SYNOPSIS

  # you should never have to use this class directly!

  use Pixie;
  Pixie->deploy( $dsn, %args );
  my $px = Pixie->connect( $dsn, %args );

=head1 DESCRIPTION

Pixie::Store provides Pixie with an abstract interface to the physical storage
used to actually store the objects that Pixie manages. It is not a 'public'
class; most Pixie users will never have to touch it.

However, if you want to add another storage medium to Pixie, start here. (If
you want to add specific methods for storing in a particular RDBMS, you should
take a look at L before diving into L and its
woefully underdocumented friends.

=cut

package Pixie::Store;

use strict;
use warnings;

use Carp qw( confess );
use Scalar::Util qw( weaken );

use Pixie::Name;
use Pixie::ObjectGraph;
use Pixie::FinalMethods;

use base qw( Pixie::Object );

our $VERSION = "2.08_02";
our %typemap = ( memory => 'Pixie::Store::Memory',
		 bdb    => 'Pixie::Store::BerkeleyDB',
		 dbi    => 'Pixie::Store::DBI', );

#use overload
#  '""' => 'as_string';

#------------------------------------------------------------------------------
# Class methods

sub deploy {
  my $class = shift;
  return $class->subclass_responsibility( @_ ) if ref( $class );
  return $class->_deploy( @_ );
}

sub connect {
  my $class = shift;
  return $class->subclass_responsibility( @_ ) if ref( $class );
  return $class->_connect( @_ );
}

sub _deploy {
  my $class = shift;
  my $spec  = shift;

  my ($type, $path) = $class->get_type_and_path( $spec );
  my $type_class    = $class->load_store_type( $type );

  return $type_class->deploy( $path, @_ );
}

sub _connect {
  my $class = shift;
  my $spec  = shift;

  my ($type, $path) = $class->get_type_and_path( $spec );
  my $type_class    = $class->load_store_type( $type );

  my $self = $type_class->connect( $path, @_ );
  $self->{spec} = $spec;	# TODO: use accessor for this

  return $self;
}

sub get_type_and_path {
  my $class = shift;
  my $spec  = shift;
  return split(':', $spec, 2);
}

sub load_store_type {
  my $class = shift;
  my $type  = shift;

  confess( "Invalid store type: '$type'" ) unless exists $typemap{$type};

  eval "require " . $typemap{$type};
  confess( "Error loading $typemap{$type}: $@" ) if $@;

  return $typemap{$type};
}

sub as_string {
  my $class = shift;
  my $str   = '';

  if (ref $class) {
    $str .= ref($class);
    $str .= ": $class->{spec}" if $class->{spec};
  } else {
    $str .= $class;
  }

  return $str;
}


#------------------------------------------------------------------------------
# Instance methods

sub clear               { $_[0]->subclass_responsibility(@_) }
sub store_at            { $_[0]->subclass_responsibility(@_) }
sub get_object_at       { $_[0]->subclass_responsibility(@_) }
sub delete              { $_[0]->subclass_responsibility(@_) } # TODO: not used?
sub _delete             { $_[0]->subclass_responsibility(@_) }
sub remove              { $_[0]->subclass_responsibility(@_) } # TODO: not used?
sub rootset             { $_[0]->subclass_responsibility(@_) }
sub _add_to_rootset     { $_[0]->subclass_responsibility(@_) }
sub remove_from_rootset { $_[0]->subclass_responsibility(@_) }
sub lock                { $_[0]->subclass_responsibility(@_) }
sub unlock              { $_[0]->subclass_responsibility(@_) }
sub rollback            { $_[0]->subclass_responsibility(@_) }

## TODO: use a name that's impossible for others to trample over
##       best idea is to move this into Pixie::Name->object_graph
sub object_graph_for {
  my $self  = shift;
  my $pixie = shift;

  my $graph = $pixie->get_object_named('PIXIE::Node Graph');
  unless ($graph) {
    $graph = Pixie::ObjectGraph->new;
    $pixie->bind_name('PIXIE::Node Graph' => $graph);
  }

  return $graph;
}

sub remove_from_store {
  my $self = shift;
  my $oid  = shift;

  $self->remove_from_rootset($oid)
       ->_delete($oid);
}

# Low level locking
# $locker is usually a Pixie

sub locked_set {
    my $self = shift;
    return $self->{locked_set} ||= {};
}

sub lock_object_for {
    my $self = shift;
    my($oid, $locker) = @_;
    $self->locked_set->{ $oid } = $locker->_oid;
    return 1;
}

sub unlock_object_for {
    my $self = shift;
    my $oid  = shift;
    delete $self->locked_set->{$oid};
}

sub release_all_locks {
    my $self = shift;
    my $locked_set = $self->locked_set;
    $self->unlock_object_for(@$_)
        for map {[$_ => $locked_set->{$_}]}
            keys %$locked_set;
    return $self;
}

sub add_to_rootset {
  my $self  = shift;
  my $thing = shift;
  # TODO: get the oid out here?
  $self->_add_to_rootset($thing) unless $self->is_hidden($thing);
}

## TODO: use names that are impossible for others to trample over
##       best idea is to move this into Pixie::Name
sub is_hidden {
  my $self  = shift;
  my $thing = shift;
  $thing->PIXIE::oid =~ /^
}

sub lock_for_GC {
  my $self = shift;
  $self->lock;
}

sub unlock_after_GC {
  my $self = shift;
  $self->unlock;
}

sub DESTROY {
    my $self = shift;
    $self->release_all_locks;
}

1;

__END__