File Coverage

blib/lib/BusyBird/Util.pm
Criterion Covered Total %
statement 141 164 85.9
branch 41 54 75.9
condition 21 27 77.7
subroutine 28 31 90.3
pod 4 10 40.0
total 235 286 82.1


line stmt bran cond sub pod time code
1             package BusyBird::Util;
2 17     17   222282 use strict;
  17         26  
  17         625  
3 17     17   71 use warnings;
  17         21  
  17         419  
4 17     17   72 use Scalar::Util qw(blessed weaken);
  17         20  
  17         1266  
5 17     17   73 use Carp;
  17         22  
  17         864  
6 17     17   71 use Exporter qw(import);
  17         57  
  17         384  
7 17     17   4974 use BusyBird::DateTime::Format;
  17         1272308  
  17         531  
8 17     17   6083 use BusyBird::Log qw(bblog);
  17         26  
  17         885  
9 17     17   5830 use BusyBird::SafeData qw(safed);
  17         35  
  17         844  
10 17     17   90 use DateTime;
  17         21  
  17         293  
11 17     17   165 use 5.10.0;
  17         45  
  17         639  
12 17     17   8705 use Future::Q 0.040;
  17         193933  
  17         468  
13 17     17   8840 use File::HomeDir;
  17         77955  
  17         1036  
14 17     17   101 use File::Spec;
  17         23  
  17         2128  
15              
16             our @EXPORT_OK =
17             qw(set_param expand_param config_directory config_file_path sort_statuses
18             split_with_entities future_of make_tracking vivifiable_as);
19             our @CARP_NOT = qw(Future::Q);
20              
21             sub set_param {
22 1616     1616 0 46081 my ($hashref, $params_ref, $key, $default, $is_mandatory) = @_;
23 1616 50 66     5889 if($is_mandatory && !defined($params_ref->{$key})) {
24 0         0 my $classname = blessed $hashref;
25 0         0 croak "ERROR: set_param in $classname: Parameter for '$key' is mandatory, but not supplied.";
26             }
27 1616 100       5331 $hashref->{$key} = (defined($params_ref->{$key}) ? $params_ref->{$key} : $default);
28             }
29              
30             sub export_ok_all_tags {
31 17     17   78 no strict "refs";
  17         25  
  17         6735  
32 8     8 0 45 my ($caller_package) = caller;
33 8         21 my $export_ok = \@{"${caller_package}::EXPORT_OK"};
  8         60  
34 8         17 my $export_tags = \%{"${caller_package}::EXPORT_TAGS"};
  8         38  
35 8         29 my @all = @$export_ok;
36 8         44 foreach my $tag (keys %$export_tags) {
37 16         32 my $exported = $export_tags->{$tag};
38 16         37 push(@all, @$exported);
39 16         44 push(@$export_ok, @$exported);
40             }
41 8         38 $export_tags->{all} = \@all;
42             }
43              
44             sub expand_param {
45 0     0 0 0 my ($param, @names) = @_;
46 0         0 my $refparam = ref($param);
47 0         0 my @result = ();
48 0 0       0 if($refparam eq 'ARRAY') {
    0          
49 0         0 @result = @$param;
50             }elsif($refparam eq 'HASH') {
51 0         0 @result = @{$param}{@names};
  0         0  
52             }else {
53 0         0 $result[0] = $param;
54             }
55 0 0       0 return wantarray ? @result : $result[0];
56             }
57              
58             sub config_directory {
59 0     0 0 0 return File::Spec->catfile(File::HomeDir->my_home, ".busybird");
60             }
61              
62             sub config_file_path {
63 0     0 0 0 my (@paths) = @_;
64 0         0 return File::Spec->catfile(config_directory, @paths);
65             }
66              
67             sub vivifiable_as {
68 71   100 71 0 350 return !defined($_[0]) || ref($_[0]) eq $_[1];
69             }
70              
71             sub _epoch_undef {
72 2916     2916   78528 my ($datetime_str) = @_;
73 2916         7012 my $dt = BusyBird::DateTime::Format->parse_datetime($datetime_str);
74 2916 100       1659430 return defined($dt) ? $dt->epoch : undef;
75             }
76              
77             sub _sort_compare {
78 3513     3513   2637 my ($a, $b) = @_;
79 3513 100 100     11642 if(defined($a) && defined($b)) {
    100 100        
    100 66        
80 2355         2212 return $b <=> $a;
81             }elsif(!defined($a) && defined($b)) {
82 73         104 return -1;
83             }elsif(defined($a) && !defined($b)) {
84 222         248 return 1;
85             }else {
86 863         965 return 0;
87             }
88             }
89              
90             sub sort_statuses {
91 92     92 1 10870 my ($statuses) = @_;
92 17     17   8225 use sort 'stable';
  17         7435  
  17         81  
93            
94 1458         17208 my @dt_statuses = map {
95 92         195 my $safe_status = safed($_);
96             [
97 1458         3307 $_,
98             _epoch_undef($safe_status->val("busybird", "acked_at")),
99             _epoch_undef($safe_status->val("created_at")),
100             ];
101             } @$statuses;
102 1458         2094 return [ map { $_->[0] } sort {
103 92         1489 foreach my $sort_key (1, 2) {
  1958         1749  
104 3513         4347 my $ret = _sort_compare($a->[$sort_key], $b->[$sort_key]);
105 3513 100       5906 return $ret if $ret != 0;
106             }
107 61         59 return 0;
108             } @dt_statuses];
109             }
110              
111             sub _create_text_segment {
112             return {
113 94     94   464 text => substr($_[0], $_[1], $_[2] - $_[1]),
114             start => $_[1],
115             end => $_[2],
116             type => $_[3],
117             entity => $_[4],
118             };
119             }
120              
121             sub split_with_entities {
122 32     32 1 15490 my ($text, $entities_hashref) = @_;
123 17     17   3902 use sort 'stable';
  17         29  
  17         61  
124 32 100       96 if(!defined($text)) {
125 1         181 croak "text must not be undef";
126             }
127 31 100       73 if(ref($entities_hashref) ne "HASH") {
128 12         31 return [_create_text_segment($text, 0, length($text))];
129             }
130              
131             ## create entity segments
132 19         24 my @entity_segments = ();
133 19         51 foreach my $entity_type (keys %$entities_hashref) {
134 50         54 my $entities = $entities_hashref->{$entity_type};
135 50 100       87 next if ref($entities) ne "ARRAY";
136 49         56 foreach my $entity (@$entities) {
137 46         106 my $se = safed($entity);
138 46         86 my $start = $se->val("indices", 0);
139 46         1504 my $end = $se->val("indices", 1);
140 46 100 100     1425 if(defined($start) && defined($end) && $start <= $end) {
      100        
141 41         62 push(@entity_segments, _create_text_segment(
142             $text, $start, $end, $entity_type, $entity
143             ));
144             }
145             }
146             }
147 19         53 @entity_segments = sort { $a->{start} <=> $b->{start} } @entity_segments;
  36         52  
148              
149             ## combine entity_segments with non-entity segments
150 19         18 my $pos = 0;
151 19         22 my @final_segments = ();
152 19         24 foreach my $entity_segment (@entity_segments) {
153 41 100       76 if($pos < $entity_segment->{start}) {
154 30         40 push(@final_segments, _create_text_segment(
155             $text, $pos, $entity_segment->{start}
156             ));
157             }
158 41         43 push(@final_segments, $entity_segment);
159 41         52 $pos = $entity_segment->{end};
160             }
161 19 100       45 if($pos < length($text)) {
162 11         19 push(@final_segments, _create_text_segment(
163             $text, $pos, length($text)
164             ));
165             }
166 19         62 return \@final_segments;
167             }
168              
169             sub future_of {
170 296     296 1 24412 my ($invocant, $method, %args) = @_;
171             return Future::Q->try(sub {
172 296 100   296   10752 croak "invocant parameter is mandatory" if not defined $invocant;
173 295 100       652 croak "method parameter is mandatory" if not defined $method;
174 294 100       1187 croak "invocant is not blessed" if not blessed $invocant;
175 293 100       1087 croak "no such method as $method" if not $invocant->can($method);
176 292         872 my $f = Future::Q->new();
177             $invocant->$method(%args, callback => sub {
178 287         7553 my ($error, @results) = @_;
179 287 100       536 if($error) {
180 6         23 $f->reject($error, 1);
181             }else {
182 281         1109 $f->fulfill(@results);
183             }
184 292         5409 });
185 287         14250 return $f;
186 296         1911 });
187             }
188              
189             sub make_tracking {
190 2     2 1 9 my ($tracking_timeline, $main_timeline) = @_;
191 2 50 33     24 if(!blessed($tracking_timeline) || !$tracking_timeline->isa("BusyBird::Timeline")) {
192 0         0 croak "tracking_timeline must be a BusyBird::Timeline.";
193             }
194 2 50 33     14 if(!blessed($main_timeline) || !$main_timeline->isa("BusyBird::Timeline")) {
195 0         0 croak "main_timeline must be a BusyBird::Timeline.";
196             }
197 2         6 my $name_tracking = $tracking_timeline->name;
198 2         4 my $name_main = $main_timeline->name;
199 2 50       6 if($name_tracking eq $name_main) {
200 0         0 croak "tracking_timeline and main_timeline must be different timelines.";
201             }
202 2         6 weaken(my $track = $tracking_timeline);
203             $tracking_timeline->add_filter_async(sub {
204 5     5   9 my ($statuses, $done) = @_;
205 5 50       14 if(!defined($track)) {
206 0         0 $done->($statuses);
207 0         0 return;
208             }
209             $track->contains(query => $statuses, callback => sub {
210 5         10 my ($error, $contained, $not_contained) = @_;
211 5 50       14 if(defined($error)) {
212 0         0 bblog("error", "tracking timeline '$name_tracking' contains() error: $error");
213 0         0 $done->($statuses);
214 0         0 return;
215             }
216             $main_timeline->add($not_contained, sub {
217 5         8 my ($error, $count) = @_;
218 5 50       13 if(defined($error)) {
219 0         0 bblog("error", "main timeline '$name_main' add() error: $error");
220             }
221 5         15 $done->($statuses);
222 5         38 });
223 5         35 });
224 2         15 });
225 2         13 return $tracking_timeline;
226             }
227              
228             1;
229              
230             __END__