Perl updates:

- Cleaned up initialization and shutdown.
 - Add support for autocommitted hashes
 - Wrote preliminary perldocs
 - Updated sample cgi scripts. 
 - Added new (partial) wiki thing
 - Added stasis.pl (a simple toplevel)

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)

lang/perl/Stasis.pm

@@ -5,31 +5,28 @@ use strict;
 use warnings;
 
 my $STASIS_DIR;
-BEGIN {
+my $initted = 0;
-    $STASIS_DIR = $INC{"Stasis.pm"};
-    $STASIS_DIR =~ s~/+lang/+perl/+Stasis.pm~~g;
-    $STASIS_DIR =~ s~/+lang/+perl/+apache/+Stasis.pm~~g;
-    1;
-}
 
 sub import {
+    my $modname = shift;
     my $inline_dir = shift;
     require Inline;
-    Inline->import (C => Config => (LIBS =>
+    
-				   "-L$STASIS_DIR/build/src/stasis/ " .
+    $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"
+		    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 => $ENV{STASIS_INLINE_DIRECTORY});
+		    DIRECTORY => $inline_dir ||$ENV{STASIS_INLINE_DIRECTORY}
-
+	);
-    Inline->import (C => 'DATA',
-             INC  => "-I $STASIS_DIR -I $STASIS_DIR/build/");
-
     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;
@@ -51,7 +81,10 @@ our @ISA = qw(Tie::Hash);
 sub TIEHASH {
     my $class = shift;
     my $xid = shift ;
-    my $rid = 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});
+	    my $rid = Stasis::ThashCreate($xid);
-	    tie %$val, 'Stasis::Hash', $$this{xid}, $rid;
+	    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});
+    my $xid = $this->getXid();
-    if(Stasis::Titerator_next($$this{xid}, $$this{it})) {
+    $$this{it} = Stasis::ThashIterator($xid, $$this{rid});
-	return Stasis::Titerator_key($$this{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 NEXTKEY {
     my $this = shift;
     my $lastkey = shift;
-    Stasis::Titerator_tupleDone($$this{xid}, $$this{it});
+    my $xid = $this->getXid();
-    if(Stasis::Titerator_next($$this{xid}, $$this{it})) {
+    Stasis::Titerator_tupleDone($xid, $$this{it});
-	return Stasis::Titerator_key($$this{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 TinitHelper() {
-int Tdeinit();
+    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.

lang/perl/apache/StasisWeb/Web.pm

@@ -15,6 +15,12 @@ sub handler {
     my $r = shift;
     $r->content_type('text/html');
     print "<html><head></head><body><h1>Stasis</h1>" . `pwd`;
+
+    my $output;
+
+    ## XXX This lock acts like a no-op; modapache seems to break perl
+    ## threads.
+    { lock($thelock);
       my $xid = Stasis::Tbegin();
       warn "a\n";
       my %h;
@@ -22,12 +28,14 @@ sub handler {
 
       $h{foo}++;
       
-    print ("$xid $h{foo}\n");
+      $output = "$xid $h{foo}\n";
-
+      Stasis::TsoftCommit($xid);
-    Stasis::Tcommit($xid);
       warn "b\n"; $| = 1;
-
+    }  # Release lock before commit happens.  This is safe, since the output is 
-    print "</body></html>\n";
+       # deferred, and the commit order safes us from xacts that read uncommitted
+       # data.
+    Stasis::TforceCommits();
+    print "$output</body></html>\n";
   
     return Apache2::Const::OK;
 }

lang/perl/apache/inc/startup.pl

@@ -1,21 +1,14 @@
-use threads;
-use threads::shared;
-
 use strict;
 BEGIN {
-    my $thelock :shared;
-
     $ENV{STASIS_DIR} = '/home/sears/stasis';
-
-    $ENV{STASIS_LOCK} = $thelock;
 }
-use lib ($ENV{STASIS_DIR}."/lang/perl/apache/");
+use lib ($ENV{STASIS_DIR}."/lang/perl/");  # For Stasis.pm
-push @INC, "$ENV{STASIS_DIR}/lang/perl/";
+push @INC, "$ENV{STASIS_DIR}/lang/perl/apache/";  # For StasisWeb::Web.pm
 
-use Inline (Config =>
+#use Inline (Config =>
-	    DIRECTORY => "$ENV{STASIS_DIR}/www-data/",
+#	    DIRECTORY => "$ENV{STASIS_DIR}/www-data/",
-    );
+#    );
-use Stasis;
+use Stasis "$ENV{STASIS_DIR}/www-data/";
 
 # XXX Ideally, the rest of this would go in a post_config handler, but
 # I can't get that to work...

lang/perl/bin/stasis.pl

@@ -0,0 +1,99 @@
+#!/usr/bin/perl -w
+
+use Stasis @ARGV;
+use strict;
+
+my $prompt = "\nstasis: ";
+
+my %s;
+Stasis::open(\%s);
+
+sub print_pad {
+    my $level = shift;
+    for(my $i = 0; $i < $level; $i++) {
+	print ' ';
+    }
+}
+sub print_hash {
+    my $h = shift;
+    my $level = shift || 0;
+    my $STEP = 2;
+    if (!defined $h) {
+	print_pad $level;
+	print '%s = ';
+	$h = \%s;
+    }
+    print "{\n";
+    foreach my $k (sort keys %$h) {
+	print_pad $level;
+	if(ref($$h{$k}) eq 'HASH') {
+	    print " $k => ";
+	    print_hash($$h{$k}, $level+$STEP);
+	} else {
+	    print " $k => $$h{$k}\n";
+	}
+    }
+    print_pad $level;
+    print "}\n";
+    "";
+}
+sub p { print_hash @_; }
+sub print_keys {
+    my $h = shift || \%s;
+    print "{ ";
+    print join ", ", sort( keys %$h);
+    print " }\n";
+    "";
+}
+sub k { print_keys @_; }
+sub commit { tied(%s)->commit(); }
+sub c { commit; }
+sub abort {tied(%s)->abort(); }
+sub a { abort; }
+
+sub help {
+    print 
+qq(This prompt is a perl toplevel.
+
+The hash %s points to the hash at the root of the datastore.
+The following helper functions may be useful:
+
+ print_hash [\%hash] (or p [\%hash])  Recursively print database contents
+ print_keys [\%hash] (or k [\%hash])  Print keys non-recursively
+ commit (or c)                        Commit %s's current transaction
+ abort  (or a)                        Abort the transaction
+
+ help (or h)
+);
+    "";
+}
+
+
+$| = 1;
+print "stasis toplevel.  'help' to get started ^D to exit.";
+print $prompt;
+
+
+while(my $line = <STDIN>) {
+    print eval($line);
+    print $prompt;
+}
+my $done = 0;
+print "^D\n";
+while(!$done) {
+    print "Commit any uncommitted data [Y/n]? ";
+    my $line = <STDIN>;
+    if(!defined $line) {
+	print "^D\n";
+	$done = 1;
+    } else {
+	chomp $line;
+	if($line eq "") { $line = "y"; }
+	if($line =~ /^y/i) {
+	    tied(%s)->commit();
+	    $done = 1;
+	} elsif($line =~ /^n/i) {
+	    $done = 1;
+	}
+    }
+}

lang/perl/cgi-bin/index.fcgi

@@ -0,0 +1,111 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+BEGIN {
+      $ENV{STASIS_INLINE_DIRECTORY} = '/home/sears/stasis/www-data2';
+      $ENV{PATH} = '/usr/local/bin:/usr/bin:/bin';
+      chdir '/home/sears/stasis/www-site' || die;
+      push @INC, '/home/sears/stasis/lang/perl';
+}
+
+use threads ('stack_size' => 128*1024);
+use threads::shared;
+
+use Stasis;
+
+use IO::Handle;
+use FCGI;
+use CGI;
+
+my $num_procs = 25;
+
+Stasis::Tinit();
+
+my @thrs;
+for(my $i = 0; $i < $num_procs; $i++) {
+    push @thrs, threads->create(\&event_loop);
+}
+
+warn "Done spawning worker threads\n";
+
+foreach my $t (@thrs) {
+    $t->join();
+}
+
+warn "Stasis cleanly shut down\n";
+
+exit;
+
+sub default_page {
+    my $q = shift;
+    my $page = shift;
+    return $q->p("$page does not exist");
+}
+
+sub edit_link {
+    my $q = shift;
+    my $page = shift;
+    my $url = $q->url(-relative=>1);
+    return $q->p("<a href='$url?mode=edit&page=$page'>Click here to edit the page</a>");
+}
+
+sub event_loop {
+#    my $in = new IO::Handle;
+#    my $out = new IO::Handle;
+#    my $err = new IO::Handle;
+    *STDIN = new IO::Handle;
+    *STDOUT = new IO::Handle;
+    *STDERR = new IO::Handle;
+    my %E;
+    %ENV = %E;
+#    my %env;
+    my %h;
+
+ #   my $request = FCGI::Request($in, $out, $err, \%env);
+   my $request = FCGI::Request();
+
+    Stasis::open(\%h);
+
+    my $contents;
+
+    while($request->Accept() >= 0) {
+	my $q = new CGI(); #$env{QUERY_STRING});
+
+	my $response;
+
+	my $mode = $q->param('mode') || 'view';
+
+	my $page = $q->param('page') || '/';
+
+	if($mode eq 'view') {
+	    $contents = ($h{$page} || default_page($q,$page)) . edit_link($q,$page);
+	    
+	} elsif($mode eq 'edit') {
+	    my $page = $q->param('page') || '/';
+	    my $a = $q->url(-relative=>1);
+	    
+	    $q->param(-name=>'mode',-value=>'set');
+	    $q->param(-name=>'contents',-value=>$h{$page});
+	    $contents = $q->start_form()
+		. $q->hidden('mode')
+		. $q->p($q->textarea(-name=>'contents',-cols=>80,-rows=>18))
+		. $q->submit("Save $page")
+		. $q->end_form();
+	} elsif($mode eq 'set') {
+	    $h{$page} = $q->param('contents');
+	    $contents = $h{$page} . edit_link($q,$page);
+	} else {
+	    $contents = "unknown mode $mode";
+	}
+	$response = $q->header()
+	    . $q->start_html($page)
+ 	    . $q->h1($page)
+	    . $contents
+	    . $q->end_html;
+
+	tied(%h)->commit();
+#	print $out $response;
+	print $response;
+    }
+}

lang/perl/cgi-bin/test.fcgi

@@ -25,7 +25,7 @@ my $count = 0;
 my $tot :shared = 0;
 my $concurrent :shared = 0;
 
-my $num_procs = 500; #25;
+my $num_procs = 25;
 
 
 Stasis::Tinit();

lang/perl/t/05-autoxacts.t

@@ -0,0 +1,42 @@
+#!/usr/bin/perl -w
+use strict;
+use Stasis;
+
+my $checking;
+
+if(@ARGV && $ARGV[0] eq "--automated-test") {
+  shift @ARGV;
+  system ("rm storefile.txt logfile.txt");
+  $checking = 1;
+}
+
+Stasis::Tinit();
+
+my %hash;
+
+tie %hash, 'Stasis::Hash';
+
+for(my $i = 0; $i < 4; $i++) {
+    $hash{$i} = $i * 10;
+    if($i % 2) {
+	tied(%hash)->commit();
+    } else {
+	tied(%hash)->abort();
+    }
+}
+Stasis::Tdeinit();
+Stasis::Tinit();
+
+tie %hash, 'Stasis::Hash';
+
+for(my $i = 0; $i < 4; $i++) {
+    if($i % 2) {
+	$hash{$i} == $i * 10 || die;
+    } else {
+	defined($hash{$i})   && die;
+    }
+}
+
+Stasis::Tdeinit();
+
+print "Passed";

lang/perl/t/06-open.t

@@ -0,0 +1,33 @@
+#!/usr/bin/perl -w
+use strict;
+use Stasis;
+
+my $checking;
+
+if(@ARGV && $ARGV[0] eq "--automated-test") {
+  shift @ARGV;
+  system ("rm storefile.txt logfile.txt");
+  $checking = 1;
+}
+
+my %hash;
+
+Stasis::open (\%hash);
+
+for(my $i = 0; $i < 4; $i++) {
+    $hash{$i} = $i * 10;
+    if($i % 2) {
+	tied(%hash)->commit();
+    } else {
+	tied(%hash)->abort();
+    }
+}
+for(my $i = 0; $i < 4; $i++) {
+    if($i % 2) {
+	$hash{$i} == $i * 10 || die;
+    } else {
+	defined($hash{$i})   && die;
+    }
+}
+
+print "Exiting";

lang/perl/t/07-hash-in-autohash.t

@@ -0,0 +1,41 @@
+#!/usr/bin/perl -w
+use strict;
+use Stasis;
+
+my $checking;
+
+if(@ARGV && $ARGV[0] eq "--automated-test") {
+  shift @ARGV;
+  system ("rm storefile.txt logfile.txt");
+  $checking = 1;
+}
+
+my %h;
+Stasis::open(\%h);
+
+Stasis::Tbegin();
+
+my %i;
+
+$h{foo} = \%i;
+
+tied(%h)->commit();
+
+$h{foo}{bar} = "x";
+
+my $i = $h{foo};
+
+tied(%h)->commit();
+$$i{baz} = "y";
+$$i{bat} = "z";
+
+Stasis::Tdeinit();
+
+Stasis::open(\%h);
+
+Stasis::Tbegin();
+Stasis::Tbegin();
+
+$h{foo}{baz} = "bat";
+$h{foo}{bar} == "x" || die;
+