package Test2::Harness::UI::Schema::Result::Job; use utf8; use strict; use warnings; use Test2::Harness::UI::Util::ImportModes qw/record_all_events mode_check/; use Carp qw/confess/; confess "You must first load a Test2::Harness::UI::Schema::NAME module" unless $Test2::Harness::UI::Schema::LOADED; our $VERSION = '0.000125'; __PACKAGE__->inflate_column( parameters => { inflate => DBIx::Class::InflateColumn::Serializer::JSON->get_unfreezer('parameters', {}), deflate => DBIx::Class::InflateColumn::Serializer::JSON->get_freezer('parameters', {}), }, ); sub file { my $self = shift; my %cols = $self->get_columns; return $cols{file} if exists $cols{file}; return $cols{filename} if exists $cols{filename}; my $test_file = $self->test_file or return undef; return $test_file->filename; } sub shortest_file { my $self = shift; my $file = $self->file or return undef; return $1 if $file =~ m{([^/]+)$}; return $file; } sub short_file { my $self = shift; my $file = $self->file or return undef; return $1 if $file =~ m{/(t2?/.*)$}i; return $1 if $file =~ m{([^/\\]+\.(?:t2?|pl))$}i; return $file; } my %COMPLETE_STATUS = (complete => 1, failed => 1, canceled => 1, broken => 1); sub complete { return $COMPLETE_STATUS{$_[0]->status} // 0 } sub sig { my $self = shift; return join ";" => ( (map {$self->$_ // ''} qw/status pass_count fail_count name file fail/), (map {length($self->$_ // '')} qw/parameters/), ($self->job_fields->count), ); } sub short_job_fields { my $self = shift; return [ map { my $d = +{$_->get_columns}; $d->{data} = $d->{data} ? \'1' : \'0'; $d } $self->job_fields->search(undef, { remove_columns => ['data'], '+select' => ['data IS NOT NULL AS data'], '+as' => ['data'], })->all ]; } sub TO_JSON { my $self = shift; my %cols = $self->get_columns; $cols{short_file} = $self->short_file; $cols{shortest_file} = $self->shortest_file; # Inflate $cols{parameters} = $self->parameters; $cols{fields} = $self->short_job_fields; return \%cols; } my @GLANCE_FIELDS = qw{ exit_code fail fail_count job_key job_try retry name pass_count file status job_ord run_id }; sub glance_data { my $self = shift; my %cols = $self->get_columns; my %data; @data{@GLANCE_FIELDS} = @cols{@GLANCE_FIELDS}; $data{file} = $self->file; $data{short_file} = $self->short_file; $data{shortest_file} = $self->shortest_file; $data{fields} = $self->short_job_fields; return \%data; } sub normalize_to_mode { my $self = shift; my %params = @_; my $mode = $params{mode} // $self->run->mode; # No need to purge anything return if record_all_events(mode => $mode, job => $self); return if mode_check($mode, 'complete'); if (mode_check($mode, 'summary', 'qvf')) { $self->events->delete; return; } my $query = { is_diag => 0, is_harness => 0, is_time => 0, }; if (mode_check($mode, 'qvfds')) { $query->{'-not'} = {is_subtest => 1, nested => 0}; } elsif(!mode_check($mode, 'qvfd')) { die "Unknown mode '$mode'"; } $self->events->search($query)->delete(); } 1; __END__ =pod =head1 NAME Test2::Harness::UI::Schema::Result::Job =head1 METHODS =head1 SOURCE The source code repository for Test2-Harness-UI can be found at F. =head1 MAINTAINERS =over 4 =item Chad Granum Eexodist@cpan.orgE =back =head1 AUTHORS =over 4 =item Chad Granum Eexodist@cpan.orgE =back =head1 COPYRIGHT Copyright 2019 Chad Granum Eexodist7@gmail.comE. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F =cut