lib/Onis/Data/Persistent/None.pm

   1 package Onis::Data::Persistent::None;
   2
   3 use strict;
   4 use warnings;
   5
   6 use vars (qw($TREE));
   7
   8 use Carp qw(confess);
   9
  10 =head1 NAME
  11
  12 Onis::Data::Persistent::None - Storage backend without storage.. ;)
  13
  14 =head1 DESCRIPTION
  15
  16 Simple storage backend that handles data in-memory only..
  17
  18 =head1 CONFIGURATION OPTIONS
  19
  20 None.
  21
  22 =cut
  23
  24 $TREE = {};
  25
  26 return (1);
  27
  28 sub new
  29 {
  30         my $pkg    = shift;
  31         my $name   = shift;
  32         my $key    = shift;
  33         my @fields = @_;
  34         my $caller = caller ();
  35         my $obj    = {};
  36         my $i = 0;
  37
  38         my $id = $caller . ':' . $name;
  39
  40         if (exists ($TREE->{$id}))
  41         {
  42                 print STDERR $/, __FILE__, ": Name $name has been used in context $caller before.";
  43                 return (undef);
  44         }
  45
  46         $TREE->{$id} = {};
  47         $obj->{'data'} = $TREE->{$id};
  48
  49         $obj->{'key'} = $key;
  50         $obj->{'fields'} = [@fields];
  51         $obj->{'num_fields'} = scalar (@fields);
  52         $obj->{'field_index'} = {map { $_ => $i++ } (@fields)};
  53         $obj->{'id'} = $id;
  54
  55         return (bless ($obj, $pkg));
  56 }
  57
  58 sub put
  59 {
  60         my $obj    = shift;
  61         my $key    = shift;
  62         my @fields = @_;
  63
  64         if ($obj->{'num_fields'} != scalar (@fields))
  65         {
  66                 my $id = $obj->{'id'};
  67                 print STDERR $/, __FILE__, ": Number of fields do not match ($id).";
  68                 return;
  69         }
  70
  71         $obj->{'data'}{$key} = [@fields];
  72 }
  73
  74 sub get
  75 {
  76         my $obj = shift;
  77         my $key = shift;
  78
  79         if (!defined ($obj->{'data'}{$key}))
  80         {
  81                 return (qw());
  82         }
  83
  84         return (@{$obj->{'data'}{$key}});
  85 }
  86
  87 sub keys
  88 {
  89         my $obj = shift;
  90         my @fields = @_;
  91         my @field_indizes = ();
  92         my @keys = keys %{$obj->{'data'}};
  93
  94         if (!@fields)
  95         {
  96                 return (@keys);
  97         }
  98
  99         for (@fields)
 100         {
 101                 my $field = $_;
 102                 if (!defined ($obj->{'field_index'}{$field}))
 103                 {
 104                         my $id = $obj->{'id'};
 105                         print STDERR $/, __FILE__, ": $field is not a valid field ($id).";
 106                 }
 107                 push (@field_indizes, $obj->{'field_index'}{$field});
 108         }
 109
 110         return (sort
 111         sub {
 112                 for (@field_indizes)
 113                 {
 114                         my $d = $obj->{'data'}{$a}[$_] cmp $obj->{'data'}{$b}[$_];
 115                         return ($d) if ($d);
 116                 }
 117         }, @keys);
 118 }
 119
 120 sub del
 121 {
 122         my $obj = shift;
 123         my $key = shift;
 124
 125         if (defined ($obj->{'data'}{$key}))
 126         {
 127                 delete ($obj->{'data'}{$key});
 128         }
 129 }
 130
 131 =head1 AUTHOR
 132
 133 Florian octo Forster, L<octo@verplant.org>
 134
 135 =cut
 136
 137 exit (0);