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

package Org::Element::Timestamp;

use 5.010;
use locale;
use utf8;
use Moo;
no if $] >= 5.021_006, warnings => "locale";
extends 'Org::Element';
with 'Org::ElementRole';
with 'Org::ElementRole::Inline';

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2023-07-12'; # DATE
our $DIST = 'Org-Parser'; # DIST
our $VERSION = '0.559'; # VERSION

my @attrs = (qw/datetime has_time event_duration recurrence is_active/);
for (@attrs) {
    has $_ => (is => 'rw', clearer=>"clear_$_");
    before $_ => sub {
        my $self = shift;
        return unless defined $self->_is_parsed; # never been parsed
        $self->_parse_timestamp($self->_str)
            unless $self->_is_parsed; # has been reset, re-set
    };
}

has _repeater => (is => 'rw'); # stores the raw repeater spec, for as_string
has _warning_period => (is => 'rw'); # raw warning period spec, for as_string
has _is_parsed => (is => 'rw');

sub clear_parse_result {
    my $self = shift;
    return unless defined $self->_is_parsed; # never been parsed
    for (@attrs) { my $m = "clear_$_"; $self->$m }
    $self->_is_parsed(0);
}

our @dow = (undef, qw(Mon Tue Wed Thu Fri Sat Sun));

sub as_string {
    my ($self) = @_;
    return $self->_str if $self->_str;
    my $dt = $self->datetime;
    my ($hour2, $min2);
    if ($self->event_duration) {
        my $hour = $dt->hour;
        my $min = $dt->minute;
        my $mins = $self->event_duration / 60;
        $min2 = $min + $mins;
        my $hours = int ($min2 / 60);
        $hour2 = $hour + $hours;
        $min2  = $min2 % 60;
    }
    join("",
         $self->is_active ? "<" : "[",
         $dt->ymd, " ",
         $dow[$dt->day_of_week],
         $self->has_time ? (
             " ",
             sprintf("%02d:%02d", $dt->hour, $dt->minute),
             defined($hour2) ? (
                 "-",
                 sprintf("%02d:%02d", $hour2, $min2),
             ) : (),
             $self->_repeater ? (
                 " ",
                 $self->_repeater,
             ) : (),
             $self->_warning_period ? (
                 " ",
                 $self->_warning_period,
             ) : (),
         ) : (),
         $self->is_active ? ">" : "]",
     );
}

sub as_text {
    goto \&as_string;
}

sub _parse_timestamp {
    require DateTime;
    require DateTime::Event::Recurrence;
    my ($self, $str, $opts) = @_;
    $self->_is_parsed(undef); # to avoid deep recursion
    $opts //= {};
    $opts->{allow_event_duration} //= 1;
    $opts->{allow_repeater} //= 1;

    my $num_re = qr/\d+(?:\.\d+)?/;

    my $dow_re = qr/\w{1,3} |     # common, chinese 四, english thu
                                        \w{2,3}\.     # french mer., german Mi.
                                      /x;

    $str =~ /^(?<open_bracket> \[|<)
                          (?<year> \d{4})-(?<mon> \d{2})-(?<day> \d{2})
                          (?:
                                  (?:\s* (?<dow> $dow_re) \s*)?
                                  (?:\s+
                                          (?<hour> \d{2}):(?<min> \d{2})
                                          (?:-
                                                  (?<event_duration>
                                                          (?<hour2> \d{2}):(?<min2> \d{2}))
                                          )?
                                  )?
                                  (?:\s+(?<repeater>
                                                  (?<repeater_prefix> \+\+|\.\+|\+)
                                                  (?<repeater_interval> $num_re)
                                                  (?<repeater_unit> [dwmy])
                                                  (?:\/(?<repeater_interval_max> $num_re)
                                                          (?<repeater_unit_max> [dwmy]))?
                                          )
                                  )?
                                  (?:\s+(?<warning_period>
                                                  -
                                                  (?<warning_period_interval> $num_re)
                                                  (?<warning_period_unit> [dwmy])
                                          )
                                  )?
                          )?
                          \s* (?<close_bracket> \]|>)
                          $/x
                 or die "Can't parse timestamp string: $str";
    # just for sanity. usually doesn't happen though because Document gives us
    # either "[...]" or "<...>"
    die "Mismatch open/close brackets in timestamp: $str"
        if $+{open_bracket} eq '<' && $+{close_bracket} eq ']' ||
            $+{open_bracket} eq '[' && $+{close_bracket} eq '>';
    die "Duration not allowed in timestamp: $str"
        if !$opts->{allow_event_duration} && $+{event_duration};
    die "Repeater ($+{repeater}) not allowed in timestamp: $str"
        if !$opts->{allow_repeater} && $+{repeater};

    $self->is_active($+{open_bracket} eq '<' ? 1:0)
        unless defined $self->is_active;

    if ($+{event_duration} && !defined($self->event_duration)) {
        $self->event_duration(
            ($+{hour2}-$+{hour})*3600 +
            ($+{min2} -$+{min} )*60
        );
    }

    my %dt_args = (year => $+{year}, month=>$+{mon}, day=>$+{day});
    if (defined($+{hour})) {
        $dt_args{hour}   = $+{hour};
        $dt_args{minute} = $+{min};
        $self->has_time(1);
    } else {
        $self->has_time(0);
    }
    if ($self->document->time_zone) {
        $dt_args{time_zone} = $self->document->time_zone;
    }
    #use Data::Dump; dd \%dt_args;
    my $dt = DateTime->new(%dt_args);

    if ($+{repeater} && !$self->recurrence) {
        my $r;
        my $i = $+{repeater_interval};
        my $u = $+{repeater_unit};
        if ($u eq 'd') {
            $r = DateTime::Event::Recurrence->daily(
                interval=>$i, start=>$dt);
        } elsif ($u eq 'w') {
            $r = DateTime::Event::Recurrence->weekly(
                interval=>$i, start=>$dt);
        } elsif ($u eq 'm') {
            $r = DateTime::Event::Recurrence->monthly(
                interval=>$i, start=>$dt);
        } elsif ($u eq 'y') {
            $r = DateTime::Event::Recurrence->yearly(
                interval=>$i, start=>$dt);
        } else {
            die "BUG: Unknown repeater unit $u in timestamp $str";
        }
        $self->recurrence($r);
        $self->_repeater($+{repeater});
    }

    if ($+{warning_period}) {
        my $i = $+{warning_period_interval};
        my $u = $+{warning_period_unit};
        if ($u eq 'd') {
        } elsif ($u eq 'w') {
        } elsif ($u eq 'm') {
        } elsif ($u eq 'y') {
        } else {
            die "BUG: Unknown warning period unit $u in timestamp $str";
        }
        $self->_warning_period($+{warning_period});
    }

    $self->_is_parsed(1);
    $self->datetime($dt);
}

1;
# ABSTRACT: Represent Org timestamp

__END__

=pod

=encoding UTF-8

=head1 NAME

Org::Element::Timestamp - Represent Org timestamp

=head1 VERSION

This document describes version 0.559 of Org::Element::Timestamp (from Perl distribution Org-Parser), released on 2023-07-12.

=head1 DESCRIPTION

Derived from L<Org::Element>.

Supported formats:

=over

=item * C<[...]> and C<< <...> >> (active) forms

=item * basic date: C<[2013-10-27 Sun]>

=item * event duration: C<[2011-03-23 Wed 10:12-11:23]>

=item * repeater: C<[2011-03-23 Wed +3m]> including C<++> and C<.+>

=item * habit-style repeater: C<[2011-03-23 Wed 10:12 +1d/2d]>

=item * warning period: C<< <2011-05-25 Wed +17.1m -13.2d> >>

=back

=head1 BUGS AND LIMITATIONS

=over

=item * Habit-style repeater (e.g. 2d/3d) is not yet represented in C<recurrence>

The recurrence object currently will still only include 2d (without the maximum
interval).

=back

=head1 ATTRIBUTES

=head2 datetime => DATETIME_OBJ

=head2 has_time => BOOL

=head2 event_duration => INT

Event duration in seconds, e.g. for event timestamp like this:

 <2011-03-23 10:15-13:25>

event_duration is 7200+600=7800 (2 hours 10 minutes).

=head2 recurrence => DateTime::Event::Recurrence object

=head2 is_active => BOOL

=head1 METHODS

=head2 $el->clear_parse_result

Clear parse result.

Since the DateTime::Set::ICal (recurrence) object contains coderefs (and thus
poses problem to serialization), an option is provided to remove parse result.
You can do this prior to serializing the object.

Timestamp will automatically be parsed again from _str when one of the
attributes is accessed.

=head2 as_string => str

From L<Org::Element>.

=head2 as_text => str

From L<Org::ElementRole::Inline>.

=head1 HOMEPAGE

Please visit the project's homepage at L<https://metacpan.org/release/Org-Parser>.

=head1 SOURCE

Source repository is at L<https://github.com/perlancar/perl-Org-Parser>.

=head1 AUTHOR

perlancar <[e-mail]>

=head1 CONTRIBUTING


To contribute, you can send patches by email/via RT, or send pull requests on
GitHub.

Most of the time, you don't need to build the distribution yourself. You can
simply modify the code, then test via:

 % prove -l

If you want to build the distribution (e.g. to try to install it locally on your
system), you can install L<Dist::Zilla>,
L<Dist::Zilla::PluginBundle::Author::PERLANCAR>,
L<Pod::Weaver::PluginBundle::Author::PERLANCAR>, and sometimes one or two other
Dist::Zilla- and/or Pod::Weaver plugins. Any additional steps required beyond
that are considered a bug and can be reported to me.

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2023, 2022, 2021, 2020, 2019, 2017, 2016, 2015, 2014, 2013, 2012, 2011 by perlancar <[e-mail]>.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=head1 BUGS

Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Org-Parser>

When submitting a bug or request, please include a test-file or a
patch to an existing test-file that illustrates the bug or desired
feature.

=cut