File Coverage

blib/lib/Hash/Storage.pm
Criterion Covered Total %
statement 49 51 96.0
branch 10 22 45.4
condition n/a
subroutine 13 13 100.0
pod 6 7 85.7
total 78 93 83.8


line stmt bran cond sub pod time code
1             package Hash::Storage;
2              
3             our $VERSION = '0.03';
4              
5 3     3   55288 use v5.10;
  3         9  
  3         121  
6 3     3   13 use strict;
  3         9  
  3         97  
7 3     3   14 use warnings;
  3         8  
  3         88  
8 3     3   13 use Carp qw/croak/;
  3         4  
  3         218  
9 3     3   1740 use Class::Load qw/load_class/;
  3         81758  
  3         1365  
10              
11             sub new {
12 3     3 1 1041 my $class = shift;
13 3         11 my %args = @_;
14 3         6 my $driver = $args{driver};
15 3 50       13 croak "Wrong driver" unless ref $driver;
16              
17 3         9 my $self = bless {}, $class;
18              
19 3 50       12 if ( ref $driver eq 'ARRAY' ) {
    0          
20 3         11 my $driver_class = 'Hash::Storage::Driver::' . $driver->[0];
21              
22 3         15 load_class($driver_class);
23              
24 3 50       190 $self->{driver} = $driver_class->new( %{ $driver->[1] || {} } );
  3         46  
25             } elsif ( $driver->isa('Hash::Storage::Driver::Base') ) {
26 0         0 $self->{driver} = $driver;
27             } else {
28 0         0 croak "Wrong driver [$driver]";
29             }
30              
31 3         15 $self->init();
32              
33 3         12 return $self;
34             }
35              
36             sub init {
37 3     3 0 6 my $self = shift;
38 3         14 $self->{driver}->init(@_);
39             }
40              
41             sub get {
42 21     21 1 47 my ( $self, $id ) = @_;
43 21 50       52 croak "id is required" unless $id;
44 21 50       49 croak "id must contain only letters and digits" unless $self->_is_good_id($id);
45              
46 21         99 $self->{driver}->get(lc($id));
47             }
48              
49             sub set {
50 48     48 1 89 my ( $self, $id, $fields ) = @_;
51 48 50       115 croak 'id is required' unless $id;
52 48 50       91 croak 'id must contain only letters and digits' unless $self->_is_good_id($id);
53 48 50       122 croak 'fields are required' unless ref $fields eq 'HASH';
54              
55 48         133 $fields->{_id} = lc($id);
56 48         162 $self->{driver}->set( lc($id), $fields );
57             }
58              
59             sub del {
60 6     6 1 15 my ( $self, $id ) = @_;
61 6 50       20 croak "id is required" unless $id;
62 6 50       14 croak "id must contain only letters and digits" unless $self->_is_good_id($id);
63              
64 6         56 $self->{driver}->del(lc($id));
65             }
66              
67             sub list {
68 15     15 1 46 my ( $self, @query ) = @_;
69 15         64 $self->{driver}->list( @query );
70             }
71              
72             sub count {
73 15     15 1 28 my ( $self, $filter ) = @_;
74 15         56 $self->{driver}->count($filter);
75             }
76              
77             sub _is_good_id {
78 75     75   80 my ($self, $id) = @_;
79 75         176 return 1;
80             #return $id =~ m/^[a-zA-Z0-9][a-zA-Z0-9_\@\-.]*[a-zA-Z0-9]$/ ? 1 : 0 ;
81             }
82              
83             =head1 NAME
84              
85             Hash::Storage - Persistent Hash Storage Framework
86              
87             =cut
88              
89             =head1 SYNOPSIS
90              
91             my $st = Hash::Storage->new(
92             driver => [ OneFile => { serializer => 'JSON', file => '/tmp/t.json' } ]
93             );
94              
95             # Store hash by id
96             $st->set( 'user1' => { name => 'Viktor', gender => 'M', age => '28' } );
97              
98             # Get hash by id
99             my $user_data = $st->get('user1');
100              
101             # Delete hash by id
102             $st->del('user1');
103              
104              
105             =head1 DESCRIPTION
106              
107             Hash::Storage is a multipurpose storage for hash. You can consider Hash::Storage object as a collection of hashes.
108             You can use it for storing users, sessions and a lot more data.
109              
110             Hash::Storage has pluggable architecture, therefore you can use different drivers or write you own.
111              
112             =head1 METHODS
113              
114             =head2 Hash::Storage->new(driver => $DRIVER)
115              
116             $DRIVER is an arrayref with two values:
117             the first is a driver name, the second is a hashref with options for driver.
118              
119             my $st = Hash::Storage->new(
120             driver => [ OneFile => { serializer => 'JSON', file => '/tmp/t.json' } ]
121             );
122              
123             $DRIVER - also can be a Hash::Storage driver object
124              
125             my $drv = Hash::Storage::Driver::OneFile->new({ serializer => 'JSON', file => '/tmp/t.json' });
126             my $st = Hash::Storage->new( driver => $drv );
127              
128              
129             =head2 $SELF->set($ID, \%HASH);
130              
131             Saves hash
132              
133             =head2 $SELF->get($ID);
134              
135             Retrieves hash
136              
137             =head2 $SELF->del($ID);
138              
139             Deletes hash
140              
141             =head2 $SELF->list();
142              
143             returns array with hashrefs
144              
145             =head2 $SELF->count();
146              
147             returns number of hashes in a collection
148              
149             =head1 AUTHOR
150              
151             "koorchik", C<< <"koorchik at cpan.org"> >>
152              
153             =head1 BUGS
154              
155             Please report any bugs or feature requests to C, or through
156             the web interface at L. I will be notified, and then you'll
157             automatically be notified of progress on your bug as I make changes.
158              
159             =head1 SUPPORT
160              
161             You can find documentation for this module with the perldoc command.
162              
163             perldoc Hash::Storage
164              
165              
166             You can also look for information at:
167              
168             =over 4
169              
170             =item * RT: CPAN's request tracker (report bugs here)
171              
172             L
173              
174             =item * AnnoCPAN: Annotated CPAN documentation
175              
176             L
177              
178             =item * CPAN Ratings
179              
180             L
181              
182             =item * Search CPAN
183              
184             L
185              
186             =back
187              
188              
189             =head1 ACKNOWLEDGEMENTS
190              
191              
192             =head1 LICENSE AND COPYRIGHT
193              
194             Copyright 2012 "koorchik".
195              
196             This program is free software; you can redistribute it and/or modify it
197             under the terms of either: the GNU General Public License as published
198             by the Free Software Foundation; or the Artistic License.
199              
200             See http://dev.perl.org/licenses/ for more information.
201              
202              
203             =cut
204              
205             1; # End of Hash::Storage