Update for new keydata interface.

[catacomb-perl] / Catacomb / Key.pm

diff --git a/Catacomb/Key.pm b/Catacomb/Key.pm
index 6f84492..8f97126 100644 (file)
--- 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;