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

implemented support for tied perl hashes

Browse source
This commit is contained in:
Sears Russell 2009-12-09 01:43:07 +00:00
parent ed1ed5fcf2
commit ac0d623d32
4 changed files with 175 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
lang/perl/CMakeLists.txt
View file

@ -11,6 +11,7 @@ ENDMACRO(CREATE_CHECK_PERL_OPT)
CREATE_CHECK_PERL(t/test.pl)
CREATE_CHECK_PERL_OPT(t/test2.pl ${CMAKE_CURRENT_SOURCE_DIR}/t/test2.script)
CREATE_CHECK_PERL(t/test3.pl)
#ADD_TEST(perl/test.pl perl -I${CMAKE_HOME_DIRECTORY}/lang/perl ${CMAKE_CURRENT_SOURCE_DIR}/t/test.pl)
#ADD_TEST(perl/t/test2.pl ${CMAKE_CURRENT_SOURCE_DIR}/t/test.pl STASIS_DIR=${CMAKE_HOME_DIRECTORY})

95
lang/perl/Stasis.pm
View file

@ -7,10 +7,8 @@ BEGIN {
if(!defined($STASIS_DIR)) {
$STASIS_DIR = $INC{"Stasis.pm"};
$STASIS_DIR =~ s~/lang/perl/Stasis.pm~~g;
print $STASIS_DIR;
}
1;
#die "\nNeed STASIS_DIR environment variable!!\n\n";
}
use Inline C => Config => LIBS =>
"-L$STASIS_DIR/build/src/stasis/ " .
@ -26,6 +24,76 @@ sub version {
return "Stasis 0.1";
}
package Stasis::Hash;
require Tie::Hash;
@ISA = qw(Tie::Hash);
sub TIEHASH {
my $class = shift;
my $xid = shift;
my $rid = shift;
defined ($xid) || die "need xid to tie hash";
defined ($rid) || die "need rid to tie hash";
my $this = {
xid => $xid,
rid => $rid,
};
return bless $this, $class;
}
sub FETCH {
my $this = shift;
my $key = shift;
my $ret = Stasis::ThashLookup($$this{xid}, $$this{rid}, $key);
## Oddly, returning without the defined() check leads to a segfault(??)
if(defined($ret)) { return $ret; } else { return; }
}
sub STORE {
my $this = shift;
my $key = shift;
my $val = shift;
Stasis::ThashInsert($$this{xid}, $$this{rid}, $key, $val);
}
sub DELETE {
my $this = shift;
my $key = shift;
return Stasis::ThashRemove($$this{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});
} else {
Stasis::Titerator_close($$this{xid}, $$this{it});
return;
}
}
sub NEXTKEY {
my $this = shift;
my $lastkey = shift;
print("."); $|=1;
Stasis::Titerator_tupleDone($$this{xid}, $$this{it});
if(Stasis::Titerator_next($$this{xid}, $$this{it})) {
return Stasis::Titerator_key($$this{xid}, $$this{it});
} else {
Stasis::Titerator_close($$this{xid}, $$this{it});
return;
}
}
sub EXISTS {
my $this = shift;
my $key = shift;
}
sub CLEAR {
my $this = shift;
}
package Stasis;
__DATA__
__C__
#include "stasis/transactional.h"
@ -227,6 +295,29 @@ SV* stasis_perl_ThashLookup(int xid, recordid hash, SV * key) {
}
}
void * stasis_perl_ThashIterator(int xid, recordid hash) {
return ThashGenericIterator(xid, hash);
}
int stasis_perl_Titerator_next(int xid, void *it) {
return Titerator_next(xid, it);
}
SV* stasis_perl_Titerator_key(int xid, void *it) {
byte * bytes;
STRLEN sz = Titerator_key(xid, it, &bytes);
return SV_bytes(bytes, sz);
}
SV* stasis_perl_Titerator_value(int xid, void *it) {
byte * bytes;
STRLEN sz = Titerator_value(xid, it, &bytes);
return SV_bytes(bytes, sz);
}
void stasis_perl_Titerator_tupleDone(int xid, void *it) {
Titerator_tupleDone(xid, it);
}
void stasis_perl_Titerator_close(int xid, void *it) {
Titerator_close(xid, it);
}
SV* stasis_perl_ROOT_RID() {
return SV_recordid(ROOT_RECORD);
}

14
lang/perl/t/test2.pl
View file

@ -43,8 +43,9 @@ my $rid;
sub walk {
my $from = shift;
my $h = shift;
my $level = shift || 0;
my $to = Stasis::ThashLookup($xid, $rid, $from);
my $to = $h->{$from};
myprint $from;
$level += (length($from) + 4);
@ -54,7 +55,7 @@ sub walk {
foreach my $f (@tok) {
if($first) { myprint " => "; } else { my $n = $level; while($n--) {myprint " ";} }
$first = 0;
walk($f,$level);
walk($f,$h,$level);
}
} else {
myprint "\n";
@ -67,13 +68,18 @@ if(Stasis::TrecordType($xid, Stasis::ROOT_RID()) == Stasis::INVALID_SLOT()) {
$rid = Stasis::ROOT_RID();
}
my %hash;
tie(%hash, 'Stasis::Hash', $xid, $rid);
while(my $line = <>) {
chomp $line;
my @tok = split '\s+', $line;
if($tok[0] eq "c") {
Stasis::ThashInsert($xid, $rid, $tok[1], $tok[2]);
#Stasis::ThashInsert($xid, $rid, $tok[1], $tok[2]);
$hash{$tok[1]} = $tok[2];
} elsif($tok[0] eq "q") {
walk $tok[1];
walk $tok[1], \%hash;
}
}

71
lang/perl/t/test3.pl Normal file
View file

@ -0,0 +1,71 @@
#!/usr/bin/perl -w
use strict;
use Stasis;
my $expected =
"a1 b2 c3 d4 e5 f6 g7 h8 i9 j10 \n" .
"k1 l2 m3 n4 o5 p6 q7 r8 s9 t10 \n";
my $checking = 0;
my $out = "";
sub myprint {
my $a = shift;
if($checking) {
$out .= $a;
} else {
print $a;
}
}
if($ARGV[0] eq "--automated-test") {
shift @ARGV;
system ("rm storefile.txt logfile.txt");
$checking = 1;
}
Stasis::Tinit();
my $xid = Stasis::Tbegin();
my $rid = Stasis::ThashCreate($xid);
Stasis::Tcommit($xid);
$xid = Stasis::Tbegin();
my %h;
tie %h, 'Stasis::Hash', $xid, $rid;
my $i = 0;
foreach my $x (qw(a b c d e f g h i j)) {
$i++;
$h{$x}=$i;
}
my @keys = sort keys %h;
for my $k (@keys) {
myprint "$k$h{$k} ";
}
myprint "\n";
Stasis::Tabort($xid);
$xid = Stasis::Tbegin();
tie %h, 'Stasis::Hash', $xid, $rid;
my $i = 0;
foreach my $x (qw(k l m n o p q r s t)) {
$i++;
$h{$x}=$i;
}
@keys = sort keys %h;
for my $k (@keys) {
# does not output the aborted pairs.
myprint "$k$h{$k} ";
}
myprint "\n";
Stasis::Tcommit($xid);
Stasis::Tdeinit();
if($checking) {
$out eq $expected || die "\nFAIL: Output did not match. Expected\n{$expected}\nGot\n{$out}\n";
print "\nPASS: Produced expected output:\n$out";
}