greg/stasis-aries-wal
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Perl updates:

Browse source 
- 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)
This commit is contained in:
Sears Russell 2010-02-17 05:05:23 +00:00
parent 98e0cb1fab
commit 5d0500dc7a
10 changed files with 617 additions and 63 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
lang/perl/CMakeLists.txt
View file

@ -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)

302
lang/perl/Stasis.pm
View file

@ -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.

28
lang/perl/apache/StasisWeb/Web.pm
View file

@ -15,19 +15,27 @@ sub handler {
my $r = shift;
$r->content_type('text/html');
print "<html><head></head><body><h1>Stasis</h1>" . `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 "</body></html>\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</body></html>\n";
return Apache2::Const::OK;
}

19
lang/perl/apache/inc/startup.pl
View file

@ -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...

99
lang/perl/bin/stasis.pl Executable file
View file

@ -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;
}
}
}

111
lang/perl/cgi-bin/index.fcgi Executable file
View file

@ -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;
}
}

2
lang/perl/cgi-bin/test.fcgi
View file

@ -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();

42
lang/perl/t/05-autoxacts.t Executable file
View file

@ -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";

33
lang/perl/t/06-open.t Normal file
View file

@ -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";

41
lang/perl/t/07-hash-in-autohash.t Normal file
View file

@ -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;