File Coverage

blib/lib/Wikibase/Datatype/Print/Value/Time.pm
Criterion Covered Total %
statement 50 53 94.3
branch 24 30 80.0
condition 8 15 53.3
subroutine 9 9 100.0
pod 1 1 100.0
total 92 108 85.1


line stmt bran cond sub pod time code
1             package Wikibase::Datatype::Print::Value::Time;
2              
3 44     44   906875 use base qw(Exporter);
  44         128  
  44         4019  
4 44     44   289 use strict;
  44         103  
  44         897  
5 44     44   216 use warnings;
  44         108  
  44         1091  
6              
7 44     44   28296 use DateTime;
  44         16280704  
  44         1907  
8 44     44   1460 use English;
  44         7297  
  44         626  
9 44     44   23141 use Error::Pure qw(err);
  44         14612  
  44         2044  
10 44     44   449 use Readonly;
  44         111  
  44         26614  
11              
12             Readonly::Array our @EXPORT_OK => qw(print);
13              
14             our $VERSION = 0.13;
15              
16             sub print {
17 14     14 1 23639 my ($obj, $opts_hr) = @_;
18              
19             # Default options.
20 14 100       50 if (! defined $opts_hr) {
21 3         8 $opts_hr = {};
22             }
23 14 100       52 if (! exists $opts_hr->{'print_name'}) {
24 13         33 $opts_hr->{'print_name'} = 1;
25             }
26              
27 14 100       84 if (! $obj->isa('Wikibase::Datatype::Value::Time')) {
28 1         5 err "Object isn't 'Wikibase::Datatype::Value::Time'.";
29             }
30              
31 13 100 100     63 if (exists $opts_hr->{'cb'} && ! $opts_hr->{'cb'}->isa('Wikibase::Cache')) {
32 1         7 err "Option 'cb' must be a instance of Wikibase::Cache.";
33             }
34              
35             # Calendar.
36 12         22 my $calendar;
37 12 100 66     97 if ($opts_hr->{'print_name'} && exists $opts_hr->{'cb'}) {
38 1   33     5 $calendar = $opts_hr->{'cb'}->get('label', $obj->calendarmodel) || $obj->calendarmodel;
39             } else {
40 11         56 $calendar = $obj->calendarmodel;
41             }
42              
43             # Convert to DateTime.
44 12         221 my $dt = _parse_date($obj->value);
45              
46 12         38 my $printed_date;
47              
48             # Day.
49 12 100 0     60 if ($obj->precision == 11) {
    50          
    100          
    50          
    0          
50 8         152 $printed_date = $dt->strftime("%e %B %Y");
51 8         767 $printed_date =~ s/^\s+//ms;
52              
53             # Month.
54             } elsif ($obj->precision == 10) {
55 0         0 $printed_date = $dt->strftime("%B %Y");
56              
57             # Year.
58             } elsif ($obj->precision == 9) {
59 2         53 $printed_date = $dt->strftime("%Y");
60 2 100 66     61 if ($obj->before || $obj->after) {
61 1 50       12 my $before = $obj->before ? $dt->year - $obj->before : $dt->year;
62 1 50       22 my $after = $obj->after ? $dt->year + $obj->after : $dt->year;
63 1         23 $printed_date .= " ($before-$after)";
64             }
65              
66             # Decade.
67             } elsif ($obj->precision == 8) {
68 2         67 $printed_date = (int($dt->strftime('%Y') / 10) * 10).'s';
69              
70             # TODO Better precision print?
71             # 0 - billion years, 1 - hundred million years, ..., 6 - millenia, 7 - century
72             } elsif ($obj->precision <= 7 && $obj->precision >= 0) {
73 0         0 $printed_date = $dt->strftime("%Y");
74             } else {
75 0         0 err "Unsupported precision '".$obj->precision."'.";
76             }
77              
78 12         171 return $printed_date.' ('.$calendar.')';
79             }
80              
81             sub _parse_date {
82 12     12   94 my $date = shift;
83              
84 12         94 my ($year, $month, $day) = ($date =~ m/^([\+\-]\d+)\-(\d{2})\-(\d{2})T\d{2}:\d{2}:\d{2}Z$/ms);
85 12 100       100 my $dt = DateTime->new(
    100          
86             'year' => int($year),
87             $month != 0 ? ('month' => $month) : (),
88             $day != 0 ? ('day' => $day) : (),
89             );
90              
91 12         3497 return $dt;
92             }
93              
94             1;
95              
96             __END__
97              
98             =pod
99              
100             =encoding utf8
101              
102             =head1 NAME
103              
104             Wikibase::Datatype::Print::Value::Time - Wikibase time value pretty print helpers.
105              
106             =head1 SYNOPSIS
107              
108             use Wikibase::Datatype::Print::Value::Time qw(print);
109              
110             my $pretty_print_string = print($obj, $opts_hr);
111             my @pretty_print_lines = print($obj, $opts_hr);
112              
113             =head1 SUBROUTINES
114              
115             =head2 C<print>
116              
117             my $pretty_print_string = print($obj, $opts_hr);
118             my @pretty_print_lines = print($obj, $opts_hr);
119              
120             Construct pretty print output for L<Wikibase::Datatype::Value::Time>
121             object.
122              
123             Returns string in scalar context.
124             Returns list of lines in array context.
125              
126             =head1 ERRORS
127              
128             print():
129             Cannot parse datetime value.
130             Input string: %s
131             Object isn't 'Wikibase::Datatype::Value::Time'.
132             Option 'cb' must be a instance of Wikibase::Cache.
133             Unsupported precision '%s'.
134              
135             =head1 EXAMPLE1
136              
137             =for comment filename=create_and_print_value_time.pl
138              
139             use strict;
140             use warnings;
141              
142             use Wikibase::Datatype::Print::Value::Time;
143             use Wikibase::Datatype::Value::Time;
144              
145             # Object.
146             my $obj = Wikibase::Datatype::Value::Time->new(
147             'precision' => 11,
148             'value' => '+2020-09-01T00:00:00Z',
149             );
150              
151             # Print.
152             print Wikibase::Datatype::Print::Value::Time::print($obj)."\n";
153              
154             # Output:
155             # 1 September 2020 (Q1985727)
156              
157             =head1 EXAMPLE2
158              
159             =for comment filename=create_and_print_value_time_translated.pl
160              
161             use strict;
162             use warnings;
163              
164             use Wikibase::Cache;
165             use Wikibase::Cache::Backend::Basic;
166             use Wikibase::Datatype::Print::Value::Time;
167             use Wikibase::Datatype::Value::Time;
168              
169             # Object.
170             my $obj = Wikibase::Datatype::Value::Time->new(
171             'precision' => 11,
172             'value' => '+2020-09-01T00:00:00Z',
173             );
174              
175             # Cache object.
176             my $cache = Wikibase::Cache->new(
177             'backend' => 'Basic',
178             );
179              
180             # Print.
181             print Wikibase::Datatype::Print::Value::Time::print($obj, {
182             'cb' => $cache,
183             })."\n";
184              
185             # Output:
186             # 1 September 2020 (proleptic Gregorian calendar)
187              
188             =head1 DEPENDENCIES
189              
190             L<DateTime>,
191             L<English>,
192             L<Error::Pure>,
193             L<Exporter>,
194             L<Readonly>.
195              
196             =head1 SEE ALSO
197              
198             =over
199              
200             =item L<Wikibase::Datatype::Value::Time>
201              
202             Wikibase time value datatype.
203              
204             =back
205              
206             =head1 REPOSITORY
207              
208             L<https://github.com/michal-josef-spacek/Wikibase-Datatype-Print>
209              
210             =head1 AUTHOR
211              
212             Michal Josef Špaček L<mailto:skim@cpan.org>
213              
214             L<http://skim.cz>
215              
216             =head1 LICENSE AND COPYRIGHT
217              
218             © 2020-2023 Michal Josef Špaček
219              
220             BSD 2-Clause License
221              
222             =head1 VERSION
223              
224             0.13
225              
226             =cut