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   927895 use base qw(Exporter);
  44         149  
  44         4025  
4 44     44   302 use strict;
  44         100  
  44         900  
5 44     44   227 use warnings;
  44         107  
  44         1109  
6              
7 44     44   29696 use DateTime;
  44         16434586  
  44         1841  
8 44     44   1566 use English;
  44         7777  
  44         605  
9 44     44   23644 use Error::Pure qw(err);
  44         15671  
  44         2154  
10 44     44   438 use Readonly;
  44         124  
  44         27067  
11              
12             Readonly::Array our @EXPORT_OK => qw(print);
13              
14             our $VERSION = 0.12;
15              
16             sub print {
17 14     14 1 24594 my ($obj, $opts_hr) = @_;
18              
19             # Default options.
20 14 100       53 if (! defined $opts_hr) {
21 3         8 $opts_hr = {};
22             }
23 14 100       43 if (! exists $opts_hr->{'print_name'}) {
24 13         37 $opts_hr->{'print_name'} = 1;
25             }
26              
27 14 100       90 if (! $obj->isa('Wikibase::Datatype::Value::Time')) {
28 1         6 err "Object isn't 'Wikibase::Datatype::Value::Time'.";
29             }
30              
31 13 100 100     81 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         25 my $calendar;
37 12 100 66     116 if ($opts_hr->{'print_name'} && exists $opts_hr->{'cb'}) {
38 1   33     15 $calendar = $opts_hr->{'cb'}->get('label', $obj->calendarmodel) || $obj->calendarmodel;
39             } else {
40 11         49 $calendar = $obj->calendarmodel;
41             }
42              
43             # Convert to DateTime.
44 12         220 my $dt = _parse_date($obj->value);
45              
46 12         25 my $printed_date;
47              
48             # Day.
49 12 100 0     48 if ($obj->precision == 11) {
    50          
    100          
    50          
    0          
50 8         141 $printed_date = $dt->strftime("%e %B %Y");
51 8         730 $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         57 $printed_date = $dt->strftime("%Y");
60 2 100 66     66 if ($obj->before || $obj->after) {
61 1 50       13 my $before = $obj->before ? $dt->year - $obj->before : $dt->year;
62 1 50       24 my $after = $obj->after ? $dt->year + $obj->after : $dt->year;
63 1         25 $printed_date .= " ($before-$after)";
64             }
65              
66             # Decade.
67             } elsif ($obj->precision == 8) {
68 2         63 $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         188 return $printed_date.' ('.$calendar.')';
79             }
80              
81             sub _parse_date {
82 12     12   111 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       101 my $dt = DateTime->new(
    100          
86             'year' => int($year),
87             $month != 0 ? ('month' => $month) : (),
88             $day != 0 ? ('day' => $day) : (),
89             );
90              
91 12         3573 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              
112             =head1 SUBROUTINES
113              
114             =head2 C<print>
115              
116             my $pretty_print_string = print($obj, $opts_hr);
117              
118             Construct pretty print output for L<Wikibase::Datatype::Value::Time>
119             object.
120              
121             Returns string.
122              
123             =head1 ERRORS
124              
125             print():
126             Cannot parse datetime value.
127             Input string: %s
128             Object isn't 'Wikibase::Datatype::Value::Time'.
129             Option 'cb' must be a instance of Wikibase::Cache.
130             Unsupported precision '%s'.
131              
132             =head1 EXAMPLE1
133              
134             =for comment filename=create_and_print_value_time.pl
135              
136             use strict;
137             use warnings;
138              
139             use Wikibase::Datatype::Print::Value::Time;
140             use Wikibase::Datatype::Value::Time;
141              
142             # Object.
143             my $obj = Wikibase::Datatype::Value::Time->new(
144             'precision' => 11,
145             'value' => '+2020-09-01T00:00:00Z',
146             );
147              
148             # Print.
149             print Wikibase::Datatype::Print::Value::Time::print($obj)."\n";
150              
151             # Output:
152             # 1 September 2020 (Q1985727)
153              
154             =head1 EXAMPLE2
155              
156             =for comment filename=create_and_print_value_time_translated.pl
157              
158             use strict;
159             use warnings;
160              
161             use Wikibase::Cache;
162             use Wikibase::Cache::Backend::Basic;
163             use Wikibase::Datatype::Print::Value::Time;
164             use Wikibase::Datatype::Value::Time;
165              
166             # Object.
167             my $obj = Wikibase::Datatype::Value::Time->new(
168             'precision' => 11,
169             'value' => '+2020-09-01T00:00:00Z',
170             );
171              
172             # Cache object.
173             my $cache = Wikibase::Cache->new(
174             'backend' => 'Basic',
175             );
176              
177             # Print.
178             print Wikibase::Datatype::Print::Value::Time::print($obj, {
179             'cb' => $cache,
180             })."\n";
181              
182             # Output:
183             # 1 September 2020 (proleptic Gregorian calendar)
184              
185             =head1 DEPENDENCIES
186              
187             L<DateTime>,
188             L<English>,
189             L<Error::Pure>,
190             L<Exporter>,
191             L<Readonly>.
192              
193             =head1 SEE ALSO
194              
195             =over
196              
197             =item L<Wikibase::Datatype::Value::Time>
198              
199             Wikibase time value datatype.
200              
201             =back
202              
203             =head1 REPOSITORY
204              
205             L<https://github.com/michal-josef-spacek/Wikibase-Datatype-Print>
206              
207             =head1 AUTHOR
208              
209             Michal Josef Špaček L<mailto:skim@cpan.org>
210              
211             L<http://skim.cz>
212              
213             =head1 LICENSE AND COPYRIGHT
214              
215             © 2020-2023 Michal Josef Špaček
216              
217             BSD 2-Clause License
218              
219             =head1 VERSION
220              
221             0.12
222              
223             =cut