File Coverage

blib/lib/App/JobLog/Log/Format.pm

Criterion	Covered	Total	%
statement	174	201	86.5
branch	60	88	68.1
condition	35	61	57.3
subroutine	20	20	100.0
pod	3	5	60.0
total	292	375	77.8

package App::JobLog::Log::Format;
$App::JobLog::Log::Format::VERSION = '1.040';
# ABSTRACT: pretty printer for log


use Exporter 'import';
our @EXPORT_OK = qw(
  display
  duration
  single_interval
  summary
  wrap
);

use Modern::Perl;
use App::JobLog::Config qw(
  day_length
  is_workday
  precision
);
use App::JobLog::Log::Synopsis qw(collect :merge);
use Text::WrapI18N qw();
use App::JobLog::TimeGrammar qw(parse);

use constant TAG_COLUMN_LIMIT => 10;
use constant MARGIN           => 5;

# minimum width of description column
use constant MIN_WIDTH       => 20;
use constant DURATION_FORMAT => '%0.' . precision . 'f';


sub summary {
    my ( $phrase, $test, $hidden, $do_notes ) = @_;

    # we skip flex days if the events are at all filtered
    my $skip_flex = !$do_notes && ( $test || 0 );
    $test //= sub { $_[0] };
    my ( $start, $end ) = parse $phrase;
    my $show_year = $start->year < $end->year;
    unless ($skip_flex) {

     # if we are chopping off any of the first and last days we ignore flex time
        $skip_flex = 1
          unless $do_notes || _break_of_dawn($start) && _witching_hour($end);
    }
    my $method = $do_notes ? 'find_notes' : 'find_events';
    my $events = App::JobLog::Log->new->$method( $start, $end );
    my @days = @{ _days( $start, $end, $skip_flex, $do_notes ) };
    my @periods =
      $hidden->{vacation} ? () : App::JobLog::Vacation->new->periods;

    # drop the vacation days that can't be relevant
    unless ( $hidden->{vacation} ) {
        my $e =
          App::JobLog::Log::Event->new(
            App::JobLog::Log::Line->new( time => $start ) );
        $e->end = $end;
        for ( my $i = 0 ; $i < @periods ; $i++ ) {
            my $p = $periods[$i];
            if ( $skip_flex && $p->flex || !$p->conflicts($e) ) {
                splice @periods, $i, 1;
                $i--;
            }
        }
    }

    # collect events into days
    my @gathered;
    for my $big_e (@$events) {
        for my $e ( $big_e->split_days ) {
            if ( $e = $test->($e) ) {
                push @gathered, shift @days
                  while @days && $days[0]->end < $e->start;
                for my $d (@days) {
                    if ( $e->intersects( $d->pseudo_event ) ) {
                        push @{ $d->events }, $e;
                        last;
                    }

                    # I believe these is_open bits are mistaken
                    # last if $e->is_open;
                    unless ($do_notes) {
                        last if $d->start > $e->end;
                    }
                }
            }
        }
    }
    unshift @days, @gathered;

    # add in vacation times
    for my $p (@periods) {
        for my $d (@days) {
            if ( is_workday( $d->start ) && $p->conflicts( $d->pseudo_event ) )
            {
                my $clone = $p->clone;
                if ( $clone->fixed ) {
                    push @{ $d->events }, $clone->overlap( $d->start, $d->end );
                }
                else {
                    $clone->start = $d->start->clone;
                    if ( $clone->flex ) {
                        $d->{deferred} = $clone;
                    }
                    else {
                        $clone->end =
                          $clone->start->clone->add( hours => day_length );
                        push @{ $d->vacation }, $clone;
                    }
                }
            }
        }
    }

    # delete empty days
    for ( my $i = 0 ; $i < @days ; $i++ ) {
        my $d = $days[$i];
        if ( $d->is_empty && !is_workday( $d->start ) ) {
            splice @days, $i, 1;
            $i--;
        }
    }

    # fix deferred flex time and ensure events are chronologically ordered
    for my $d (@days) {
        my $flex   = $d->{deferred};
        my @events = @{ $d->events };
        if ($flex) {
            delete $d->{deferred};
            my $tr = $d->time_remaining;
            if ( $tr > 0 ) {
                $flex->end = $flex->start->clone->add( seconds => $tr );
                push @events, $flex;
            }
        }
        $d->{events} = [ sort { $a->cmp($b) } @events ] if @events > 1;
    }

    return \@days, $show_year;
}

# whether the date is the first moment in its day
sub _break_of_dawn {
    my ($date) = @_;
    return $date->hour == 0 && $date->minute == 0 && $date->second == 0;
}

# whether the date is the last moment in its day
sub _witching_hour {
    my ($date) = @_;
    return $date->hour == 23 && $date->minute == 59 && $date->second == 59;
}

# create a list of days about which we wish to collect information
sub _days {
    my ( $start, $end, $skip_flex, $doing_notes ) = @_;
    my @days;
    my $b1 = $start;
    my $b2 = $start->clone->add( days => 1 )->truncate( to => 'day' );
    while ( $b2 < $end ) {
        push @days,
          App::JobLog::Log::Day->new(
            start     => $b1,
            end       => $b2,
            skip_flex => $skip_flex,
            $doing_notes ? ( notes => 1 ) : (),
          );
        $b1 = $b2;
        $b2 = $b2->clone->add( days => 1 );
    }
    push @days,
      App::JobLog::Log::Day->new(
        start     => $b1,
        end       => $end,
        skip_flex => $skip_flex,
        $doing_notes ? ( notes => 1 ) : (),
      );
    return \@days;
}


sub display {
    my ( $days, $merge_level, $hidden, $screen_width, $show_year ) = @_;

    if (@$days) {
        collect $_, $merge_level for @$days;
        my @synopses = map { @{ $_->synopses } } @$days;

        my $columns = {
            time => single_interval($merge_level) && !$hidden->{time},
            date => !$hidden->{date},
            tags => !$hidden->{tags},
            description => !$hidden->{description},
            duration    => !$hidden->{duration},
        };
        $show_year &&= $columns->{date};
        my $format = _define_format( \@synopses, $columns, $screen_width );

        # keep track of various durations
        my $times = {
            total    => 0,
            untagged => 0,
            expected => 0,
            vacation => 0,
            tags     => {}
        };

        # display synopses and add up durations
        for my $d (@$days) {
            $d->times($times);
            $d->display( $format, $columns, $screen_width, $show_year );
        }

        unless ( $hidden->{totals} ) {
            my ( $m1, $m2 ) =
              ( length 'TOTAL HOURS', length duration( $times->{total} ) );
            my @keys = keys %{ $times->{tags} };
            push @keys, 'UNTAGGED' if $times->{untagged};
            push @keys, 'VACATION' if $times->{vacation};
            for my $tag (@keys) {
                my $l = length $tag;
                $m1 = $l if $l > $m1;
            }
            $format = sprintf "  %%-%ds %%%ds\n", $m1, $m2;
            printf $format, 'TOTAL HOURS', duration( $times->{total} );
            printf $format, 'VACATION',    duration( $times->{vacation} )
              if $times->{vacation};
            if ( %{ $times->{tags} } ) {
                printf $format, 'UNTAGGED', duration( $times->{untagged} )
                  if $times->{untagged};
                for my $key ( sort keys %{ $times->{tags} } ) {
                    my $d = $times->{tags}{$key};
                    printf $format, $key, duration($d);
                }
            }
        }
    }
    else {
        say 'No events in interval specified.';
    }
}

# generate printf format for synopses
# returns format and wrap widths for tags and descriptions
sub _define_format {
    my ( $synopses, $hash, $screen_width ) = @_;

    #determine maximum width of each column
    my $widths;
    for my $s (@$synopses) {
        if ( $hash->{tags} ) {
            my $w1 = $hash->{widths}{tags} || 0;
            my $ts = $s->tag_string;
            if ( $screen_width > -1 && length $ts > TAG_COLUMN_LIMIT ) {
                my $wrapped = wrap( $ts, TAG_COLUMN_LIMIT );
                $ts = '';
                for my $line (@$wrapped) {
                    $ts = $line if length $line > length $ts;
                }
            }
            my $w2 = length $ts;
            $hash->{widths}{tags} = $w2 if $w2 > $w1;
        }
        if ( $hash->{time} ) {
            my $w1 = $hash->{widths}{time} || 0;
            my $w2 = length $s->time_fmt;
            $hash->{widths}{time} = $w2 if $w2 > $w1;
        }
        if ( $hash->{duration} ) {
            my $w1 = $hash->{widths}{duration} || 0;
            my $w2 = length duration( $s->duration );
            $hash->{widths}{duration} = $w2 if $w2 > $w1;
        }
    }
    my $margins = 0;
    if ( $hash->{tags} && $hash->{widths}{tags} ) {
        $margins++;
        $hash->{formats}{tags} = sprintf '%%-%ds', $hash->{widths}{tags};

# there seems to be a bug in Text::Wrap that requires tinkering with the column width
        $hash->{widths}{tags}++;
    }
    if ( $hash->{time} && $hash->{widths}{time} ) {
        $margins++;
        $hash->{formats}{time} = sprintf '%%%ds', $hash->{widths}{time};
    }
    if ( $hash->{duration} && $hash->{widths}{duration} ) {
        $margins++;
        $hash->{formats}{duration} = sprintf '%%%ds', $hash->{widths}{duration};
    }
    if ( $hash->{description} ) {
        if ( $screen_width == -1 ) {
            $hash->{formats}{description} = '%s';
        }
        else {
            $margins++;
            my $max_description = $screen_width;
            for my $col (qw(time duration tags)) {
                $max_description -= $hash->{widths}{$col} || 0;
            }
            $max_description -= $margins * 2;    # left margins
            $max_description -= MARGIN;          # margin on the right
            $max_description = MIN_WIDTH if $max_description < MIN_WIDTH;
            $hash->{widths}{description} = $max_description;
            $hash->{formats}{description} = sprintf '%%-%ds', $max_description;
        }
    }

    my $format = '';
    for my $col (qw(time duration tags description)) {
        my $f = $hash->{formats}{$col};
        $format .= "  $f" if $f;
    }
    return $format;
}


sub wrap {
    my ( $text, $columns ) = @_;
    my @ar;
    eval {
        $Text::WrapI18N::columns = $columns;
        my $s = Text::WrapI18N::wrap( '', '', $text );
        @ar = $s =~ /^.*$/mg;
    };
    return \@ar unless $@;
    return [$text];
}


sub single_interval {
    $_[0] == MERGE_ADJACENT
      || $_[0] == MERGE_ADJACENT_SAME_TAGS
      || $_[0] == MERGE_NONE;
}


sub duration { sprintf DURATION_FORMAT, $_[0] / ( 60 * 60 ) }

1;

__END__