lib/Onis/Data/Persistent/None.pm

   1 package Onis::Data::Persistent::None;
   2
   3 use strict;
   4 use warnings;
   5 use vars (qw($TREE));
   6
   7 use Carp qw(carp confess);
   8 use Exporter;
   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 @Onis::Data::Persistent::None::EXPORT_OK = (qw($TREE));
  25 @Onis::Data::Persistent::None::ISA = ('Exporter');
  26
  27 if ($::DEBUG & 0x0200)
  28 {
  29         require Data::Dumper;
  30 }
  31
  32 return (1);
  33
  34 sub new
  35 {
  36         my $pkg    = shift;
  37         my $name   = shift;
  38         my $key    = shift;
  39         my @fields = @_;
  40         my $caller = caller ();
  41         my $obj    = {};
  42         my $i = 0;
  43
  44         my $id = $caller . ':' . $name;
  45
  46         if (!exists ($TREE->{$id}))
  47         {
  48                 $TREE->{$id} = {};
  49         }
  50
  51         $obj->{'data'} = $TREE->{$id};
  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->{'data'}{$key}}) . ')';
 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);