diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Test2/IPC/Driver/Files.pm')
-rwxr-xr-x | Master/tlpkg/tlperl/lib/Test2/IPC/Driver/Files.pm | 28 |
1 files changed, 26 insertions, 2 deletions
diff --git a/Master/tlpkg/tlperl/lib/Test2/IPC/Driver/Files.pm b/Master/tlpkg/tlperl/lib/Test2/IPC/Driver/Files.pm index f6d7ff1b2c0..09fdd5c0cf6 100755 --- a/Master/tlpkg/tlperl/lib/Test2/IPC/Driver/Files.pm +++ b/Master/tlpkg/tlperl/lib/Test2/IPC/Driver/Files.pm @@ -2,7 +2,7 @@ package Test2::IPC::Driver::Files; use strict; use warnings; -our $VERSION = '1.302162'; +our $VERSION = '1.302175'; BEGIN { require Test2::IPC::Driver; our @ISA = qw(Test2::IPC::Driver) } @@ -117,12 +117,36 @@ sub drop_hub { } opendir(my $dh, $tdir) or $self->abort_trace("Could not open temp dir!"); + + my %bad; for my $file (readdir($dh)) { next if $file =~ m{\.complete$}; next unless $file =~ m{^$hid}; - $self->abort_trace("Not all files from hub '$hid' have been collected!"); + + eval { $bad{$file} = $self->read_event_file(File::Spec->catfile($tdir, $file)); 1 } or $bad{$file} = $@ || "Unknown error reading file"; } closedir($dh); + + return unless keys %bad; + + my $data; + my $ok = eval { + require JSON::PP; + local *UNIVERSAL::TO_JSON = sub { +{ %{$_[0]} } }; + my $json = JSON::PP->new->ascii->pretty->canonical->allow_unknown->allow_blessed->convert_blessed; + $data = $json->encode(\%bad); + 1; + }; + $ok ||= eval { + require Data::Dumper; + local $Data::Dumper::Sortkeys = 1; + $data = Data::Dumper::Dumper(\%bad); + 1; + }; + + $data = "Could not dump data... sorry." unless defined $data; + + $self->abort_trace("Not all files from hub '$hid' have been collected!\nHere is the leftover data:\n========================\n$data\n===================\n"); } sub send { |