File Coverage

blib/lib/Pixie/Store/Memory.pm
Criterion Covered Total %
statement 34 58 58.6
branch 2 10 20.0
condition n/a
subroutine 12 18 66.6
pod 8 13 61.5
total 56 99 56.5


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Pixie::Store::Memory -- a memory store for Pixie.
4              
5             =head1 SYNOPSIS
6              
7             use Pixie;
8             my $px = Pixie->new->connect( 'memory' );
9              
10             =head1 DESCRIPTION
11              
12             A memory store for Pixie.
13              
14             =cut
15              
16             package Pixie::Store::Memory;
17              
18 15     15   93 use Carp qw( confess );
  15         34  
  15         6048  
19 15     15   12639 use Storable qw( nfreeze thaw );
  15         42968  
  15         1205  
20              
21 15     15   123 use base qw( Pixie::Store );
  15         27  
  15         11194  
22              
23             our $VERSION = "2.08_02";
24              
25             sub init {
26 39     39 0 84 my $self = shift;
27 39         217 $self->{store} = {};
28 39         94 $self->{rootset} = {};
29 39         106 return $self;
30             }
31              
32             sub deploy {
33 4     4 1 7 my $self = shift;
34             # do nothing
35 4         15 return $self;
36             }
37              
38             sub connect {
39 39     39 1 73 my $self = shift;
40 39 50       343 $self = ref($self) ? $self : $self->new;
41             }
42              
43             sub remove_from_rootset {
44 0     0 0 0 my $self = shift;
45 0         0 my $oid = shift;
46 0         0 delete $self->{rootset}{$oid};
47 0         0 return $self;
48             }
49              
50             sub _add_to_rootset {
51 0     0   0 my $self = shift;
52 0         0 my $thing = shift;
53 0         0 $self->{rootset}{$thing->PIXIE::oid} = 1;
54 0         0 return $self;
55             }
56              
57             ## TODO: use wantarray
58             sub rootset {
59 0     0 0 0 my $self = shift;
60 0         0 keys %{$self->{rootset}};
  0         0  
61             }
62              
63             sub working_set_for {
64 0     0 0 0 my $self = shift;
65 0         0 my @ret = keys %{$self->{store}};
  0         0  
66 0 0       0 return wantarray ? @ret : \@ret;
67             }
68              
69             sub _delete {
70 0     0   0 my $self = shift;
71 0         0 my($oid) = @_;
72 0 0       0 defined(delete $self->{store}{$oid}) ? 1 : 0;
73             }
74              
75             sub store_at {
76 3     3 1 7 my $self = shift;
77 3         6 my($oid, $obj) = @_;
78              
79             # TODO: why not throw an error if no $oid?
80 3 50       8 if ($oid) {
81 3         15 $self->{store}{$oid} = nfreeze($obj);
82 3         305 return($oid, $obj);
83             }
84             else {
85 0         0 return $obj;
86             }
87             }
88              
89             sub get_object_at {
90 2     2 1 6 my $self = shift;
91 2         3 my($oid) = @_;
92              
93 2         16 return thaw $self->{store}{$oid};
94             }
95              
96 19     19 1 50 sub lock { $_[0] }
97 21     21 1 51 sub unlock { $_[0] }
98 21     21 1 53 sub rollback { $_[0] }
99              
100             sub clear {
101 10     10 1 24 my $self = shift;
102 10         20 %{$self->{store}} = ();
  10         31  
103 10         21 %{$self->{rootset}} = ();
  10         25  
104 10         27 return $self;
105             }
106              
107             sub delete_object_at {
108 0     0 0   my $self = shift;
109 0           my($oid) = @_;
110              
111 0 0         if (defined(wantarray)) {
112 0           return thaw delete $self->{store}{$oid};
113             }
114             else {
115 0           delete $self->{store}{$oid};
116             }
117             }
118              
119             1;
120              
121             __END__