package Test2::Harness::UI::Importer; use strict; use warnings; our $VERSION = '0.000116'; use Carp qw/croak/; use Test2::Harness::UI::RunProcessor; use Test2::Harness::UI::Util::HashBase qw/-config -worker_id/; use Test2::Harness::Util::UUID qw/gen_uuid/; use Test2::Harness::Util::JSON qw/decode_json/; use IO::Uncompress::Bunzip2 qw($Bunzip2Error); use IO::Uncompress::Gunzip qw($GunzipError); sub init { my $self = shift; croak "'config' is a required attribute" unless $self->{+CONFIG}; } sub run { my $self = shift; my ($max) = @_; my $schema = $self->{+CONFIG}->schema; my $worker_id = $self->{+WORKER_ID} //= gen_uuid(); while (!defined($max) || $max--) { $schema->resultset('Run')->search( {status => 'pending', log_file_id => {'is not' => undef}}, {order_by => {-asc => 'added'}, rows => 1}, )->update({status => 'running', worker_id => $worker_id}); my $run = $schema->resultset('Run')->search( {status => 'running', worker_id => $worker_id}, {order_by => {-asc => 'added'}, rows => 1}, )->first; unless ($run) { sleep 1; next; } $self->process($run); } } sub process { my $self = shift; my ($run) = @_; my $start = time; syswrite(\*STDOUT, '[' . $run->worker_id . "] Starting run " . $run->run_id . " (" . $run->log_file->name . ")\n"); my $status; my $ok = eval { $status = $self->process_log($run); 1 }; my $err = $@; my $total = time - $start; if ($ok && !$status->{errors}) { syswrite(\*STDOUT, "Completed run " . $run->run_id . " (" . $run->log_file->name . ") in $total seconds.\n"); $run->update({status => 'complete', passed => $status->{passed}, failed => $status->{failed}, retried => $status->{retried}}); } else { my $error = $ok ? join("\n" => @{$status->{errors}}) : $err; syswrite(\*STDOUT, "Failed feed " . $run->run_id . " (" . $run->log_file->name . ") in $total seconds.\n$error\n"); $run->update({status => 'broken', error => $error}); } return; } sub process_log { my $self = shift; my ($run, $fh) = @_; unless ($fh) { my $log = $run->log_file or die "No log file"; if ($log->name =~ m/\.bz2$/) { $fh = IO::Uncompress::Bunzip2->new($log->local_file || \($log->data)) or die "Could not open bz2 data: $Bunzip2Error"; } else { $fh = IO::Uncompress::Gunzip->new($log->local_file || \($log->data)) or die "Could not open gz data: $GunzipError"; } } my $processor = Test2::Harness::UI::RunProcessor->new( run => $run, config => $self->{+CONFIG}, buffer => 1, ); $processor->start(); my $schema = $self->{+CONFIG}->schema; local $| = 1; while (my $line = <$fh>) { next if $line =~ m/^null$/ims; my $ln = $.; my $error = $self->process_event_json($processor, $ln => $line); return {errors => ["error processing line number $ln: $error"]} if $error; } my $status = $processor->finish(); return $status; } sub process_event_json { my $self = shift; my ($processor, $ln, $json) = @_; my $ok = eval { my $event = decode_json($json); $processor->process_event($event, undef, line => $ln); 1; }; my $err = $@; return $ok ? undef : $err; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Test2::Harness::UI::Importer =head1 DESCRIPTION =head1 SYNOPSIS TODO =head1 SOURCE The source code repository for Test2-Harness-UI can be found at F<http://github.com/Test-More/Test2-Harness-UI/>. =head1 MAINTAINERS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 AUTHORS =over 4 =item Chad Granum E<lt>exodist@cpan.orgE<gt> =back =head1 COPYRIGHT Copyright 2019 Chad Granum E<lt>exodist7@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F<http://dev.perl.org/licenses/> =cut