line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package DateTime::Format::Human::Duration; |
2
|
|
|
|
|
|
|
|
3
|
3
|
|
|
3
|
|
59189
|
use warnings; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
164
|
|
4
|
3
|
|
|
3
|
|
14
|
use strict; |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
177
|
|
5
|
|
|
|
|
|
|
require DateTime::Format::Human::Duration::Locale; |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
our $VERSION = '0.62'; |
8
|
|
|
|
|
|
|
|
9
|
3
|
|
|
3
|
|
14
|
use Carp qw/croak/; |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
2321
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
sub new { |
12
|
1
|
|
|
1
|
1
|
14
|
bless { 'locale_cache' => {} }, 'DateTime::Format::Human::Duration'; |
13
|
|
|
|
|
|
|
} |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
sub format_duration_between { |
16
|
0
|
|
|
0
|
1
|
|
my ($span, $dt, $dtb, %args) = @_; |
17
|
0
|
|
|
|
|
|
my $dur = $dt - $dtb; |
18
|
|
|
|
|
|
|
|
19
|
0
|
0
|
|
|
|
|
if (!exists $args{'locale'}) { |
20
|
0
|
|
|
|
|
|
$args{'locale'} = $dt->{'locale'}{'id'}; |
21
|
|
|
|
|
|
|
} |
22
|
|
|
|
|
|
|
|
23
|
0
|
|
|
|
|
|
return $span->format_duration($dur, %args); |
24
|
|
|
|
|
|
|
} |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
sub format_duration { |
27
|
0
|
|
|
0
|
1
|
|
my ($span, $duration, %args) = @_; |
28
|
|
|
|
|
|
|
|
29
|
0
|
|
|
|
|
|
my @default_units = qw(years months weeks days hours minutes seconds nanoseconds); |
30
|
|
|
|
|
|
|
|
31
|
0
|
0
|
|
|
|
|
my @units = $args{'units'} ? @{ $args{'units'} } : @default_units; |
|
0
|
|
|
|
|
|
|
32
|
0
|
0
|
|
|
|
|
if ($args{'precision'}) { |
33
|
|
|
|
|
|
|
# Reduce time resolution to requested precision |
34
|
0
|
|
|
|
|
|
for (my $i = 0; $i < scalar(@units); $i++) { |
35
|
0
|
0
|
|
|
|
|
next unless ($units[$i] eq $args{'precision'}); |
36
|
0
|
|
|
|
|
|
splice(@units, $i + 1); |
37
|
|
|
|
|
|
|
} |
38
|
0
|
0
|
|
|
|
|
croak('Useless precision') unless (@units); |
39
|
|
|
|
|
|
|
} |
40
|
|
|
|
|
|
|
|
41
|
0
|
|
|
|
|
|
my @duration_vals = $duration->in_units( @units ); |
42
|
0
|
|
|
|
|
|
my $i = 0; |
43
|
0
|
|
|
|
|
|
my %duration_vals = map { ($_ => $duration_vals[$i++]) } @units; |
|
0
|
|
|
|
|
|
|
44
|
0
|
|
|
|
|
|
my %positive_duration_vals = map { ($_ => abs $duration_vals{$_}) } keys %duration_vals; |
|
0
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
|
46
|
0
|
|
|
|
|
|
my $say = ''; |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
# $dta - $dtb: |
49
|
|
|
|
|
|
|
# if dta < dtb means past -> future (Duration units will have negatives) |
50
|
|
|
|
|
|
|
# else its either this absolute instant (no_time) or the past |
51
|
0
|
0
|
|
|
|
|
if ( grep { $_ < 0 } @duration_vals ) { |
|
0
|
|
|
|
|
|
|
52
|
0
|
0
|
|
|
|
|
if ( exists $args{'future'} ) { |
53
|
0
|
|
|
|
|
|
$say = $args{'future'} |
54
|
|
|
|
|
|
|
} |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
else { |
57
|
0
|
0
|
|
|
|
|
if ( exists $args{'past'} ) { |
58
|
0
|
|
|
|
|
|
$say = $args{'past'} |
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
#### |
63
|
|
|
|
|
|
|
## this is essentially the hashref that is returned from DateTime::Format::Human::Duration::en::get_human_span_hashref() : # |
64
|
|
|
|
|
|
|
#### |
65
|
0
|
|
|
|
|
|
my $setup = { |
66
|
|
|
|
|
|
|
'no_oxford_comma' => 0, |
67
|
|
|
|
|
|
|
'no_time' => 'no time', # The wait will be $formatted_duration |
68
|
|
|
|
|
|
|
'and' => 'and', |
69
|
|
|
|
|
|
|
'year' => 'year', |
70
|
|
|
|
|
|
|
'years' => 'years', |
71
|
|
|
|
|
|
|
'month' => 'month', |
72
|
|
|
|
|
|
|
'months' => 'months', |
73
|
|
|
|
|
|
|
'week' => 'week', |
74
|
|
|
|
|
|
|
'weeks' => 'weeks', |
75
|
|
|
|
|
|
|
'day' => 'day', |
76
|
|
|
|
|
|
|
'days' => 'days', |
77
|
|
|
|
|
|
|
'hour' => 'hour', |
78
|
|
|
|
|
|
|
'hours' => 'hours', |
79
|
|
|
|
|
|
|
'minute' => 'minute', |
80
|
|
|
|
|
|
|
'minutes' => 'minutes', |
81
|
|
|
|
|
|
|
'second' => 'second', |
82
|
|
|
|
|
|
|
'seconds' => 'seconds', |
83
|
|
|
|
|
|
|
'nanosecond' => 'nanosecond', |
84
|
|
|
|
|
|
|
'nanoseconds' => 'nanoseconds', |
85
|
|
|
|
|
|
|
}; |
86
|
|
|
|
|
|
|
|
87
|
0
|
|
|
|
|
|
my $locale = DateTime::Format::Human::Duration::Locale::calc_locale($span, $args{'locale'}); |
88
|
|
|
|
|
|
|
|
89
|
0
|
0
|
|
|
|
|
if($locale) { |
90
|
0
|
0
|
|
|
|
|
if ( ref $locale eq 'HASH' ) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
91
|
0
|
|
|
|
|
|
%{ $setup } = ( |
|
0
|
|
|
|
|
|
|
92
|
0
|
|
|
|
|
|
%{ $setup }, |
93
|
0
|
|
|
|
|
|
%{ $locale }, |
94
|
|
|
|
|
|
|
); |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
# get_human_span_from_units_array is deprecated, but we will still |
97
|
|
|
|
|
|
|
# support it. |
98
|
|
|
|
|
|
|
elsif ( my $get1 = $locale->can('get_human_span_from_units_array') ) { |
99
|
0
|
|
|
|
|
|
my @n = map { $positive_duration_vals{$_} } @default_units; |
|
0
|
|
|
|
|
|
|
100
|
0
|
|
|
|
|
|
return $get1->( @n, \%args ); |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
elsif ( my $get2 = $locale->can('get_human_span_from_units') ) { |
103
|
0
|
|
|
|
|
|
return $get2->( \%duration_vals, \%args ); |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
|
107
|
0
|
|
|
|
|
|
my @parts; |
108
|
0
|
|
|
|
|
|
for my $unit (@units) { |
109
|
0
|
|
|
|
|
|
my $val = $positive_duration_vals{$unit}; |
110
|
0
|
0
|
|
|
|
|
next unless $val; |
111
|
|
|
|
|
|
|
|
112
|
0
|
|
|
|
|
|
my $setup_key = $unit; |
113
|
0
|
0
|
|
|
|
|
if ($val == 1) { |
114
|
0
|
|
|
|
|
|
$setup_key =~ s/s$//; |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
|
117
|
0
|
|
|
|
|
|
push(@parts, $val . ' ' . $setup->{$setup_key}); |
118
|
0
|
0
|
|
|
|
|
if (exists $args{'significant_units'}) { |
119
|
0
|
0
|
|
|
|
|
last if scalar(@parts) == $args{'significant_units'}; |
120
|
|
|
|
|
|
|
} |
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
|
123
|
0
|
0
|
|
|
|
|
my $no_time = exists $args{'no_time'} ? $args{'no_time'} : $setup->{'no_time'}; |
124
|
0
|
0
|
|
|
|
|
return $no_time if !@parts; |
125
|
|
|
|
|
|
|
|
126
|
0
|
0
|
|
|
|
|
my $last = @parts > 1 ? pop(@parts): ''; |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
## We want to use the so-called Oxford comma to avoid ambiguity. |
129
|
|
|
|
|
|
|
## For that reason we make locale's specifically tell us they do not want it. |
130
|
0
|
0
|
|
|
|
|
my $string = $setup->{'no_oxford_comma'} |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
131
|
|
|
|
|
|
|
? join(', ', @parts) . ($last ? " $setup->{'and'} $last" : '') |
132
|
|
|
|
|
|
|
: join(', ', @parts) . (@parts > 1 ? ',' : '') . ($last ? " $setup->{'and'} $last" : '') |
133
|
|
|
|
|
|
|
; |
134
|
|
|
|
|
|
|
|
135
|
0
|
0
|
|
|
|
|
if ( $say ) { |
136
|
0
|
0
|
|
|
|
|
$string = $say =~ m{%s} ? sprintf($say, $string): "$say $string"; |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
0
|
|
|
|
|
|
return $string; |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
1; |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
__END__ |