File Coverage

blib/lib/Flower/Chronos/Report.pm
Criterion Covered Total %
statement 93 95 97.8
branch 27 30 90.0
condition 16 24 66.6
subroutine 12 13 92.3
pod 0 4 0.0
total 148 166 89.1


line stmt bran cond sub pod time code
1             package Flower::Chronos::Report;
2              
3 2     2   65202 use strict;
  2         4  
  2         51  
4 2     2   9 use warnings;
  2         4  
  2         53  
5              
6 2     2   836 use Time::Piece;
  2         11467  
  2         9  
7 2     2   1119 use JSON ();
  2         12556  
  2         43  
8 2     2   12 use Digest::MD5 ();
  2         12  
  2         39  
9 2     2   560 use Flower::Chronos::Utils qw(parse_time);
  2         4  
  2         112  
10 2     2   1742 use Encode;
  2         22753  
  2         2043  
11              
12             sub new {
13 12     12 0 26646 my $class = shift;
14 12         41 my (%params) = @_;
15              
16 12         27 my $self = {};
17 12         25 bless $self, $class;
18              
19 12         38 $self->{log_file} = $params{log_file};
20 12         28 $self->{where} = $params{where};
21 12         26 $self->{group_by} = $params{group_by};
22 12         23 $self->{fields} = $params{fields};
23 12         22 $self->{from} = $params{from};
24 12         19 $self->{to} = $params{to};
25              
26 12         37 return $self;
27             }
28              
29             sub run {
30 12     12 0 2364 my $self = shift;
31              
32 12   100     129 my @group_by = split /\s*,\s*/, ($self->{group_by} || '');
33              
34 12         20 my $where_cb;
35 12 100       39 if (my $where = $self->{where}) {
36 1         10 $where =~ s{\$([a-z]+)}{\$_[0]->{$1}}g;
37 1         3 $where = "sub {no warnings; $where }";
38              
39 1 50   1   7 $where_cb = eval $where or die $@;
  1         1  
  1         63  
  1         117  
40             }
41              
42 12 50       402 open my $fh, '<', $self->{log_file} or die $!;
43              
44 12         42 my @from = (gmtime(time))[3 .. 5];
45 12         586 my $from = join '-', ($from[2] + 1900), ($from[1] + 1), $from[0];
46 12         38 $from = parse_time($from);
47 12         723 my $to = time;
48              
49 12 100       74 $from = parse_time($self->{from}) if defined $self->{from};
50 12 100       79 $to = parse_time($self->{to}) if $self->{to};
51              
52 12         64 my @records;
53 12         231 while (defined(my $line = <$fh>)) {
54 20         38 chomp $line;
55 20 100       50 next unless $line;
56              
57 17         26 my $record = eval { JSON::decode_json($line) };
  17         190  
58 17 100       52 next unless $record;
59              
60 14         24 my $start = $record->{_start};
61 14         22 my $end = $record->{_end};
62 14 50 33     103 next if !$start || !$end || $end < $start;
      33        
63              
64             next
65 14 100 66     84 unless ($start >= $from && $start <= $to)
      66        
      66        
66             || ($end >= $from && $end <= $to);
67 11 100       25 if ($start < $from) {
68 1         2 $start = $from;
69             }
70 11 100       24 if ($end > $to) {
71 1         7 $end = $to;
72             }
73              
74 11 100 100     81 next if $where_cb && !$where_cb->($record);
75              
76 10         23 $record->{_elapsed} = $end - $start;
77 10         23 $record->{_sig} = calculate_sig($record, @group_by);
78 10         62 push @records, $record;
79             }
80              
81 12         18 my %groups;
82 12         25 foreach my $record (@records) {
83 10 100       27 if (exists $groups{$record->{_sig}}) {
84 1         4 $groups{$record->{_sig}}->{_elapsed} += $record->{_elapsed};
85             }
86             else {
87 9         27 $groups{$record->{_sig}} = $record;
88             }
89             }
90              
91             my @sorted_sig =
92 12         38 sort { $groups{$b}->{_elapsed} <=> $groups{$a}->{_elapsed} } keys %groups;
  2         9  
93              
94 12         73 foreach my $sig (@sorted_sig) {
95 9         72 my $record = $groups{$sig};
96 9         24 $self->_print(sec2human($record->{_elapsed}), ' ');
97              
98 9   100     376 my @fields = split /\s*,\s*/, ($self->{fields} || '');
99 9 100       25 @fields = @group_by unless @fields;
100 9         18 foreach my $field (@fields) {
101 9         96 $self->_print("$field=$record->{$field} ");
102             }
103              
104 9         226 $self->_print("\n");
105             }
106             }
107              
108             sub calculate_sig {
109 11     11 0 1794 my ($record, @group_by) = @_;
110              
111 11 100       31 return '' unless @group_by;
112              
113 8         16 my $sig = '';
114 8         57 foreach my $group_by (@group_by) {
115 9   50     30 $record->{$group_by} //= '';
116 9         29 $sig .= $record->{$group_by} . ':';
117             }
118              
119 8         31 $sig = Encode::encode('UTF-8', $sig);
120 8         612 return Digest::MD5::md5_hex($sig);
121             }
122              
123             sub sec2human {
124 9     9 0 12 my $sec = shift;
125              
126             return
127 9         88 sprintf('%02d', int($sec / (24 * 60 * 60))) . 'd '
128             . sprintf('%02d', ($sec / (60 * 60)) % 24) . ':'
129             . sprintf('%02d', ($sec / 60) % 60) . ':'
130             . sprintf('%02d', $sec % 60);
131             }
132              
133             sub _print {
134 0     0     my $self = shift;
135              
136 0           print @_;
137             }
138              
139             1;