From 5d0500dc7a92f80abbe161868caec1377ec11b65 Mon Sep 17 00:00:00 2001 From: Sears Russell Date: Wed, 17 Feb 2010 05:05:23 +0000 Subject: [PATCH] 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 | 3 + lang/perl/Stasis.pm | 302 ++++++++++++++++++++++++++---- lang/perl/apache/StasisWeb/Web.pm | 28 ++- lang/perl/apache/inc/startup.pl | 19 +- lang/perl/bin/stasis.pl | 99 ++++++++++ lang/perl/cgi-bin/index.fcgi | 111 +++++++++++ lang/perl/cgi-bin/test.fcgi | 2 +- lang/perl/t/05-autoxacts.t | 42 +++++ lang/perl/t/06-open.t | 33 ++++ lang/perl/t/07-hash-in-autohash.t | 41 ++++ 10 files changed, 617 insertions(+), 63 deletions(-) create mode 100755 lang/perl/bin/stasis.pl create mode 100755 lang/perl/cgi-bin/index.fcgi create mode 100755 lang/perl/t/05-autoxacts.t create mode 100644 lang/perl/t/06-open.t create mode 100644 lang/perl/t/07-hash-in-autohash.t 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 "

Stasis

" . `pwd`; - my $xid = Stasis::Tbegin(); - warn "a\n"; - my %h; - tie %h, 'Stasis::Hash', $xid, Stasis::ROOT_RID(); - $h{foo}++; + my $output; - print ("$xid $h{foo}\n"); + ## 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; + tie %h, 'Stasis::Hash', $xid, Stasis::ROOT_RID(); - Stasis::Tcommit($xid); - warn "b\n"; $| = 1; - - print "\n"; + $h{foo}++; + + $output = "$xid $h{foo}\n"; + Stasis::TsoftCommit($xid); + warn "b\n"; $| = 1; + } # Release lock before commit happens. This is safe, since the output is + # deferred, and the commit order safes us from xacts that read uncommitted + # data. + Stasis::TforceCommits(); + print "$output\n"; return Apache2::Const::OK; } diff --git a/lang/perl/apache/inc/startup.pl b/lang/perl/apache/inc/startup.pl index ac70559..eb25b3b 100755 --- a/lang/perl/apache/inc/startup.pl +++ b/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/"); -push @INC, "$ENV{STASIS_DIR}/lang/perl/"; +use lib ($ENV{STASIS_DIR}."/lang/perl/"); # For Stasis.pm +push @INC, "$ENV{STASIS_DIR}/lang/perl/apache/"; # For StasisWeb::Web.pm -use Inline (Config => - DIRECTORY => "$ENV{STASIS_DIR}/www-data/", - ); -use Stasis; +#use Inline (Config => +# DIRECTORY => "$ENV{STASIS_DIR}/www-data/", +# ); +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... diff --git a/lang/perl/bin/stasis.pl b/lang/perl/bin/stasis.pl new file mode 100755 index 0000000..c92e74f --- /dev/null +++ b/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 = ) { + print eval($line); + print $prompt; +} +my $done = 0; +print "^D\n"; +while(!$done) { + print "Commit any uncommitted data [Y/n]? "; + my $line = ; + 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; + } + } +} diff --git a/lang/perl/cgi-bin/index.fcgi b/lang/perl/cgi-bin/index.fcgi new file mode 100755 index 0000000..e4a7912 --- /dev/null +++ b/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("Click here to edit the page"); +} + +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; + } +} diff --git a/lang/perl/cgi-bin/test.fcgi b/lang/perl/cgi-bin/test.fcgi index 883f969..512c365 100755 --- a/lang/perl/cgi-bin/test.fcgi +++ b/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(); diff --git a/lang/perl/t/05-autoxacts.t b/lang/perl/t/05-autoxacts.t new file mode 100755 index 0000000..21ff4e4 --- /dev/null +++ b/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"; diff --git a/lang/perl/t/06-open.t b/lang/perl/t/06-open.t new file mode 100644 index 0000000..20df16f --- /dev/null +++ b/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"; \ No newline at end of file diff --git a/lang/perl/t/07-hash-in-autohash.t b/lang/perl/t/07-hash-in-autohash.t new file mode 100644 index 0000000..9d9dd75 --- /dev/null +++ b/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; +