File Coverage

blib/lib/BusyBird/StatusStorage/Memory.pm
Criterion Covered Total %
statement 169 210 80.4
branch 81 98 82.6
condition 23 26 88.4
subroutine 25 32 78.1
pod 6 6 100.0
total 304 372 81.7


line stmt bran cond sub pod time code
1             package BusyBird::StatusStorage::Memory;
2 2     2   121148 use v5.8.0;
  2         7  
  2         94  
3 2     2   11 use strict;
  2         4  
  2         75  
4 2     2   10 use warnings;
  2         4  
  2         82  
5 2     2   14 use parent ('BusyBird::StatusStorage');
  2         4  
  2         17  
6 2     2   165 use BusyBird::Util qw(set_param sort_statuses);
  2         4  
  2         168  
7 2     2   13 use BusyBird::Log qw(bblog);
  2         2  
  2         99  
8 2     2   875 use BusyBird::StatusStorage::Common qw(contains ack_statuses get_unacked_counts);
  2         4  
  2         192  
9 2     2   14 use BusyBird::DateTime::Format;
  2         3  
  2         48  
10 2     2   762 use Storable qw(dclone);
  2         3031  
  2         186  
11 2     2   19 use Carp;
  2         3  
  2         134  
12 2     2   13 use List::Util qw(min);
  2         3  
  2         152  
13 2     2   641 use JSON;
  2         9721  
  2         12  
14 2     2   294 use Try::Tiny;
  2         2  
  2         555  
15              
16             sub new {
17 3     3 1 1635 my ($class, %options) = @_;
18 3         20 my $self = bless {
19             timelines => {}, ## timelines should always be sorted.
20             }, $class;
21 3         28 $self->set_param(\%options, 'max_status_num', 2000);
22 3 50       18 if($self->{max_status_num} <= 0) {
23 0         0 croak "max_status_num option must be bigger than 0.";
24             }
25 3         16 return $self;
26             }
27              
28             sub _log {
29 0     0   0 my ($self, $level, $msg) = @_;
30 0         0 bblog($level, $msg);
31             }
32              
33             sub _index {
34 1057     1057   1652 my ($self, $timeline, $id) = @_;
35 1057 100       2772 return -1 if not defined($self->{timelines}{$timeline});
36 1012         1310 my $tl = $self->{timelines}{$timeline};
37 1012         2909 my @ret = grep { $tl->[$_]{id} eq $id } 0..$#$tl;
  25080         38863  
38 1012 50       2935 confess "multiple IDs in timeline $timeline." if int(@ret) >= 2;
39 1012 100       2688 return int(@ret) == 0 ? -1 : $ret[0];
40             }
41              
42             sub _acked {
43 4930     4930   4270 my ($self, $status) = @_;
44 2     2   9 no autovivification;
  2         4  
  2         11  
45 4930         17422 return $status->{busybird}{acked_at};
46             }
47              
48             sub save {
49 0     0 1 0 my ($self, $filepath) = @_;
50 0 0       0 if(not defined($filepath)) {
51 0         0 croak '$filepath is not specified.';
52             }
53 0         0 my $file;
54 0 0       0 if(!open $file, ">", $filepath) {
55 0         0 $self->_log("error", "Cannot open $filepath to write.");
56 0         0 return 0;
57             }
58 0         0 my $success;
59             try {
60 0     0   0 print $file encode_json($self->{timelines});
61 0         0 $success = 1;
62             }catch {
63 0     0   0 my $e = shift;
64 0         0 $self->_log("error", "Error while saving: $e");
65 0         0 $success = 0;
66 0         0 };
67 0         0 close $file;
68 0         0 return $success;
69             }
70              
71             sub load {
72 0     0 1 0 my ($self, $filepath) = @_;
73 0 0       0 if(not defined($filepath)) {
74 0         0 croak '$filepath is not specified.';
75             }
76 0         0 my $file;
77 0 0       0 if(!open $file, "<", $filepath) {
78 0         0 $self->_log("notice", "Cannot open $filepath to read");
79 0         0 return 0;
80             }
81 0         0 my $success;
82             try {
83 0     0   0 my $text = do { local $/; <$file> };
  0         0  
  0         0  
84 0         0 $self->{timelines} = decode_json($text);
85 0         0 $success = 1;
86             }catch {
87 0     0   0 my $e = shift;
88 0         0 $self->_log("error", "Error while loading: $e");
89 0         0 $success = 0;
90 0         0 };
91 0         0 close $file;
92 0         0 return $success;
93             }
94              
95             sub _is_timestamp_format_ok {
96 1799     1799   2483 my ($timestamp_str) = @_;
97 1799 100       5029 return 1 if not defined $timestamp_str;
98            
99             ## It is very inefficient to parse $timestamp_str to check its
100             ## format, because creating a DateTime object takes long time. We
101             ## do it because BB::SS::Memory is just a reference
102             ## implementation.
103 1318         3993 return defined(BusyBird::DateTime::Format->parse_datetime($timestamp_str));
104             }
105              
106             sub put_statuses {
107 121     121 1 24821 my ($self, %args) = @_;
108 121 100       612 croak 'timeline arg is mandatory' if not defined $args{timeline};
109 120         266 my $timeline = $args{timeline};
110 120 100 100     1143 if(!defined($args{mode}) ||
      66        
      66        
111             ($args{mode} ne 'insert'
112             && $args{mode} ne 'update' && $args{mode} ne 'upsert')) {
113 1         117 croak 'mode arg must be insert/update/upsert';
114             }
115 119         262 my $mode = $args{mode};
116 119         190 my $statuses;
117 119 100       867 if(!defined($args{statuses})) {
    100          
    50          
118 1         121 croak 'statuses arg is mandatory';
119             }elsif(ref($args{statuses}) eq 'HASH') {
120 28         70 $statuses = [ $args{statuses} ];
121             }elsif(ref($args{statuses}) eq 'ARRAY') {
122 90         201 $statuses = $args{statuses};
123             }else {
124 0         0 croak 'statuses arg must be STATUS/ARRAYREF_OF_STATUSES';
125             }
126 118         386 foreach my $s (@$statuses) {
127 2     2   1221 no autovivification;
  2         3  
  2         8  
128 919 100       408648 croak "{id} field is mandatory in statuses" if not defined $s->{id};
129 904 100 100     5376 croak "{busybird} field must be a hash-ref if present" if defined($s->{busybird}) && ref($s->{busybird}) ne "HASH";
130 901 100       2098 croak "{created_at} field must be parsable by BusyBird::DateTime::Format" if !_is_timestamp_format_ok($s->{created_at});
131 898         889050 my $acked_at = $s->{busybird}{acked_at}; ## avoid autovivification
132 898 100       2472 croak "{busybird}{acked_at} field must be parsable by BusyBird::DateTime::Format" if !_is_timestamp_format_ok($acked_at);
133             }
134 94         33960 my $put_count = 0;
135 94         481 foreach my $status_index (reverse 0 .. $#$statuses) {
136 880         1252 my $s = $statuses->[$status_index];
137 880         2359 my $tl_index = $self->_index($timeline, $s->{id});
138 880         1268 my $existent = ($tl_index >= 0);
139 880 100 100     5108 next if ($mode eq 'insert' && $existent) || ($mode eq 'update' && !$existent);
      100        
      66        
140 869         1007 my $is_insert = ($mode eq 'insert');
141 869 100       1495 if($mode eq 'upsert') {
142 24         24 $is_insert = (!$existent);
143             }
144 869 100       1268 if($is_insert) {
145 548         451 unshift(@{$self->{timelines}{$timeline}}, dclone($s));
  548         9546  
146             }else {
147             ## update
148 321         7064 $self->{timelines}{$timeline}[$tl_index] = dclone($s);
149             }
150 869         2187 $put_count++;
151             }
152 94 100       448 if($put_count > 0) {
153 90         682 $self->{timelines}{$timeline} = sort_statuses($self->{timelines}{$timeline});
154 90 100       322 if(int(@{$self->{timelines}{$timeline}}) > $self->{max_status_num}) {
  90         722  
155 3         6 splice(@{$self->{timelines}{$timeline}}, -(int(@{$self->{timelines}{$timeline}}) - $self->{max_status_num}));
  3         11  
  3         27  
156             }
157             }
158 94 50       454 if($args{callback}) {
159 94         309 @_ = (undef, $put_count);
160 94         800 goto $args{callback};
161             }
162             }
163              
164             sub delete_statuses {
165 58     58 1 14133 my ($self, %args) = @_;
166 58 100       488 croak 'timeline arg is mandatory' if not defined $args{timeline};
167 57 100       339 croak 'ids arg is mandatory' if not exists $args{ids};
168 56         101 my $timeline = $args{timeline};
169 56         95 my $ids = $args{ids};
170 56 100       212 if(defined($ids)) {
171 7 100       35 if(!ref($ids)) {
    50          
172 2         6 $ids = [$ids];
173             }elsif(ref($ids) eq 'ARRAY') {
174 5 100       14 croak "ids arg array must not contain undef" if grep { !defined($_) } @$ids;
  14         153  
175             }else {
176 0         0 croak "ids must be undef/ID/ARRAYREF_OF_IDS";
177             }
178             }
179 55 100       258 if(!$self->{timelines}{$timeline}) {
180 14 50       50 if($args{callback}) {
181 14         40 @_ = (undef, 0);
182 14         63 goto $args{callback};
183             }
184 0         0 return;
185             }
186 41         74 my $delete_num = 0;
187 41 100       122 if(defined($ids)) {
188 5         13 foreach my $id (@$ids) {
189 8         26 my $tl_index = $self->_index($timeline, $id);
190 8 100       27 last if $tl_index < 0;
191 7         7 splice(@{$self->{timelines}{$timeline}}, $tl_index, 1);
  7         22  
192 7         28 $delete_num++;
193             }
194             }else {
195 36 50       144 if(defined($self->{timelines}{$timeline})) {
196 36         57 $delete_num = @{$self->{timelines}{$timeline}};
  36         99  
197 36         543 delete $self->{timelines}{$timeline};
198             }
199             }
200 41 50       164 if($args{callback}) {
201 41         126 @_ = (undef, $delete_num);
202 41         197 goto $args{callback};
203             }
204             }
205              
206             sub get_statuses {
207 538     538 1 27190 my ($self, %args) = @_;
208 538 100       2102 croak 'timeline arg is mandatory' if not defined $args{timeline};
209 537 100       1937 croak 'callback arg is mandatory' if not defined $args{callback};
210 536         968 my $timeline = $args{timeline};
211 536 100       2207 if(!$self->{timelines}{$timeline}) {
212 68         160 @_ = (undef, []);
213 68         286 goto $args{callback};
214             }
215 468   100     1638 my $ack_state = $args{ack_state} || 'any';
216 468         741 my $max_id = $args{max_id};
217 468 50       1336 my $count = defined($args{count}) ? $args{count} : 20;
218             my $ack_test = $ack_state eq 'unacked' ? sub {
219 2866     2866   3636 !$self->_acked(shift);
220             } : $ack_state eq 'acked' ? sub {
221 2064     2064   2694 $self->_acked(shift);
222 468 100   3121   2753 } : sub { 1 };
  3121 100       8611  
223 468         895 my $start_index;
224 468 100       1170 if(defined($max_id)) {
225 169         526 my $tl_index = $self->_index($timeline, $max_id);
226 169 100       384 if($tl_index < 0) {
227 23         63 @_ = (undef, []);
228 23         122 goto $args{callback};
229             }
230 146         290 my $s = $self->{timelines}{$timeline}[$tl_index];
231 146 100       401 if(!$ack_test->($s)) {
232 40         80 @_ = (undef, []);
233 40         222 goto $args{callback};
234             }
235 106         178 $start_index = $tl_index;
236             }
237             my @indice = grep {
238 7905 100 100     12648 if(!$ack_test->($self->{timelines}{$timeline}[$_])) {
  405 100       1773  
239 2283         2991 0;
240             }elsif(defined($start_index) && $_ < $start_index) {
241 726         852 0;
242             }else {
243 4896         6462 1;
244             }
245 405         823 } 0 .. $#{$self->{timelines}{$timeline}};
246 405 100       1609 $count = int(@indice) if $count eq 'all';
247 405         1639 $count = min($count, int(@indice));
248 4382         57493 my $result_statuses = $count <= 0 ? [] : [ map {
249 405 100       1786 dclone($self->{timelines}{$timeline}[$_])
250             } @indice[0 .. ($count-1)] ];
251              
252 405         1333 @_ = (undef, $result_statuses);
253 405         3435 goto $args{callback};
254             }
255              
256             1;
257              
258             __END__