X-Git-Url: https://git.distorted.org.uk/~mdw/catacomb-perl/blobdiff_plain/bdf77f6dbd9205c70639fb682059e4ba0761c767..bfdf19cbde6d9f5cdb740d258fcc439a4a412ab0:/Catacomb/Key.pm diff --git a/Catacomb/Key.pm b/Catacomb/Key.pm index 6f84492..8f97126 100644 --- a/Catacomb/Key.pm +++ b/Catacomb/Key.pm @@ -27,23 +27,28 @@ #----- Key data ------------------------------------------------------------- -package Catacomb::Key::StructData; +package Catacomb::Key::Data::StructTie; use Carp; use Catacomb::Base; sub TIEHASH { bless [$_[1], []], $_[0]; } -sub FETCH { Catacomb::Key::Data::StructItem->new($_[0][0], $_[1]); } -sub EXISTS { !!$_[0][0]->_get->structfind($_[1]); } -sub DELETE { $_[0][0]->_get->structdel($_[1]); } -sub CLEAR { $_[0][0]->_get()->setstruct(); } -sub STORE { - my ($me, $k, $v) = @_; - $me->[0]->_get()->structcreate($k)->set($v); +sub FETCH { $_[0][0]->find($_[1]); } +sub EXISTS { !!$_[0][0]->find($_[1]); } +sub DELETE { $_[0][0]->del($_[1]); } +sub STORE { $_[0][0]->find($_[1], $_[2]); } + +sub CLEAR { + my ($me) = @_; + my $kd = $me->[0]; + my $i = $kd->iterate(); + $kd->del($k) while my $k = $i->next(); + 1; } + sub FIRSTKEY { my ($me) = @_; - my $kd = $me->[0]->_get(); - my $i = $kd->structiter(); + my $kd = $me->[0]; + my $i = $kd->iterate(); my @k = (); while (my $k = $i->next()) { push(@k, $k); @@ -53,79 +58,12 @@ sub FIRSTKEY { } sub NEXTKEY { shift(@{$_[0][1]}); } -package Catacomb::Key::DataRef; -use Carp; -use Catacomb::Base; -use Catacomb::MP; -use Catacomb::EC; -sub _adopt { - my $kd = shift; - defined($kd) or return; - $kd = bless [$kd], Catacomb::Key::Data; - return wantarray ? ($kd, @_) : $kd; -} -sub new { my $me = shift(@_); bless [@_], $me; } -sub _proxy { my ($op, $kd, @args) = @_; &$op($kd->_get(), @args); } - -sub setbinary { _proxy(\&Catacomb::Key::DataImpl::setbinary, @_); } -sub setencrypted { _proxy(\&Catacomb::Key::DataImpl::setencrypted, @_); } -sub setmp { _proxy(\&Catacomb::Key::DataImpl::setec, @_); } -sub setstring { _proxy(\&Catacomb::Key::DataImpl::setstring, @_); } -sub setec { _proxy(\&Catacomb::Key::DataImpl::setec, @_); } +package Catacomb::Key::Data::Structured; +sub open { my %h; tie %h, Catacomb::Key::Data::StructTie, $_[0]; \%h; } -sub flags { _proxy(\&Catacomb::Key::DataImpl::flags, @_); } - -sub getbinary { _proxy(\&Catacomb::Key::DataImpl::getbinary, @_); } -sub getencrypted { _proxy(\&Catacomb::Key::DataImpl::getencrypted, @_); } -sub getmp { _proxy(\&Catacomb::Key::DataImpl::getmp, @_); } -sub getstring { _proxy(\&Catacomb::Key::DataImpl::getstring, @_); } -sub getec { _proxy(\&Catacomb::Key::DataImpl::getec, @_); } - -sub setstruct { _proxy(\&Catacomb::Key::DataImpl::setstruct, @_); } -sub structfind { Catacomb::Key::Data::StructItem->new($_[0], $_[1]); } -sub structcreate { - _proxy(\&Catacomb::Key::DataImpl::structcreate, @_); - Catacomb::Key::Data::StructItem->new($_[0], $_[1]); -} -sub structiter { _proxy(\&Catacomb::Key::DataImpl::structiter, @_); } -sub structdel { _proxy(\&Catacomb::Key::DataImpl::structdel, @_); } -sub structopen { my %h; tie %h, Catacomb::Key::StructData, $_[0]; \%h; } - -sub copy { - croak("Usage: Catacomb::Key::Data::Ref::copy(kd, kkd, [filter])") - unless @_ >= 2 && @_ <= 3; - my $kd = Catacomb::Key::Data->new(); - $kd->_get()->set($_[0]->_get(), $_[1]); - return $kd; +foreach $i (qw(Binary Encrypted MP EC String Structured)) { + @{"Catacomb::Key::Data::${i}::ISA"} = qw(Catacomb::Key::Data); } -sub lock { _adopt(_proxy(\&Catacomb::Key::DataImpl::lock, @_)); } -sub unlock { _adopt(_proxy(\&Catacomb::Key::DataImpl::unlock, @_)); } -sub plock { _adopt(_proxy(\&Catacomb::Key::DataImpl::plock, @_)); } -sub punlock { _adopt(_proxy(\&Catacomb::Key::DataImpl::punlock, @_)); } -sub read { _adopt(Catacomb::Key::DataImpl::read(@_)); } -sub write { _proxy(\&Catacomb::Key::DataImpl::write, @_); } -sub decode { _adopt(Catacomb::Key::DataImpl::decode(@_)); } -sub encode { _proxy(\&Catacomb::Key::DataImpl::encode, @_); } - -package Catacomb::Key::Data; -use Carp; -@ISA = qw(Catacomb::Key::DataRef); -sub _get { $_[0][0]; } -## Perl will randomly zap my reference during cleanup. Just pretend -## we didn't notice. -sub DESTROY { $_[0][0]->free() if defined $_[0][0]; } -sub new { - croak("Usage: Catacomb::Key::Data::new(me)") unless @_ == 1; - Catacomb::Key::DataRef::_adopt(Catacomb::Key::DataImpl->new()); -} - -package Catacomb::Key::Data::StructItem; -@ISA = qw(Catacomb::Key::DataRef); -sub _get { $_[0][0]->_get()->structfind($_[0][1]); } - -package Catacomb::Key::Data::KeyData; -@ISA = qw(Catacomb::Key::DataRef); -sub _get { $_[0][0]->_data(); } #----- Actual keys ---------------------------------------------------------- @@ -157,33 +95,6 @@ sub attrs { return \%a; } -sub data { - croak("Usage: Catacomb::Key::data(k)") unless @_ == 1; - return Catacomb::Key::Data::KeyData->new($_[0]); -} - -package Catacomb::Key::File; -use Carp; -use Catacomb::Base; - -sub qtag { - croak("Usage: Catacomb::Key::File::qtag(kf, tag)") unless @_ == 2; - my ($kf, $tag) = @_; - my @q = (); - if ($tag =~ /^([^.]*)\.(.*)$/) { - $tag = $1; - @q = split(/\./, $2); - } - my $k = $kf->bytag($tag) or return; - my $d = $k->data(); - my $f = $k->fulltag(); - foreach my $t (@q) { - $d = $d->structfind($t) or return; - $f .= "." . $t; - } - return $k, $d, $f; -} - #----- That's all, folks ---------------------------------------------------- 1;