view release on metacpan or  search on metacpan

lib/App/JobLog/Vacation/Period.pm  view on Meta::CPAN

package App::JobLog::Vacation::Period;
$App::JobLog::Vacation::Period::VERSION = '1.042';
# ABSTRACT: extension of L<App::JobLog::Log::Event> to handle special properties of vacation periods


use Exporter 'import';
our @EXPORT_OK = qw(
  FLEX
  FIXED
  ANNUAL
  MONTHLY
);

use base 'App::JobLog::Log::Event';
use DateTime;
use App::JobLog::Log::Line;
use App::JobLog::Time qw(tz);
use Carp qw(carp);

use overload '""' => \&to_string;
use overload 'bool' => sub { 1 };

use constant FLEX    => 1;
use constant FIXED   => 2;
use constant ANNUAL  => 1;
use constant MONTHLY => 2;

sub new {
    my ( $class, $log_line, %opts ) = @_;
    $class = ref $class || $class;
    bless {
        log      => $log_line,
        type     => 0,
        repeats  => 0,
        tags     => [],
        events   => [],
        vacation => [],
        %opts
      },
      $class;
}


sub flex { $_[0]->{type} == FLEX }


sub fixed { $_[0]->{type} == FIXED }


sub annual { $_[0]->{repeats} == ANNUAL }


sub monthly { $_[0]->{repeats} == MONTHLY }


sub repeats { $_[0]->{repeats} }


sub description : lvalue {
    $_[0]->data->description;
}


sub clone {
    my ($self) = @_;
    my $clone = $self->SUPER::clone;
    $clone->{type}    = $self->{type};
    $clone->{repeats} = $self->{repeats};
    return $clone;
}


sub cmp {
    my ( $self, $other ) = @_;

lib/App/JobLog/Vacation/Period.pm  view on Meta::CPAN

    if ( $self->monthly ) {
        return -1 unless $other->monthly;
    }
    elsif ( $self->annual ) {
        return 1 if $other->monthly;
        return -1 unless $other->annual;
    }
    return $self->SUPER::cmp($other);
}

# some global variables for use in BNF regex
our ( @dates, $type, @tags, $description );

# log line parser
my $re = qr{
    ^ (?&ts) : (?&non_ts) $
    (?(DEFINE)
     (?<ts> (?&date) : (?&date) )
     (?<date> (\d{4}\s++\d++\s++\d++\s++\d++\s++\d++\s++\d++) (?{push @dates, $^N}) )
     (?<non_ts> (?&flex) : (?&tags) : (?&description))
     (?<flex> ([012]{2}) (?{$type = $^N}))
     (?<tags> (?:(?&tag)(\s++(?&tag))*+)?)
     (?<tag> ((?:[^\s:\\]|(?&escaped))++) (?{push @tags, $^N}))
     (?<escaped> \\.)
     (?<description> (.++) (?{$description = $^N}))
    )
}xi;


sub parse {
    my ( $class, $text ) = @_;
    $class = ref $class || $class;
    local ( @dates, $type, @tags, $description );
    if ( $text =~ $re ) {
        my $start = _parse_time( $dates[0] );
        my $end   = _parse_time( $dates[1] );
        my %tags  = map { $_ => 1 } @tags;
        my $tags  = [ map { s/\\(.)/$1/g; $_ } sort keys %tags ];
        $description = [ map { s/\\(.)/$1/g; $_ } ($description) ];
        my ( $type, $repeats ) = split //, $type;
        $obj = $class->new(
            App::JobLog::Log::Line->new(
                description => $description,
                time        => $start,
                tags        => $tags
            ),
            type    => $type,
            repeats => $repeats,
            end     => $end
        );
        return $obj;
    }
    else {
        carp "malformed line in vacation file: '$text'";
    }
    return;
}

sub _parse_time {
    my @time = split /\s++/, $_[0];
    $date = DateTime->new(
        year      => $time[0],
        month     => $time[1],
        day       => $time[2],
        hour      => $time[3],
        minute    => $time[4],
        second    => $time[5],
        time_zone => tz,
    );
    return $date;
}


sub to_string {
    my ($self) = @_;
    my $text = $self->data->time_stamp( $self->start );
    $text .= ':';
    $text .= $self->data->time_stamp( $self->end );
    $text .= ':';
    if ( $self->flex ) {
        $text .= FLEX;
    }
    elsif ( $self->fixed ) {
        $text .= FIXED;
    }
    else {
        $text .= 0;
    }
    if ( $self->annual ) {
        $text .= ANNUAL;
    }
    elsif ( $self->monthly ) {
        $text .= MONTHLY;
    }
    else {
        $text .= 0;
    }
    $text .= ':';
    $self->tags ||= [];
    my %tags = map { $_ => 1 } @{ $self->tags };
    $text .= join ' ', map { s/([:\\\s])/\\$1/g; $_ } sort keys %tags;
    $text .= ':';
    $self->description ||= [];
    $text .= join ';',
      map { ( my $d = $_ ) =~ s/([;\\])/\\$1/g; $d } @{ $self->description };
}


sub conflicts {
    my ( $self, $other ) = @_;
    return 1 if $self->intersects($other);
    my $other_is_period = ref $other eq __PACKAGE__;
    if ( $self->annual || $other_is_period && $other->annual ) {
        if ( $self->start->year != $other->start->year ) {
            if ( !$self->annual ) {
                my $t = $self;
                $self  = $other;
                $other = $t;
            }
            $self = $self->clone;
            my $d = $self->start->year - $other->start->year;