mdw@git.distorted.org.uk Git - catacomb-perl/blob - Catacomb/Key.pm

   1 # -*-perl-*-
   2 #
   3 # $Id$
   4 #
   5 # Key management
   6 #
   7 # (c) 2004 Straylight/Edgeware
   8 #
   9
  10 #----- Licensing notice -----------------------------------------------------
  11 #
  12 # This file is part of the Perl interface to Catacomb.
  13 #
  14 # Catacomb/Perl is free software; you can redistribute it and/or modify
  15 # it under the terms of the GNU General Public License as published by
  16 # the Free Software Foundation; either version 2 of the License, or
  17 # (at your option) any later version.
  18 #
  19 # Catacomb/Perl is distributed in the hope that it will be useful,
  20 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 # GNU General Public License for more details.
  23 #
  24 # You should have received a copy of the GNU General Public License
  25 # along with Catacomb/Perl; if not, write to the Free Software Foundation,
  26 # Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  27
  28 #----- Key data -------------------------------------------------------------
  29
  30 package Catacomb::Key::Data::StructTie;
  31 use Carp;
  32 use Catacomb::Base;
  33
  34 sub TIEHASH { bless [$_[1], []], $_[0]; }
  35 sub FETCH { $_[0][0]->find($_[1]); }
  36 sub EXISTS { !!$_[0][0]->find($_[1]); }
  37 sub DELETE { $_[0][0]->del($_[1]); }
  38 sub STORE { $_[0][0]->find($_[1], $_[2]); }
  39
  40 sub CLEAR {
  41   my ($me) = @_;
  42   my $kd = $me->[0];
  43   my $i = $kd->iterate();
  44   $kd->del($k) while my $k = $i->next();
  45   1;
  46 }
  47
  48 sub FIRSTKEY {
  49   my ($me) = @_;
  50   my $kd = $me->[0];
  51   my $i = $kd->iterate();
  52   my @k = ();
  53   while (my $k = $i->next()) {
  54     push(@k, $k);
  55   }
  56   $me->[1] = \@k;
  57   return shift(@k);
  58 }
  59 sub NEXTKEY { shift(@{$_[0][1]}); }
  60
  61 package Catacomb::Key::Data::Structured;
  62 sub open {  my %h; tie %h, Catacomb::Key::Data::StructTie, $_[0]; \%h; }
  63
  64 foreach $i (qw(Binary Encrypted MP EC String Structured)) {
  65   @{"Catacomb::Key::Data::${i}::ISA"} = qw(Catacomb::Key::Data);
  66 }
  67
  68 #----- Actual keys ----------------------------------------------------------
  69
  70 package Catacomb::Key::Attrs;
  71 use Carp;
  72
  73 sub TIEHASH { bless [$_[1], []], $_[0]; }
  74 sub FETCH { $_[0][0]->getattr($_[1]); }
  75 sub EXISTS { defined($_[0][0]->getattr($_[1])); }
  76 sub STORE { $_[0][0]->putattr($_[1], $_[2]); }
  77 sub DELETE { $_[0][0]->putattr($_[1]); }
  78 sub FIRSTKEY {
  79   my ($me) = @_;
  80   my $k = $me->[0];
  81   my $i = $k->attriter();
  82   my @a;
  83   while (my $a = $i->next()) { push(@a, $a); }
  84   $me->[1] = \@a;
  85   return shift(@a);
  86 }
  87 sub NEXTKEY { shift(@{$_[0][1]}); }
  88
  89 package Catacomb::Key;
  90
  91 sub attrs {
  92   croak("Usage: Catacomb::Key::attrs(k)") unless @_ == 1;
  93   my %a;
  94   tie %a, Catacomb::Key::Attrs, @_;
  95   return \%a;
  96 }
  97
  98 #----- That's all, folks ----------------------------------------------------
  99
 100 1;