From ac0d623d324dcd23972c733ada84a30b71a8fd04 Mon Sep 17 00:00:00 2001 From: Sears Russell Date: Wed, 9 Dec 2009 01:43:07 +0000 Subject: [PATCH] implemented support for tied perl hashes --- lang/perl/CMakeLists.txt | 1 + lang/perl/Stasis.pm | 95 +++++++++++++++++++++++++++++++++++++++- lang/perl/t/test2.pl | 14 ++++-- lang/perl/t/test3.pl | 71 ++++++++++++++++++++++++++++++ 4 files changed, 175 insertions(+), 6 deletions(-) create mode 100644 lang/perl/t/test3.pl diff --git a/lang/perl/CMakeLists.txt b/lang/perl/CMakeLists.txt index 471d1a3..3a867da 100644 --- a/lang/perl/CMakeLists.txt +++ b/lang/perl/CMakeLists.txt @@ -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}) diff --git a/lang/perl/Stasis.pm b/lang/perl/Stasis.pm index 314176c..40b3189 100644 --- a/lang/perl/Stasis.pm +++ b/lang/perl/Stasis.pm @@ -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); } diff --git a/lang/perl/t/test2.pl b/lang/perl/t/test2.pl index 1c99963..2c5fed5 100755 --- a/lang/perl/t/test2.pl +++ b/lang/perl/t/test2.pl @@ -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; } } diff --git a/lang/perl/t/test3.pl b/lang/perl/t/test3.pl new file mode 100644 index 0000000..c5d644c --- /dev/null +++ b/lang/perl/t/test3.pl @@ -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"; +}