lib/Onis/Data/Persistent/None.pm

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