diff --git a/lang/perl/CMakeLists.txt b/lang/perl/CMakeLists.txt index b061cf1..23960fb 100644 --- a/lang/perl/CMakeLists.txt +++ b/lang/perl/CMakeLists.txt @@ -11,3 +11,6 @@ CREATE_CHECK_PERL(t/01-boostrap.t) CREATE_CHECK_PERL_OPT(t/02-hash.t ${CMAKE_CURRENT_SOURCE_DIR}/t/02-hash.script) CREATE_CHECK_PERL(t/03-hash-iterator.t) CREATE_CHECK_PERL(t/04-hash-in-hash.t) +CREATE_CHECK_PERL(t/05-autoxacts.t) +CREATE_CHECK_PERL(t/06-open.t) +CREATE_CHECK_PERL(t/07-hash-in-autohash.t) diff --git a/lang/perl/Stasis.pm b/lang/perl/Stasis.pm index 064bef8..7b8f72b 100644 --- a/lang/perl/Stasis.pm +++ b/lang/perl/Stasis.pm @@ -5,31 +5,28 @@ use strict; use warnings; my $STASIS_DIR; -BEGIN { - $STASIS_DIR = $INC{"Stasis.pm"}; - $STASIS_DIR =~ s~/+lang/+perl/+Stasis.pm~~g; - $STASIS_DIR =~ s~/+lang/+perl/+apache/+Stasis.pm~~g; - 1; -} +my $initted = 0; sub import { + my $modname = shift; my $inline_dir = shift; require Inline; - Inline->import (C => Config => (LIBS => - "-L$STASIS_DIR/build/src/stasis/ " . - "-lstasis -lpthread", - CCFLAGS => "-Wall -pedantic -Werror -std=c99 -DPERL_GCC_PEDANTIC" - ), - ENABLE => 'AUTOWRAP', - TYPEMAPS => "$STASIS_DIR/lang/perl/typemap", - PREFIX => 'stasis_perl_', - DIRECTORY => $ENV{STASIS_INLINE_DIRECTORY}); - - Inline->import (C => 'DATA', - INC => "-I $STASIS_DIR -I $STASIS_DIR/build/"); + + $STASIS_DIR = $INC{"Stasis.pm"}; + $STASIS_DIR =~ s~/+lang/+perl/+Stasis.pm~~g; + 1; + Inline->import (C => 'DATA' => + LIBS => "-L$STASIS_DIR/build/src/stasis/ " . + "-lstasis -lpthread", + CCFLAGS => "-Wall -pedantic -Werror -std=c99 -DPERL_GCC_PEDANTIC", + INC => "-I $STASIS_DIR -I $STASIS_DIR/build/", + ENABLE => 'AUTOWRAP', + TYPEMAPS => "$STASIS_DIR/lang/perl/typemap", + PREFIX => 'stasis_perl_', + DIRECTORY => $inline_dir ||$ENV{STASIS_INLINE_DIRECTORY} + ); Inline->init; - } sub version { return "Stasis 0.1"; @@ -40,6 +37,39 @@ sub ThashCreate { my $rid = ThashCreateHelper($xid); return bless $rid, 'Stasis::HashHeader'; } +sub Tinit { + $initted && die "Called Tinit() when Stasis was initted!\n"; + $initted = 1; + return TinitHelper(); +} +sub Tdeinit { + $initted || die "Called Tdeinit() when Stasis was not initted!\n"; + $initted = 0; + return TdeinitHelper(); + +} +sub TbootstrapHash { + my $xid = Tbegin(); + my $rid = ROOT_RID(); + if(TrecordType($xid, $rid) == INVALID_SLOT()) { + $rid = Stasis::ThashCreate($xid); + } + Tcommit($xid); + return $rid; +} + +sub open { + my $h = shift; + $initted || Tinit(); + tie %$h, 'Stasis::Hash'; +} +END { + if($initted) { + print STDERR "Cleanly shutting Stasis down..."; $| = 1; + Tdeinit(); + print STDERR "done.\n"; + } +} package Stasis::Hash; require Scalar::Util; @@ -50,8 +80,11 @@ our @ISA = qw(Tie::Hash); sub TIEHASH { my $class = shift; - my $xid = shift; - my $rid = shift; + my $xid = shift ; + my $rid = shift || Stasis::ROOT_RID(); + if(!defined($xid)) { + $xid = -1; + } defined ($xid) || die "need xid to tie hash"; defined ($rid) || die "need rid to tie hash"; @@ -59,16 +92,46 @@ sub TIEHASH { xid => $xid, rid => $rid, }; + if($xid == -1) { + $this->{autoxact} = 1; + $this->{rid} = Stasis::TbootstrapHash(); + $this->{xid} = Stasis::Tbegin(); + } + return bless $this, $class; } + +sub getXid { + my $this = shift; + my $ret = $$this{xid}; + defined $ret || ($ret = ${$$this{root}}{xid}); + #warn "$ret ($$this{xid}) ($$this{root})\n"; + return $ret; +} + +sub setRoot { + my $this = shift; + my $root = shift; + + #warn "setting root\n"; + $$this{xid} = undef; + $$this{autoxact} = 1; + $$this{root} = ($$root{root} || $root); + #warn $$this{root}; # = ($$this{root} || $this); + #warn $this->getXid(); + +} + sub FETCH { my $this = shift; my $key = shift; - my $sv = Stasis::ThashLookup($$this{xid}, $$this{rid}, $key); + my $xid = $this->getXid(); + my $sv = Stasis::ThashLookup($xid, $$this{rid}, $key); if(Scalar::Util::blessed($sv)) { if($sv->isa('Stasis::HashHeader')) { my %h; - tie(%h, 'Stasis::Hash', $$this{xid}, $sv); + tie(%h, 'Stasis::Hash', $xid, $sv); + tied(%h)->setRoot($this); return \%h; } else { die 'ThashLookup returned an object of unknown type'; @@ -81,11 +144,12 @@ sub STORE { my $this = shift; my $key = shift; my $val = shift; + my $xid = $this->getXid(); if('HASH' eq ref($val)) { if(Scalar::Util::blessed($val) && $val->isa('Stasis::Hash')) { die "untested?"; my $obj = tied ($val); # tied returns the object backing the hash. - Stasis::ThashInsert($$this{xid}, $$this{rid}, $key, $$obj{rid}); + Stasis::ThashInsert($xid, $$this{rid}, $key, $$obj{rid}); die "untested?"; } else { # Copy the hash into scratch space @@ -95,8 +159,8 @@ sub STORE { } # Tie the hash that was passed to us - my $rid = Stasis::ThashCreate($$this{xid}); - tie %$val, 'Stasis::Hash', $$this{xid}, $rid; + my $rid = Stasis::ThashCreate($xid); + tie %$val, 'Stasis::Hash', $xid, $rid; # Copy the scratch space into the tied hash. foreach my $k (keys %h) { @@ -104,48 +168,71 @@ sub STORE { } # Insert the populated hashtable - Stasis::ThashInsert($$this{xid}, $$this{rid}, $key, $rid); + Stasis::ThashInsert($xid, $$this{rid}, $key, $rid); + if($$this{autoxact}) { + tied(%$val)->setRoot($this); + } } } else { # XXX assumes the value is a scalar. - Stasis::ThashInsert($$this{xid}, $$this{rid}, $key, $val); + Stasis::ThashInsert($xid, $$this{rid}, $key, $val); } } sub DELETE { my $this = shift; my $key = shift; + my $xid = $this->getXid(); # This will leak hashes that were automatically created. Refcounts? - return Stasis::ThashRemove($$this{xid}, $$this{rid}, $key); + return Stasis::ThashRemove($xid, $$this{rid}, $key); } sub FIRSTKEY { my $this = shift; - $$this{it} = Stasis::ThashIterator($$this{xid}, $$this{rid}); - if(Stasis::Titerator_next($$this{xid}, $$this{it})) { - return Stasis::Titerator_key($$this{xid}, $$this{it}); + my $xid = $this->getXid(); + $$this{it} = Stasis::ThashIterator($xid, $$this{rid}); + if(Stasis::Titerator_next($xid, $$this{it})) { + return Stasis::Titerator_key($xid, $$this{it}); } else { - Stasis::Titerator_close($$this{xid}, $$this{it}); + Stasis::Titerator_close($xid, $$this{it}); return; } } sub NEXTKEY { my $this = shift; my $lastkey = shift; - Stasis::Titerator_tupleDone($$this{xid}, $$this{it}); - if(Stasis::Titerator_next($$this{xid}, $$this{it})) { - return Stasis::Titerator_key($$this{xid}, $$this{it}); + my $xid = $this->getXid(); + Stasis::Titerator_tupleDone($xid, $$this{it}); + if(Stasis::Titerator_next($xid, $$this{it})) { + return Stasis::Titerator_key($xid, $$this{it}); } else { - Stasis::Titerator_close($$this{xid}, $$this{it}); + Stasis::Titerator_close($xid, $$this{it}); return; } } sub EXISTS { my $this = shift; my $key = shift; + warn "unimplemeted method 'EXISTS' called"; } sub CLEAR { my $this = shift; + warn "unimplemeted method 'CLEAR' called"; +} +sub commit { + my $this = shift; + $this->{autoxact} || die 'commit() called on non-auto hash'; + $this->{root} && die 'commit() called on non root'; + Stasis::Tcommit($this->{xid}); + $this->{xid} = Stasis::Tbegin(); +} +sub abort { + my $this = shift; + $this->{autoxact} || die 'abort() called on non-auto hash'; + $this->{root} && die 'abort() called on non root'; + Stasis::Tabort($this->{xid}); + $this->{xid} = Stasis::Tbegin(); } +package Stasis::Recordid; # Silence warning about "can't locate package Stasis::Recordid for @Stasis::HashHeader::ISA" package Stasis::HashHeader; our @ISA = qw(Stasis::Recordid); @@ -155,8 +242,12 @@ __DATA__ __C__ #include "stasis/transactional.h" -int Tinit(); -int Tdeinit(); +int TinitHelper() { + return Tinit(); +} +int TdeinitHelper() { + return Tdeinit(); +} int Tbegin(); int Tcommit(int xid); int TsoftCommit(int xid); @@ -428,3 +519,136 @@ SV* stasis_perl_NULL_RID() { int stasis_perl_INVALID_SLOT() { return INVALID_SLOT; } + + +__END__ + +=head1 NAME + +Stasis - Flexible transactional storage + +=head1 SYNOPSIS + + use Stasis; + + my %h; + + Stasis::open(\%h); + + $h{foo} = 'bar'; + + # Create an anonymous hash and insert it into h + + $h{bat}{bam} = 'boom'; + + tied(%h)->commit(); + + $h{bar} = 'bad update'; + + tied(%h)->abort(); + + defined $h{bar} && die; + +=head1 DESCRIPTION + +Stasis is a lightweight transactional storage library. This perl +module provides bindings for Stasis' C functions (Tinit(), +ThashInsert(), etc), and higher-level interfaces based upon tied perl +hashes. + +=head2 Programming Style + +The synopsis describes Stasis.pm's high level interface. Lower-level +interactions with Stasis are possible as well: + + use Stasis; + + Stasis::Tinit(); # Initialize Stasis + + Stasis::TbootstrapHash(); # Open or bootstrap a stasis database + + # Bootstrapping arranges for a hash to live in ROOT_RECORD + + my $rid = STASIS::ROOT_RECORD(); + + my $xid = Stasis::Tbegin(); # Start new transaction + + # Insert a value into the hash + Stasis::ThashInsert($xid, $rid, "foo", "bar"); + + # Lookup the value + my $bar = Stasis::ThashLookup($xid, $rid, "foo", "bar"); + + Stasis::Tcommit($xid); + + $xid = Stasis::Tbegin(); + + # This update will not be reflected after abort. + Stasis::ThashRemove($xid, $rid, "foo", "bar"); + + Stasis::Tabort($xid); + + #Deinitialize Stasis (Called automatically at shutdown if needed) + Stasis::Tdeinit(); + +Stasis supports a wide range of other data structures (including +arrays, records, large objects and trees), which are somewhat +supported by Stasis.pm. These bindings are a work in progress; +consult the source code for a list of currently implemented methods. + +Note that Stasis (and this module) are thread safe. However, Stasis +does not perform lock management. Refer to the Stasis documentation +for more information before attempting to make use of concurrent (even +if single threaded) transactions. + + +=head1 CAVEATS AND BUGS + +=head2 No garbage collection + +Nested hashes are not garbage collected. Therefore, the following +code leaks storage: + + my %h; + Stasis::open(\%h); + + $h{a}{b} = 1; # Automatically instantiates a hash. + delete $h{a}; # The automatically created hash is now unreachable. + + tied(%h)->commit(); # However, abort() would have reclaimed the space + +=head2 Small hash performance + +Stasis is currently tuned for small numbers of large hashes. +Its hashtable implementation would be more efficient if it included +special cases for small indexes, then dynamically switched to the +current layout for large data sets. + +=head2 No tied arrays + +Stasis provides an array type, but this module does not export them to +perl as tied arrays. Instead, it includes a partial (and untested) +set of C-style bindings. Support for push() and pop() should be +straightforward. However, Stasis' array implementation does not +currently provide anything analogous to shift() and unshift(). Like +the hashtables, Stasis' arrays are tuned for large data sets. + +=head2 Type safety / reflection + +Stasis records include a 'type' field that allows 'special' data to be +distinguished from 'normal' slots (eg: application data). Hashtables +do not use this feature, so it is possible to attempt to access +headers as scalar values. This will likely fail by crashing the +process. Similarly, the recordids returned by Stasis are blessed +arrays. Tampering with their contents, then attempting to dereference +them will likely lead to crashes and other trouble. These problems +should not affect "well-written" code. + +=head2 This documentation is incomplete + +See the source for a complete list of exported Stasis functions. + +=head2 This module is a work in progress + +Expect API instability. Also, note that many Stasis functions are not +yet exported to perl. diff --git a/lang/perl/apache/StasisWeb/Web.pm b/lang/perl/apache/StasisWeb/Web.pm index cccff37..81a7d59 100644 --- a/lang/perl/apache/StasisWeb/Web.pm +++ b/lang/perl/apache/StasisWeb/Web.pm @@ -15,19 +15,27 @@ sub handler { my $r = shift; $r->content_type('text/html'); print "