File Coverage

blib/lib/Time/Duration/Patch/Millisecond.pm
Criterion Covered Total %
statement 35 38 92.1
branch 3 10 30.0
condition 1 2 50.0
subroutine 9 10 90.0
pod 0 4 0.0
total 48 64 75.0


line stmt bran cond sub pod time code
1             package Time::Duration::Patch::Millisecond;
2              
3 1     1   47955 use 5.010001;
  1         4  
  1         38  
4 1     1   6 use strict;
  1         2  
  1         36  
5 1     1   6 no warnings;
  1         1  
  1         44  
6              
7 1     1   879 use Module::Patch 0.12 qw();
  1         24123  
  1         29  
8 1     1   10 use base qw(Module::Patch);
  1         2  
  1         647  
9              
10             our $VERSION = '0.03'; # VERSION
11              
12             my $mod_version = qr/^1\./;
13              
14             sub concise($) {
15 2     2 0 82 my $string = shift;
16              
17 2         15 $string =~ s/\b(millisecond)s?\b/ms/g;
18              
19             # begin from T::D
20 2         6 $string =~ tr/,//d;
21 2         5 $string =~ s/\band\b//;
22 2         11 $string =~ s/\b(year|day|hour|minute|second)s?\b/substr($1,0,1)/eg;
  1         5  
23 2         15 $string =~ s/\s*(\d+)\s*/$1/g;
24             # end from T::D
25              
26 2         21 return $string;
27             }
28              
29             sub _separate {
30 4     4   153 my $ctx = shift;
31 4         6 my $remainder = abs($_[0]);
32 4         8 my $frac = $remainder - int($remainder);
33 4         12 my @wheel = $ctx->{orig}->($remainder);
34 4 50       79 if ($frac) {
35 4         38 push @wheel, ['millisecond', sprintf("%0.f", $frac*1000), 1000];
36             }
37 4         37 @wheel;
38             }
39              
40             # this is just like in T::D, except <= -1 and > 1 are replaced with < 0 and > 0.
41             sub interval_exact {
42 0     0 0 0 my $span = $_[0]; # interval, in seconds
43             # precision is ignored
44 0 0       0 my $direction = ($span < 0) ? $_[2] # what a neg number gets
    0          
45             : ($span > 0) ? $_[3] # what a pos number gets
46             : return $_[4]; # what zero gets
47 0         0 Time::Duration::_render($direction,
48             Time::Duration::_separate($span));
49             }
50              
51             # this is just like in T::D, except <= -1 and > 1 are replaced with < 0 and > 0.
52             sub interval {
53 2     2 0 62 my $span = $_[0]; # interval, in seconds
54 2   50     22 my $precision = int($_[1] || 0) || 2; # precision (default: 2)
55 2 50       9 my $direction = ($span < 0) ? $_[2] # what a neg number gets
    50          
56             : ($span > 0) ? $_[3] # what a pos number gets
57             : return $_[4]; # what zero gets
58 2         7 Time::Duration::_render($direction,
59             Time::Duration::_approximate($precision,
60             Time::Duration::_separate($span)));
61             }
62              
63             sub patch_data {
64             return {
65 1     1 0 43 v => 3,
66             patches => [
67             {
68             action => 'wrap',
69             mod_version => $mod_version,
70             sub_name => '_separate',
71             code => \&_separate,
72             },
73             {
74             action => 'replace', # wrap causes prototype mismatch
75             mod_version => $mod_version,
76             sub_name => 'concise',
77             code => \&concise,
78             },
79             {
80             action => 'replace',
81             mod_version => $mod_version,
82             sub_name => 'interval_exact',
83             code => \&interval_exact,
84             },
85             {
86             action => 'replace',
87             mod_version => $mod_version,
88             sub_name => 'interval',
89             code => \&interval,
90             },
91             ],
92             };
93             }
94              
95             1;
96             # ABSTRACT: (DEPRECATED) Make Time::Duration support milliseconds
97              
98              
99             __END__