A first, simple implementation of Persistent::None..

diff --git a/lib/Onis/Data/Persistent.pm b/lib/Onis/Data/Persistent.pm
index 7793594..a2824e6 100644 (file)
--- a/lib/Onis/Data/Persistent.pm
+++ b/lib/Onis/Data/Persistent.pm
@@ -18,9 +18,6 @@ internal data for longer than one run..
 
 use Onis::Config qw#get_config get_checksum#;
 
-@Onis::Data::Persistent::EXPORT_OK = qw##;
-@Onis::Data::Persistent::ISA = ('Exporter');
-
 our $StoreModule = 'None';
 
 =head1 CONFIGURATION OPTIONS
@@ -81,24 +78,24 @@ world - a table. The name must be unique for each calling method's namespace.
 
 Since this is a constructor it returns an object. The object "knows" the folling methods:
 
-=item B<$data-E<gt>put> (I<$name>, I<$key>, I<@fields>)
+=item B<$data-E<gt>put> (I<$key>, I<@fields>)
 
 Stores the given values in the data structure. How this is done is described
 below in L<another paragraph>. Doesn't return anything. The number of entries
 in I<@fields> has to match the number of entries in I<@field_names> when
 creating the object using B<new>.
 
-=item B<$data-E<gt>get> (I<$name>, I<$key>) 
+=item B<$data-E<gt>get> (I<$key>) 
 
-Returns the data associated with the given I<$name>/I<$key> pair or an empty
-list if no data has been stored under this tupel before..
+Returns the data associated with the given I<$key> pair or an empty list if no
+data has been stored under this tupel before..
 
-=item B<$data-E<gt>keys> (I<$name>, [I<$field>, ...])
+=item B<$data-E<gt>keys> ([I<$field>, ...])
 
-Returns a list of all the keys defined for this name. If one field is given the
-list will be sorted by that field's values, if more fields are given the list
-is sorted with the first field taking precedence over the others. If no field
-is supplied the order is undefined.
+Returns a list of all the keys defined for this object. If one field is given
+the list will be sorted by that field's values, if more fields are given the
+list is sorted with the first field taking precedence over the others. If no
+field is supplied the order is undefined.
 
 =back
 

diff --git a/lib/Onis/Data/Persistent/None.pm b/lib/Onis/Data/Persistent/None.pm
new file mode 100644 (file)
index 0000000..5532561
--- /dev/null
+++ b/lib/Onis/Data/Persistent/None.pm
@@ -0,0 +1,126 @@
+package Onis::Data::Persistent::None;
+
+use strict;
+use warnings;
+
+use vars (qw($TREE));
+
+use Carp qw(confess);
+
+=head1 NAME
+
+Onis::Data::Persistent::None - Storage backend without storage.. ;)
+
+=head1 DESCRIPTION
+
+Simple storage backend that handles data in-memory only..
+
+=head1 CONFIGURATION OPTIONS
+
+None.
+
+=cut
+
+$TREE = {};
+
+return (1);
+
+sub new
+{
+       my $pkg    = shift;
+       my $name   = shift;
+       my $key    = shift;
+       my @fields = @_;
+       my $caller = caller ();
+       my $obj    = {};
+       my $i = 0;
+       
+       my $id = $caller . ':' . $name;
+       
+       if (exists ($TREE->{$id}))
+       {
+               print STDERR $/, __FILE__, ": Name $name has been used in context $caller before.";
+               return (undef);
+       }
+
+       $TREE->{$id} = {};
+       $obj->{'data'} = $TREE->{$id};
+
+       $obj->{'key'} = $key;
+       $obj->{'fields'} = [@fields];
+       $obj->{'num_fields'} = scalar (@fields);
+       $obj->{'field_index'} = {map { $_ => $i++ } (@fields)};
+       $obj->{'id'} = $id;
+       
+       return (bless ($obj, $pkg));
+}
+
+sub put
+{
+       my $obj    = shift;
+       my $key    = shift;
+       my @fields = @_;
+
+       if ($obj->{'num_fields'} != scalar (@fields))
+       {
+               my $id = $obj->{'id'};
+               print STDERR $/, __FILE__, ": Number of fields do not match ($id).";
+               return;
+       }
+
+       $obj->{'data'}{$key} = [@fields];
+}
+
+sub get
+{
+       my $obj = shift;
+       my $key = shift;
+
+       if (!defined ($obj->{'data'}{$key}))
+       {
+               return (qw());
+       }
+
+       return (@{$obj->{'data'}{$key}});
+}
+
+sub keys
+{
+       my $obj = shift;
+       my @fields = @_;
+       my @field_indizes = ();
+       my @keys = keys %{$obj->{'data'}};
+
+       if (!@fields)
+       {
+               return (@keys);
+       }
+
+       for (@fields)
+       {
+               my $field = $_;
+               if (!defined ($obj->{'field_index'}{$field}))
+               {
+                       my $id = $obj->{'id'};
+                       print STDERR $/, __FILE__, ": $field is not a valid field ($id).";
+               }
+               push (@field_indizes, $obj->{'field_index'}{$field});
+       }
+
+       return (sort (sub
+       {
+               for (@field_indizes)
+               {
+                       my $d = $obj->{'data'}{$a}[$_] cmp $obj->{'data'}{$b}[$_];
+                       return ($d) if ($d);
+               }
+       }, @keys));
+}
+
+=head1 AUTHOR
+
+Florian octo Forster, L<octo@verplant.org>
+
+=cut
+
+exit (0);