speedtag.t: fix Command::speedtag's accessor

Makefile.PL

@@ -22,11 +22,17 @@ if ($ENV{AUTOMATED_TESTING}) {
         if $is_njh;
 }
 
+use File::ShareDir::Install;
+$File::ShareDir::Install::INCLUDE_DOTFILES = 1;
+$File::ShareDir::Install::INCLUDE_DOTDIRS = 1;
+install_share dist => "share";
+
 my %WriteMakefileArgs = (
   "ABSTRACT" => "Top-level test harness service.",
   "AUTHOR" => "Chad Granum <exodist\@cpan.org>",
   "CONFIGURE_REQUIRES" => {
     "ExtUtils::MakeMaker" => 0,
+    "File::ShareDir::Install" => "0.06",
     "Test2::Event::V2" => "1.302199",
     "Test2::Util::Term" => "0.000159"
   },
@@ -274,3 +280,9 @@ delete $WriteMakefileArgs{CONFIGURE_REQUIRES}
   unless eval { ExtUtils::MakeMaker->VERSION(6.52) };
 
 WriteMakefile(%WriteMakefileArgs);
+
+{
+package
+MY;
+use File::ShareDir::Install qw(postamble);
+}

cpanfile

@@ -137,6 +137,7 @@ on 'test' => sub {
 
 on 'configure' => sub {
   requires "ExtUtils::MakeMaker" => "0";
+  requires "File::ShareDir::Install" => "0.06";
   requires "Test2::Event::V2" => "1.302199";
   requires "Test2::Util::Term" => "0.000159";
 };

lib/App/Yath2/Command/speedtag.pm

@@ -105,16 +105,6 @@ sub run {
     die "max medium duration must be an integer, got '$self->{+MAX_MEDIUM}'\n"
         unless $self->{+MAX_MEDIUM} && $self->{+MAX_MEDIUM} =~ m/^\d+$/;
 
-    require App::Yath2::LogArchive;
-    my @runs = App::Yath2::LogArchive->new(path => $log)->runs;
-    die "No runs found in '$log'\n" unless @runs;
-
-    my $streamer = App::Yath2::Streamer::Static->new(
-        log    => $log,
-        runs   => [@runs],
-        global => 1,
-    );
-
     my $durations_file = $settings->speedtag->generate_durations_file;
     my %durations;
 
@@ -123,98 +113,108 @@ sub run {
     # tag and emit the moment we have both.
     my %job_state;
     my %tagged;
-    $streamer->stream(
-        callback => sub {
-            my ($event) = @_;
-            my $f = $event->facet_data // {};
-
-            if (my $start = $f->{harness_job_start}) {
-                my $jid = $start->{job_id} // $event->{job_id} // return;
-                $job_state{$jid}{start} //= $start->{stamp}    // $event->stamp;
-                $job_state{$jid}{file}  //= $start->{abs_file} // $start->{file};
-                return;
+    my $callback = sub {
+        my ($event) = @_;
+        my $f = $event->facet_data // {};
+
+        if (my $start = $f->{harness_job_start}) {
+            my $jid = $start->{job_id} // $event->{job_id} // return;
+            $job_state{$jid}{start} //= $start->{stamp}    // $event->stamp;
+            $job_state{$jid}{file}  //= $start->{abs_file} // $start->{file};
+            return;
+        }
+
+        return unless my $end = $f->{harness_job_end};
+
+        my $jid  = $end->{job_id}   // $event->{job_id} // return;
+        my $file = $end->{abs_file} // $end->{file}     // $job_state{$jid}{file};
+        return unless $file;
+
+        $file = clean_path($file);
+        return if $tagged{$file}++;
+
+        my $start = $job_state{$jid}{start};
+        my $stop  = $end->{stamp} // $event->stamp;
+        return unless defined $start && defined $stop;
+
+        my $time = $stop - $start;
+        return unless $time > 0;
+
+        my $dur =
+              $time < $self->{+MAX_SHORT}  ? 'short'
+            : $time < $self->{+MAX_MEDIUM} ? 'medium'
+            :                                'long';
+
+        my $rfh;
+        unless (open($rfh, '<', $file)) {
+            warn "Could not open file $file for reading\n";
+            return;
+        }
+
+        my @lines;
+        my $injected;
+        my ($old, $new);
+        for my $line (<$rfh>) {
+            if ($line =~ m/^(\s*)#(\s*)HARNESS-(CAT(EGORY)?|DUR(ATION))-(LONG|MEDIUM|SHORT)$/i) {
+                next if $injected++;
+                $old  = $line;
+                $line = "${1}#${2}HARNESS-DURATION-" . uc($dur) . "\n";
+                $new  = $line;
             }
-
-            return unless my $end = $f->{harness_job_end};
-
-            my $jid  = $end->{job_id}   // $event->{job_id} // return;
-            my $file = $end->{abs_file} // $end->{file}     // $job_state{$jid}{file};
-            return unless $file;
-
-            $file = clean_path($file);
-            return if $tagged{$file}++;
-
-            my $start = $job_state{$jid}{start};
-            my $stop  = $end->{stamp} // $event->stamp;
-            return unless defined $start && defined $stop;
-
-            my $time = $stop - $start;
-            return unless $time > 0;
-
-            my $dur =
-                  $time < $self->{+MAX_SHORT}  ? 'short'
-                : $time < $self->{+MAX_MEDIUM} ? 'medium'
-                :                                'long';
-
-            my $rfh;
-            unless (open($rfh, '<', $file)) {
-                warn "Could not open file $file for reading\n";
-                return;
+            push @lines => $line;
+        }
+        close($rfh);
+
+        unless ($injected) {
+            my $new_line = "# HARNESS-DURATION-" . uc($dur) . "\n";
+            my @header;
+            while (@lines && $lines[0] =~ m/^(#|use\s|package\s)/) {
+                push @header => shift @lines;
             }
+            unshift @lines => (@header, $new_line);
+
+            $old = "<NO TAG FOUND>";
+            $new = $new_line;
+        }
+
+        if ($durations_file) {
+            my $tfile = $file;
+            $tfile =~ s{^\Q$initial_dir\E/+}{};
+            $durations{$tfile} = uc($dur);
+        }
+
+        if ($settings->harness->dummy) {
+            print "Would tag (dummy) file $file with duration '$dur'\n";
+            chomp($old);
+            chomp($new);
+            print "Old Header: $old\nNew Header: $new\n\n";
+            return;
+        }
+
+        my $wfh;
+        unless (open($wfh, '>', $file)) {
+            warn "Could not open file $file for writing\n";
+            return;
+        }
+
+        print $wfh @lines;
+        close($wfh);
+
+        print "Tagged '$dur': $file\n";
+    };
 
-            my @lines;
-            my $injected;
-            my ($old, $new);
-            for my $line (<$rfh>) {
-                if ($line =~ m/^(\s*)#(\s*)HARNESS-(CAT(EGORY)?|DUR(ATION))-(LONG|MEDIUM|SHORT)$/i) {
-                    next if $injected++;
-                    $old  = $line;
-                    $line = "${1}#${2}HARNESS-DURATION-" . uc($dur) . "\n";
-                    $new  = $line;
-                }
-                push @lines => $line;
-            }
-            close($rfh);
-
-            unless ($injected) {
-                my $new_line = "# HARNESS-DURATION-" . uc($dur) . "\n";
-                my @header;
-                while (@lines && $lines[0] =~ m/^(#|use\s|package\s)/) {
-                    push @header => shift @lines;
-                }
-                unshift @lines => (@header, $new_line);
-
-                $old = "<NO TAG FOUND>";
-                $new = $new_line;
-            }
-
-            if ($durations_file) {
-                my $tfile = $file;
-                $tfile =~ s{^\Q$initial_dir\E/+}{};
-                $durations{$tfile} = uc($dur);
-            }
-
-            if ($settings->harness->dummy) {
-                print "Would tag (dummy) file $file with duration '$dur'\n";
-                chomp($old);
-                chomp($new);
-                print "Old Header: $old\nNew Header: $new\n\n";
-                return;
-            }
-
-            my $wfh;
-            unless (open($wfh, '>', $file)) {
-                warn "Could not open file $file for writing\n";
-                return;
-            }
-
-            print $wfh @lines;
-            close($wfh);
+    require App::Yath2::LogArchive;
+    my @runs = App::Yath2::LogArchive->new(path => $log)->runs;
+    die "No runs found in '$log'\n" unless @runs;
 
-            print "Tagged '$dur': $file\n";
-        },
+    my $streamer = App::Yath2::Streamer::Static->new(
+        log    => $log,
+        runs   => \@runs,
+        global => 1,
     );
 
+    $streamer->stream(callback => $callback);
+
     if ($durations_file) {
         my $jfile = Test2::Harness2::Util::File::JSON->new(
             name   => $durations_file,

lib/App/Yath2/LogArchive.pm

@@ -57,7 +57,9 @@ sub artifacts {
         my $bytes = do { local $/; <$fh> };
         close $fh;
 
-        my $dict_bytes = $self->can('dict_bytes') ? $self->dict_bytes : undef;
+        # dict_bytes is a Role::Source contract method; every backend
+        # provides it (returns undef when no dict is bundled).
+        my $dict_bytes = $self->dict_bytes;
         my $json = decompress_blob(
             $bytes,
             ($dict_bytes ? (dict_bytes => $dict_bytes) : ()),

lib/App/Yath2/LogArchive/Directory.pm

@@ -10,7 +10,8 @@ use Role::Tiny::With;
 use parent 'App::Yath2::LogArchive';
 use Object::HashBase qw/path format/;
 
-with 'App::Yath2::LogArchive::Role::Source';
+with 'App::Yath2::LogArchive::Role::Source',
+     'App::Yath2::LogArchive::Role::DiskDict';
 
 sub viable { 1 }
 

lib/App/Yath2/LogArchive/Role/DiskDict.pm

@@ -0,0 +1,83 @@
+package App::Yath2::LogArchive::Role::DiskDict;
+use strict;
+use warnings;
+
+our $VERSION = '2.000011';
+
+use Carp qw/croak/;
+use File::Spec ();
+
+use Role::Tiny;
+
+# Concrete `dict_bytes` implementation for any LogArchive backend
+# whose storage shape is "an on-disk root carrying a sibling
+# zstd-dict.bin file". Composes the Role::Source dict_bytes contract
+# (returns the dict bytes, or undef when none).
+#
+# Implementors must expose a `path` accessor (e.g. via
+# Object::HashBase) returning the root directory; the role reads
+# `<path>/zstd-dict.bin` in binary mode -- Test2::Harness2::Util::
+# read_file goes through open_file which does not call binmode, and
+# a CRLF-translating environment would corrupt the dict mid-read.
+requires 'path';
+
+sub dict_bytes {
+    my $self = shift;
+    my $abs  = File::Spec->catfile($self->path, 'zstd-dict.bin');
+    return undef unless -f $abs;
+
+    open(my $fh, '<', $abs) or croak "open '$abs': $!";
+    binmode $fh;
+    local $/;
+    my $bytes = <$fh>;
+    close $fh;
+    return $bytes;
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+App::Yath2::LogArchive::Role::DiskDict - Sibling-file
+implementation of the L<App::Yath2::LogArchive::Role::Source>
+C<dict_bytes> contract.
+
+=head1 SYNOPSIS
+
+    package App::Yath2::LogArchive::Directory;
+    use parent 'App::Yath2::LogArchive';
+    use Object::HashBase qw/path format/;
+
+    with 'App::Yath2::LogArchive::Role::Source',
+         'App::Yath2::LogArchive::Role::DiskDict';
+
+=head1 DESCRIPTION
+
+Provides a single C<dict_bytes> method that reads
+C<E<lt>pathE<gt>/zstd-dict.bin> from disk in binary mode and
+returns its bytes (or C<undef> when the file does not exist).
+
+Implementors must expose a C<path> accessor returning the root
+directory the dict file lives next to; everything else is the
+role's responsibility.
+
+This is the right shape for any backend whose underlying storage
+is a real directory tree -- the live workdir layout
+(L<App::Yath2::LogArchive::Directory>), an extracted archive, an
+NFS-mounted snapshot, etc. Backends whose dict lives I<inside> a
+single file (e.g. L<App::Yath2::LogArchive::TarZIdx>, which
+reads the dict at an offset within the archive) implement
+C<dict_bytes> themselves.
+
+=head1 SOURCE
+
+The source code repository for Test2-Harness can be found at
+L<https://github.com/Test-More/Test2-Harness>.
+
+=cut

lib/App/Yath2/LogArchive/Role/Source.pm

@@ -3,6 +3,6 @@ use strict;
 use warnings;
 use Role::Tiny;
 
-requires qw/read_file has_file list_files close viable/;
+requires qw/read_file has_file list_files close viable dict_bytes/;
 
 1;

lib/App/Yath2/LogArchive/TarZIdx.pm

@@ -171,6 +171,7 @@ sub has_file {
     return exists $self->_build_index->{$rel} ? 1 : 0;
 }
 
+# Role::Source dict_bytes contract for the tar.zidx backend.
 # Returns the bytes of the bundled zstd dictionary (the file the
 # writer copied out of $source/zstd-dict.bin) or undef when the
 # archive is dict-less. Probes the index once and caches the result;