File Coverage

blib/lib/Wikibase/Datatype/Print/Value/Time.pm
Criterion Covered Total %
statement 45 47 95.7
branch 18 20 90.0
condition 6 9 66.6
subroutine 9 9 100.0
pod 1 1 100.0
total 79 86 91.8


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