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   68878 use strict;
  2         5  
  2         48  
4 2     2   10 use warnings;
  2         4  
  2         49  
5              
6 2     2   837 use Time::Piece;
  2         11170  
  2         10  
7 2     2   1079 use JSON ();
  2         12457  
  2         41  
8 2     2   11 use Digest::MD5 ();
  2         11  
  2         41  
9 2     2   509 use Flower::Chronos::Utils qw(parse_time);
  2         4  
  2         112  
10 2     2   1747 use Encode;
  2         22137  
  2         2014  
11              
12             sub new {
13 12     12 0 26834 my $class = shift;
14 12         41 my (%params) = @_;
15              
16 12         20 my $self = {};
17 12         22 bless $self, $class;
18              
19 12         41 $self->{log_file} = $params{log_file};
20 12         24 $self->{where} = $params{where};
21 12         24 $self->{group_by} = $params{group_by};
22 12         25 $self->{fields} = $params{fields};
23 12         21 $self->{from} = $params{from};
24 12         17 $self->{to} = $params{to};
25              
26 12         38 return $self;
27             }
28              
29             sub run {
30 12     12 0 2334 my $self = shift;
31              
32 12   100     109 my @group_by = split /\s*,\s*/, ($self->{group_by} || '');
33              
34 12         18 my $where_cb;
35 12 100       37 if (my $where = $self->{where}) {
36 1         9 $where =~ s{\$([a-z]+)}{\$_[0]->{$1}}g;
37 1         4 $where = "sub {no warnings; $where }";
38              
39 1 50   1   7 $where_cb = eval $where or die $@;
  1         2  
  1         61  
  1         109  
40             }
41              
42 12 50       399 open my $fh, '<', $self->{log_file} or die $!;
43              
44 12         41 my @from = (gmtime(time))[3 .. 5];
45 12         592 my $from = join '-', ($from[2] + 1900), ($from[1] + 1), $from[0];
46 12         34 $from = parse_time($from);
47 12         704 my $to = time;
48              
49 12 100       75 $from = parse_time($self->{from}) if defined $self->{from};
50 12 100       77 $to = parse_time($self->{to}) if $self->{to};
51              
52 12         60 my @records;
53 12         294 while (defined(my $line = <$fh>)) {
54 20         30 chomp $line;
55 20 100       49 next unless $line;
56              
57 17         25 my $record = eval { JSON::decode_json($line) };
  17         132  
58 17 100       56 next unless $record;
59              
60 14         21 my $start = $record->{_start};
61 14         18 my $end = $record->{_end};
62 14 50 33     104 next if !$start || !$end || $end < $start;
      33        
63              
64             next
65 14 100 66     85 unless ($start >= $from && $start <= $to)
      66        
      66        
66             || ($end >= $from && $end <= $to);
67 11 100       24 if ($start < $from) {
68 1         3 $start = $from;
69             }
70 11 100       21 if ($end > $to) {
71 1         3 $end = $to;
72             }
73              
74 11 100 100     83 next if $where_cb && !$where_cb->($record);
75              
76 10         21 $record->{_elapsed} = $end - $start;
77 10         21 $record->{_sig} = calculate_sig($record, @group_by);
78 10         59 push @records, $record;
79             }
80              
81 12         18 my %groups;
82 12         19 foreach my $record (@records) {
83 10 100       26 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         39 sort { $groups{$b}->{_elapsed} <=> $groups{$a}->{_elapsed} } keys %groups;
  2         22  
93              
94 12         70 foreach my $sig (@sorted_sig) {
95 9         69 my $record = $groups{$sig};
96 9         22 $self->_print(sec2human($record->{_elapsed}), ' ');
97              
98 9   100     380 my @fields = split /\s*,\s*/, ($self->{fields} || '');
99 9 100       22 @fields = @group_by unless @fields;
100 9         17 foreach my $field (@fields) {
101 9         95 $self->_print("$field=$record->{$field} ");
102             }
103              
104 9         301 $self->_print("\n");
105             }
106             }
107              
108             sub calculate_sig {
109 11     11 0 1347 my ($record, @group_by) = @_;
110              
111 11 100       34 return '' unless @group_by;
112              
113 8         13 my $sig = '';
114 8         16 foreach my $group_by (@group_by) {
115 9   50     25 $record->{$group_by} //= '';
116 9         25 $sig .= $record->{$group_by} . ':';
117             }
118              
119 8         28 $sig = Encode::encode('UTF-8', $sig);
120 8         568 return Digest::MD5::md5_hex($sig);
121             }
122              
123             sub sec2human {
124 9     9 0 12 my $sec = shift;
125              
126             return
127 9         87 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;