Much wider support for Catacomb in all its glory.

[catacomb-perl] / Catacomb / Cache.pm

diff --git a/Catacomb/Cache.pm b/Catacomb/Cache.pm
new file mode 100644 (file)
index 0000000..6b42c4e
--- /dev/null
+++ b/Catacomb/Cache.pm
@@ -0,0 +1,72 @@
+# -*-perl-*-
+#
+# $Id$
+#
+# Caching for fields, curves, groups, ...
+#
+# (c) 2004 Straylight/Edgeware
+#
+
+#----- Licensing notice -----------------------------------------------------
+#
+# This file is part of the Perl interface to Catacomb.
+#
+# Catacomb/Perl is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+# 
+# Catacomb/Perl is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with Catacomb/Perl; if not, write to the Free Software Foundation,
+# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+package Catacomb::Cache::Ref;
+
+sub new {
+  my ($me, $c) = @_;
+  $c->[0]++;
+  return bless [$c], $me;
+}
+
+sub DESTROY {
+  my ($me) = @_;
+  my $c = $me->[0];
+  if ($c->[0] > 1) { $c->[0]--; return; }
+  delete $c->[1]{$c->[2]};
+}
+
+package Catacomb::Cache;
+
+$debug = 1;
+
+sub stringify {
+  my ($x) = @_;
+  if (ref($x) eq ARRAY) {
+    return "[" . join("/", map(stringify($_), @$x)) . "]";
+  } else {
+    return $x;
+  }
+}
+
+sub new { my ($me) = @_; return bless { }, $me; }
+
+sub intern {
+  my ($c, $x) = @_;
+  my $k = stringify($x->get());
+  my $e;
+  if (exists($c->{$k})) {
+    $e = $c->{$k};
+  } else {
+    $e = $c->{$k} = [0, $c, $k, $x];
+  }
+  return $e->[3], Catacomb::Cache::Ref->new($e);
+}
+
+#----- That's all, folks ----------------------------------------------------
+
+1;