| 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; |