+# -*-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;