view release on metacpan or  search on metacpan

lib/App/JobLog/Log/Synopsis.pm  view on Meta::CPAN

package App::JobLog::Log::Synopsis;
$App::JobLog::Log::Synopsis::VERSION = '1.042';
# ABSTRACT: consolidates App::JobClock::Log::Event objects for display


use Exporter 'import';
our @EXPORT_OK = qw(
  collect
  MERGE_ALL
  MERGE_ADJACENT
  MERGE_ADJACENT_SAME_TAGS
  MERGE_SAME_TAGS
  MERGE_SAME_DAY
  MERGE_SAME_DAY_SAME_TAGS
  MERGE_NONE
);
our %EXPORT_TAGS = (
    merge => [
        qw(
          MERGE_ALL
          MERGE_ADJACENT
          MERGE_ADJACENT_SAME_TAGS
          MERGE_SAME_TAGS
          MERGE_SAME_DAY
          MERGE_SAME_DAY_SAME_TAGS
          MERGE_NONE
          )
    ]
);

use Modern::Perl;
use autouse 'Carp'              => qw(carp);
use autouse 'App::JobLog::Time' => qw(now);
use Class::Autouse qw(DateTime);
no if $] >= 5.018, warnings => "experimental::smartmatch";

use constant MERGE_ALL                => 1;
use constant MERGE_ADJACENT           => 2;
use constant MERGE_ADJACENT_SAME_TAGS => 3;
use constant MERGE_SAME_TAGS          => 4;
use constant MERGE_SAME_DAY           => 5;
use constant MERGE_SAME_DAY_SAME_TAGS => 6;
use constant MERGE_NONE               => 0;


# takes in a bunch of App::JobClock::Log::Event objects
# returns a bunch of App::JobClock::Log::Synopsis objects
sub collect {
    my ( $day, $merge_level ) = @_;
    my ( @synopses, $previous, @current_day );
    for my $e ( @{ $day->events }, @{ $day->vacation } ) {
        my $do_merge = 0;
        my $mergand  = $previous;
        if ($previous) {
            for ($merge_level) {
                when (MERGE_ALL)      { $do_merge = 1 }
                when (MERGE_ADJACENT) { $do_merge = $previous->adjacent($e) }
                when (MERGE_SAME_TAGS) {
                    for my $o (@synopses) {
                        if ( $o->same_tags($e) ) {
                            $mergand  = $o;
                            $do_merge = 1;
                            last;
                        }
                    }
                }
                when (MERGE_SAME_DAY) { $do_merge = 1 }
                when (MERGE_SAME_DAY_SAME_TAGS) {
                    for my $s (@current_day) {
                        if ( $s->same_tags($e) ) {
                            $do_merge = 1;
                            $mergand  = $s;
                            last;
                        }
                    }
                }
                when (MERGE_ADJACENT_SAME_TAGS) {
                    $do_merge = $previous->adjacent($e)
                      && $previous->same_tags($e)
                }
                when (MERGE_NONE) { $do_merge = 0 }
                default { carp 'unfamiliar merge level' };
            }
        }

        # keep vacation and regular events apart
        $do_merge &&= ref $mergand->last_event eq ref $e;

        if ($do_merge) {
            $mergand->merge($e);
        }