File Coverage

blib/lib/Hash/Storage/AutoTester.pm
Criterion Covered Total %
statement 15 101 14.8
branch 0 2 0.0
condition 0 3 0.0
subroutine 5 17 29.4
pod 0 7 0.0
total 20 130 15.3


line stmt bran cond sub pod time code
1             package Hash::Storage::AutoTester;
2              
3             our $VERSION = '0.02';
4              
5 3     3   1262 use strict;
  3         6  
  3         93  
6 3     3   12 use warnings;
  3         4  
  3         58  
7 3     3   23 use v5.10;
  3         8  
  3         93  
8              
9 3     3   29 use Test::More;
  3         24  
  3         21  
10 3     3   2425 use Test::Deep;
  3         20168  
  3         17  
11              
12             sub new {
13 0     0 0   my $class = shift;
14 0           my %args = @_;
15              
16 0           my $st = $args{storage};
17 0 0 0       die "WRONG STORAGE" unless $st && $st->isa('Hash::Storage');
18              
19 0           return bless { storage => $st }, $class;
20             }
21              
22             sub run {
23 0     0 0   my $self = shift;
24 0           $self->test_get();
25 0           $self->test_set();
26 0           $self->test_del();
27 0           $self->test_list();
28 0           $self->test_count();
29             }
30              
31             sub test_get {
32 0     0 0   my $self = shift;
33 0           my $st = $self->{storage};
34              
35 0           my %user1 = (
36             fname => 'Ivan',
37             lname => 'Ivanov',
38             age => '21',
39             gender => 'male'
40             );
41              
42 0           my %user2 = (
43             fname => 'Taras',
44             lname => 'Schevchenko',
45             age => '64',
46             gender => 'male'
47             );
48              
49             subtest 'Getting users' => sub {
50 0     0     ok( $st->set('user1', {%user1}), 'should create "user1" and return true' );
51 0           ok( $st->set('user2', {%user2}), 'should create "user2" and return true' );
52              
53 0           cmp_deeply($st->get('user1'), {%user1, _id => 'user1'}, 'should return "user1" attrs');
54 0           cmp_deeply($st->get('user2'), {%user2, _id => 'user2'}, 'should return "user2" attrs');
55 0           };
56             }
57              
58              
59             sub test_set {
60 0     0 0   my $self = shift;
61 0           my $st = $self->{storage};
62              
63 0           my %user1 = (
64             fname => 'Ivan',
65             lname => 'Ivanov',
66             age => '21',
67             gender => 'male'
68             );
69              
70              
71             subtest 'Set and Update user' => sub {
72 0     0     ok( $st->set('user1', {%user1}), 'should create "user1" and return true' );
73 0           cmp_deeply($st->get('user1'), {%user1, _id => 'user1'}, 'should return "user1" attrs');
74              
75 0           ok( $st->set('user1', {lname => 'NewLname', age => 33}), 'should update "user1" and return true' );
76 0           my $updated_user = $st->get('user1');
77              
78 0           is( $updated_user->{_id}, 'user1', '_id should should contain object id');
79 0           is( $updated_user->{fname}, 'Ivan', 'fname should be the same as before');
80 0           is( $updated_user->{lname}, 'NewLname', 'lname should contain new value - "NewLname"');
81 0           is( $updated_user->{age}, '33', 'age should contain new value - "33"');
82 0           is( $updated_user->{gender}, 'male', 'gender should be the same as before');
83 0           };
84             }
85              
86             sub test_del {
87 0     0 0   my $self = shift;
88 0           my $st = $self->{storage};
89              
90 0           my %user1 = (
91             fname => 'Ivan',
92             lname => 'Ivanov',
93             age => '21',
94             gender => 'male'
95             );
96              
97 0           my %user2 = (
98             fname => 'Taras',
99             lname => 'Schevchenko',
100             age => '64',
101             gender => 'male'
102             );
103              
104             subtest 'Deleting users' => sub {
105 0     0     ok( $st->set('user1', {%user1}), 'should create "user1" and return true' );
106 0           ok( $st->set('user2', {%user2}), 'should create "user2" and return true' );
107              
108 0           ok( $st->del('user1'), 'should delete "user1" and return true' );
109              
110 0           ok( !$st->get('user1'), 'should return undef because "user1" was deleted');
111 0           cmp_deeply($st->get('user2'), {%user2, _id => 'user2'}, 'should return not deleted "user2"');
112              
113 0           ok( $st->del('user2'), 'should delete "user2" and return true' );
114 0           ok( !$st->get('user1'), 'should return undef because "user2" was deleted');
115 0           };
116             }
117              
118              
119             sub test_list {
120 0     0 0   my $self = shift;
121 0           my $st = $self->{storage};
122              
123 0           my %user1 = (
124             fname => 'Ivan',
125             lname => 'Ivanov',
126             age => '30',
127             gender => 'male'
128             );
129              
130 0           my %user2 = (
131             fname => 'Taras',
132             lname => 'Leleka',
133             age => '64',
134             gender => 'male'
135             );
136              
137 0           my %user3 = (
138             fname => 'Taras',
139             lname => 'Schevchenko',
140             age => '22',
141             gender => 'male'
142             );
143              
144 0           my %user4 = (
145             fname => 'Petrik',
146             lname => 'Pyatochkin',
147             age => '8',
148             gender => 'male'
149             );
150              
151 0           my %user5 = (
152             fname => 'Lesya',
153             lname => 'Ukrainka',
154             age => '30',
155             gender => 'female'
156             );
157              
158 0           $st->set('user1', {%user1});
159 0           $user1{_id} = 'user1';
160              
161 0           $st->set('user2', {%user2});
162 0           $user2{_id} = 'user2';
163              
164 0           $st->set('user3', {%user3});
165 0           $user3{_id} = 'user3';
166              
167 0           $st->set('user4', {%user4});
168 0           $user4{_id} = 'user4';
169              
170 0           $st->set('user5', {%user5});
171 0           $user5{_id} = 'user5';
172              
173             subtest 'List users' => sub {
174 0     0     cmp_bag($st->list(), [\%user1, \%user2, \%user3, \%user4, \%user5], 'should return all users');
175 0           cmp_bag($st->list([fname => 'Ivan']), [\%user1], 'simple query should return user with fname="Ivan" users');
176 0           cmp_bag($st->list([fname => ['Ivan']]), [\%user1], 'should return user with fname="Ivan" users');
177 0           cmp_bag($st->list( where => [
178             fname => ['Ivan', 'Taras', 'Petrik', 'Lesya'],
179             age => {'>=' => 30 },
180             gender => { 'like' => 'ma%' },
181             ]), [\%user2, \%user1], 'complex query should return "Ivan" and "Taras" ');
182              
183 0           cmp_deeply($st->list(
184             where => [
185             fname => ['Ivan', 'Taras', 'Petrik', 'Lesya'],
186             age => {'>=' => 30 },
187             ],
188             sort_by => 'age DESC, fname ASC',
189             ), [\%user2, \%user1, \%user5], 'complex query with sort should return "Ivan" "Taras" ');
190 0           };
191             }
192              
193             sub test_count {
194 0     0 0   my $self = shift;
195 0           my $st = $self->{storage};
196              
197 0           my %user1 = (
198             fname => 'Ivan',
199             lname => 'Ivanov',
200             age => '30',
201             gender => 'male'
202             );
203              
204 0           my %user2 = (
205             fname => 'Taras',
206             lname => 'Leleka',
207             age => '64',
208             gender => 'male'
209             );
210              
211 0           my %user3 = (
212             fname => 'Taras',
213             lname => 'Schevchenko',
214             age => '22',
215             gender => 'male'
216             );
217              
218 0           my %user4 = (
219             fname => 'Petrik',
220             lname => 'Pyatochkin',
221             age => '8',
222             gender => 'male'
223             );
224              
225 0           my %user5 = (
226             fname => 'Lesya',
227             lname => 'Ukrainka',
228             age => '30',
229             gender => 'female'
230             );
231              
232 0           $st->set('user1', {%user1});
233 0           $st->set('user2', {%user2});
234 0           $st->set('user3', {%user3});
235 0           $st->set('user4', {%user4});
236 0           $st->set('user5', {%user5});
237              
238             subtest 'Count users' => sub {
239 0     0     is($st->count(), 5, 'should return 5 ');
240 0           is($st->count([fname => 'Ivan']), 1, 'should return 1');
241 0           is($st->count([fname => ['Ivan']]), 1, 'should return 1');
242 0           is($st->count( [
243             fname => ['Ivan', 'Taras', 'Petrik', 'Lesya'],
244             age => {'>=' => 30 },
245             gender => { 'like' => 'ma%' },
246             ]), 2, 'complex query: should return 2');
247              
248 0           is($st->count( [
249             fname => ['Ivan', 'Taras', 'Petrik', 'Lesya'],
250             age => {'>=' => 30 },
251             ]), 3, 'complex query: should return 3 ');
252 0           };
253             }
254              
255             1;