File Coverage

blib/lib/Test2/Util/Times.pm
Criterion Covered Total %
statement 40 41 97.5
branch 8 10 80.0
condition 3 5 60.0
subroutine 6 6 100.0
pod 1 2 50.0
total 58 64 90.6


line stmt bran cond sub pod time code
1             package Test2::Util::Times;
2 2     2   381 use strict;
  2         3  
  2         56  
3 2     2   10 use warnings;
  2         3  
  2         75  
4              
5 2     2   12 use List::Util qw/sum/;
  2         4  
  2         188  
6              
7             our $VERSION = '0.000153';
8              
9             our @EXPORT_OK = qw/render_bench render_duration/;
10 2     2   13 use base 'Exporter';
  2         13  
  2         1032  
11              
12             sub render_duration {
13 7     7 0 13 my $time;
14 7 50       22 if (@_ == 1) {
15 0         0 ($time) = @_;
16             }
17             else {
18 7         14 my ($start, $end) = @_;
19 7         20 $time = $end - $start;
20             }
21              
22 7 100       42 return sprintf('%1.5fs', $time) if $time < 10;
23 4 100       19 return sprintf('%2.4fs', $time) if $time < 60;
24              
25 3         26 my $msec = substr(sprintf('%0.2f', $time - int($time)), -2, 2);
26 3         7 my $secs = $time % 60;
27 3         7 my $mins = int($time / 60) % 60;
28 3         7 my $hours = int($time / 60 / 60) % 24;
29 3         6 my $days = int($time / 60 / 60 / 24);
30              
31 3         12 my @units = (qw/d h m/, '');
32              
33 3         5 my $duration = '';
34 3         8 for my $t ($days, $hours, $mins, $secs) {
35 12         20 my $u = shift @units;
36 12 100 66     42 next unless $t || $duration;
37 9         83 $duration = join ':' => grep { length($_) } $duration, sprintf('%02u%s', $t, $u);
  18         47  
38             }
39              
40 3   50     13 $duration ||= '0';
41 3 50       12 $duration .= ".$msec" if int($msec);
42 3         6 $duration .= 's';
43              
44 3         7 return $duration;
45             }
46              
47             sub render_bench {
48 6     6 1 32 my ($start, $end, $user, $system, $cuser, $csystem) = @_;
49              
50 6         16 my $duration = render_duration($start, $end);
51              
52 6         82 my $bench = sprintf(
53             "%s on wallclock (%5.2f usr %5.2f sys + %5.2f cusr %5.2f csys = %5.2f CPU)",
54             $duration, $user, $system, $cuser, $csystem, sum($user, $system, $cuser, $csystem),
55             );
56 6         74 $bench =~ s/\s+/ /g;
57 6         53 $bench =~ s/(\(|\))\s+/$1/g;
58              
59 6         31 return $bench;
60             }
61              
62             1;
63              
64             =pod
65              
66             =encoding UTF-8
67              
68             =head1 NAME
69              
70             Test2::Util::Times - Format timing/benchmark information.
71              
72             =head1 DESCRIPTION
73              
74             This modules exports tools for rendering timing data at the end of tests.
75              
76             =head1 EXPORTS
77              
78             All exports are optional. You must specify subs to import.
79              
80             =over 4
81              
82             =item $str = render_bench($start, $end, $user, $system, $cuser, $csystem)
83              
84             =item $str = render_bench($start, time(), times())
85              
86             This will produce a string like one of these (Note these numbers are completely
87             made up). I
88              
89             0.12345s on wallclock (0.05 usr 0.00 sys + 0.00 cusr 0.00 csys = 0.05 CPU)
90              
91             11.1234s on wallclock (0.05 usr 0.00 sys + 0.00 cusr 0.00 csys = 0.05 CPU)
92              
93             01m:54.45s on wallclock (0.05 usr 0.00 sys + 0.00 cusr 0.00 csys = 0.05 CPU)
94              
95             18h:22m:54.45s on wallclock (0.05 usr 0.00 sys + 0.00 cusr 0.00 csys = 0.05 CPU)
96              
97             04d:18h:22m:54.45s on wallclock (0.05 usr 0.00 sys + 0.00 cusr 0.00 csys = 0.05 CPU)
98              
99             The first 2 arguments are the C<$start> and C<$end> times in seconds (as
100             returned by C or C).
101              
102             The last 4 arguments are timing information as returned by the C
103             function.
104              
105             =back
106              
107             =head1 SOURCE
108              
109             The source code repository for Test2-Suite can be found at
110             F.
111              
112             =head1 MAINTAINERS
113              
114             =over 4
115              
116             =item Chad Granum Eexodist@cpan.orgE
117              
118             =back
119              
120             =head1 AUTHORS
121              
122             =over 4
123              
124             =item Chad Granum Eexodist@cpan.orgE
125              
126              
127             =back
128              
129             =head1 COPYRIGHT
130              
131             Copyright 2018 Chad Granum Eexodist@cpan.orgE.
132              
133             This program is free software; you can redistribute it and/or
134             modify it under the same terms as Perl itself.
135              
136             See F
137              
138             =cut