File Coverage

blib/lib/Org/Element/Timestamp.pm
Criterion Covered Total %
statement 65 79 82.2
branch 29 56 51.7
condition 21 27 77.7
subroutine 8 9 88.8
pod 3 3 100.0
total 126 174 72.4


line stmt bran cond sub pod time code
1             package Org::Element::Timestamp;
2              
3 12     12   1387 use 5.010;
  12         40  
4 12     12   62 use locale;
  12         30  
  12         89  
5 12     12   5979 use utf8;
  12         198  
  12         84  
6 12     12   395 use Moo;
  12         27  
  12         89  
7 12     12   4076 no if $] >= 5.021_006, warnings => "locale";
  12         31  
  12         144  
8             extends 'Org::Element';
9             with 'Org::ElementRole';
10             with 'Org::ElementRole::Inline';
11              
12             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
13             our $DATE = '2023-08-05'; # DATE
14             our $DIST = 'Org-Parser'; # DIST
15             our $VERSION = '0.560'; # VERSION
16              
17             my @attrs = (qw/datetime has_time event_duration recurrence is_active/);
18             for (@attrs) {
19             has $_ => (is => 'rw', clearer=>"clear_$_");
20             before $_ => sub {
21             my $self = shift;
22             return unless defined $self->_is_parsed; # never been parsed
23             $self->_parse_timestamp($self->_str)
24             unless $self->_is_parsed; # has been reset, re-set
25             };
26             }
27              
28             has _repeater => (is => 'rw'); # stores the raw repeater spec, for as_string
29             has _warning_period => (is => 'rw'); # raw warning period spec, for as_string
30             has _is_parsed => (is => 'rw');
31              
32             sub clear_parse_result {
33 1     1 1 1247 my $self = shift;
34 1 50       6 return unless defined $self->_is_parsed; # never been parsed
35 1         4 for (@attrs) { my $m = "clear_$_"; $self->$m }
  5         52  
  5         116  
36 1         10 $self->_is_parsed(0);
37             }
38              
39             our @dow = (undef, qw(Mon Tue Wed Thu Fri Sat Sun));
40              
41             sub as_string {
42 18     18 1 11782 my ($self) = @_;
43 18 50       203 return $self->_str if $self->_str;
44 0         0 my $dt = $self->datetime;
45 0         0 my ($hour2, $min2);
46 0 0       0 if ($self->event_duration) {
47 0         0 my $hour = $dt->hour;
48 0         0 my $min = $dt->minute;
49 0         0 my $mins = $self->event_duration / 60;
50 0         0 $min2 = $min + $mins;
51 0         0 my $hours = int ($min2 / 60);
52 0         0 $hour2 = $hour + $hours;
53 0         0 $min2 = $min2 % 60;
54             }
55 0 0       0 join("",
    0          
    0          
    0          
    0          
    0          
56             $self->is_active ? "<" : "[",
57             $dt->ymd, " ",
58             $dow[$dt->day_of_week],
59             $self->has_time ? (
60             " ",
61             sprintf("%02d:%02d", $dt->hour, $dt->minute),
62             defined($hour2) ? (
63             "-",
64             sprintf("%02d:%02d", $hour2, $min2),
65             ) : (),
66             $self->_repeater ? (
67             " ",
68             $self->_repeater,
69             ) : (),
70             $self->_warning_period ? (
71             " ",
72             $self->_warning_period,
73             ) : (),
74             ) : (),
75             $self->is_active ? ">" : "]",
76             );
77             }
78              
79             sub as_text {
80 0     0 1 0 goto \&as_string;
81             }
82              
83             sub _parse_timestamp {
84 70     70   9920 require DateTime;
85 70         4833840 require DateTime::Event::Recurrence;
86 70         606456 my ($self, $str, $opts) = @_;
87 70         308 $self->_is_parsed(undef); # to avoid deep recursion
88 70   100     332 $opts //= {};
89 70   100     399 $opts->{allow_event_duration} //= 1;
90 70   100     298 $opts->{allow_repeater} //= 1;
91              
92 70         254 my $num_re = qr/\d+(?:\.\d+)?/;
93              
94 70         201 my $dow_re = qr/\w{1,3} | # common, chinese 四, english thu
95             \w{2,3}\. # french mer., german Mi.
96             /x;
97              
98 70 50       2643 $str =~ /^(?<open_bracket> \[|<)
99             (?<year> \d{4})-(?<mon> \d{2})-(?<day> \d{2})
100             (?:
101             (?:\s* (?<dow> $dow_re) \s*)?
102             (?:\s+
103             (?<hour> \d{2}):(?<min> \d{2})
104             (?:-
105             (?<event_duration>
106             (?<hour2> \d{2}):(?<min2> \d{2}))
107             )?
108             )?
109             (?:\s+(?<repeater>
110             (?<repeater_prefix> \+\+|\.\+|\+)
111             (?<repeater_interval> $num_re)
112             (?<repeater_unit> [dwmy])
113             (?:\/(?<repeater_interval_max> $num_re)
114             (?<repeater_unit_max> [dwmy]))?
115             )
116             )?
117             (?:\s+(?<warning_period>
118             -
119             (?<warning_period_interval> $num_re)
120             (?<warning_period_unit> [dwmy])
121             )
122             )?
123             )?
124             \s* (?<close_bracket> \]|>)
125             $/x
126             or $self->die("Can't parse timestamp string: $str");
127             # just for sanity. usually doesn't happen though because Document gives us
128             # either "[...]" or "<...>"
129             $self->die("Mismatch open/close brackets in timestamp: $str")
130             if $+{open_bracket} eq '<' && $+{close_bracket} eq ']' ||
131 70 50 66     1228 $+{open_bracket} eq '[' && $+{close_bracket} eq '>';
      66        
      33        
132             $self->die("Duration not allowed in timestamp: $str")
133 70 100 100     410 if !$opts->{allow_event_duration} && $+{event_duration};
134             $self->die("Repeater ($+{repeater}) not allowed in timestamp: $str")
135 69 100 100     243 if !$opts->{allow_repeater} && $+{repeater};
136              
137 68 100       1650 $self->is_active($+{open_bracket} eq '<' ? 1:0)
    50          
138             unless defined $self->is_active;
139              
140 68 100 66     751 if ($+{event_duration} && !defined($self->event_duration)) {
141             $self->event_duration(
142             ($+{hour2}-$+{hour})*3600 +
143 3         114 ($+{min2} -$+{min} )*60
144             );
145             }
146              
147 68         771 my %dt_args = (year => $+{year}, month=>$+{mon}, day=>$+{day});
148 68 100       405 if (defined($+{hour})) {
149 20         81 $dt_args{hour} = $+{hour};
150 20         79 $dt_args{minute} = $+{min};
151 20         395 $self->has_time(1);
152             } else {
153 48         999 $self->has_time(0);
154             }
155 68 100       788 if ($self->document->time_zone) {
156 1         7 $dt_args{time_zone} = $self->document->time_zone;
157             }
158             #use Data::Dump; dd \%dt_args;
159 68         472 my $dt = DateTime->new(%dt_args);
160              
161 67 100 66     37620 if ($+{repeater} && !$self->recurrence) {
162 12         97 my $r;
163 12         52 my $i = $+{repeater_interval};
164 12         54 my $u = $+{repeater_unit};
165 12 100       64 if ($u eq 'd') {
    100          
    100          
    50          
166 2         13 $r = DateTime::Event::Recurrence->daily(
167             interval=>$i, start=>$dt);
168             } elsif ($u eq 'w') {
169 3         18 $r = DateTime::Event::Recurrence->weekly(
170             interval=>$i, start=>$dt);
171             } elsif ($u eq 'm') {
172 4         14 $r = DateTime::Event::Recurrence->monthly(
173             interval=>$i, start=>$dt);
174             } elsif ($u eq 'y') {
175 3         22 $r = DateTime::Event::Recurrence->yearly(
176             interval=>$i, start=>$dt);
177             } else {
178 0         0 $self->die("BUG: Unknown repeater unit $u in timestamp $str");
179             }
180 12         4603 $self->recurrence($r);
181 12         138 $self->_repeater($+{repeater});
182             }
183              
184 67 100       424 if ($+{warning_period}) {
185 1         7 my $i = $+{warning_period_interval};
186 1         5 my $u = $+{warning_period_unit};
187 1 50       8 if ($u eq 'd') {
    0          
    0          
    0          
188             } elsif ($u eq 'w') {
189             } elsif ($u eq 'm') {
190             } elsif ($u eq 'y') {
191             } else {
192 0         0 $self->die("BUG: Unknown warning period unit $u in timestamp $str");
193             }
194 1         20 $self->_warning_period($+{warning_period});
195             }
196              
197 67         245 $self->_is_parsed(1);
198 67         1549 $self->datetime($dt);
199             }
200              
201             1;
202             # ABSTRACT: Represent Org timestamp
203              
204             __END__
205              
206             =pod
207              
208             =encoding UTF-8
209              
210             =head1 NAME
211              
212             Org::Element::Timestamp - Represent Org timestamp
213              
214             =head1 VERSION
215              
216             This document describes version 0.560 of Org::Element::Timestamp (from Perl distribution Org-Parser), released on 2023-08-05.
217              
218             =head1 DESCRIPTION
219              
220             Derived from L<Org::Element>.
221              
222             Supported formats:
223              
224             =over
225              
226             =item * C<[...]> and C<< <...> >> (active) forms
227              
228             =item * basic date: C<[2013-10-27 Sun]>
229              
230             =item * event duration: C<[2011-03-23 Wed 10:12-11:23]>
231              
232             =item * repeater: C<[2011-03-23 Wed +3m]> including C<++> and C<.+>
233              
234             =item * habit-style repeater: C<[2011-03-23 Wed 10:12 +1d/2d]>
235              
236             =item * warning period: C<< <2011-05-25 Wed +17.1m -13.2d> >>
237              
238             =back
239              
240             =head1 BUGS AND LIMITATIONS
241              
242             =over
243              
244             =item * Habit-style repeater (e.g. 2d/3d) is not yet represented in C<recurrence>
245              
246             The recurrence object currently will still only include 2d (without the maximum
247             interval).
248              
249             =back
250              
251             =head1 ATTRIBUTES
252              
253             =head2 datetime => DATETIME_OBJ
254              
255             =head2 has_time => BOOL
256              
257             =head2 event_duration => INT
258              
259             Event duration in seconds, e.g. for event timestamp like this:
260              
261             <2011-03-23 10:15-13:25>
262              
263             event_duration is 7200+600=7800 (2 hours 10 minutes).
264              
265             =head2 recurrence => DateTime::Event::Recurrence object
266              
267             =head2 is_active => BOOL
268              
269             =head1 METHODS
270              
271             =head2 $el->clear_parse_result
272              
273             Clear parse result.
274              
275             Since the DateTime::Set::ICal (recurrence) object contains coderefs (and thus
276             poses problem to serialization), an option is provided to remove parse result.
277             You can do this prior to serializing the object.
278              
279             Timestamp will automatically be parsed again from _str when one of the
280             attributes is accessed.
281              
282             =head2 as_string => str
283              
284             From L<Org::Element>.
285              
286             =head2 as_text => str
287              
288             From L<Org::ElementRole::Inline>.
289              
290             =head1 HOMEPAGE
291              
292             Please visit the project's homepage at L<https://metacpan.org/release/Org-Parser>.
293              
294             =head1 SOURCE
295              
296             Source repository is at L<https://github.com/perlancar/perl-Org-Parser>.
297              
298             =head1 AUTHOR
299              
300             perlancar <perlancar@cpan.org>
301              
302             =head1 CONTRIBUTING
303              
304              
305             To contribute, you can send patches by email/via RT, or send pull requests on
306             GitHub.
307              
308             Most of the time, you don't need to build the distribution yourself. You can
309             simply modify the code, then test via:
310              
311             % prove -l
312              
313             If you want to build the distribution (e.g. to try to install it locally on your
314             system), you can install L<Dist::Zilla>,
315             L<Dist::Zilla::PluginBundle::Author::PERLANCAR>,
316             L<Pod::Weaver::PluginBundle::Author::PERLANCAR>, and sometimes one or two other
317             Dist::Zilla- and/or Pod::Weaver plugins. Any additional steps required beyond
318             that are considered a bug and can be reported to me.
319              
320             =head1 COPYRIGHT AND LICENSE
321              
322             This software is copyright (c) 2023, 2022, 2021, 2020, 2019, 2017, 2016, 2015, 2014, 2013, 2012, 2011 by perlancar <perlancar@cpan.org>.
323              
324             This is free software; you can redistribute it and/or modify it under
325             the same terms as the Perl 5 programming language system itself.
326              
327             =head1 BUGS
328              
329             Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Org-Parser>
330              
331             When submitting a bug or request, please include a test-file or a
332             patch to an existing test-file that illustrates the bug or desired
333             feature.
334              
335             =cut