Pasted

#!/usr/bin/perl
use 5.028;
use strict;
use warnings qw(all);
use autodie qw(mkdir);
 
use Data::Dump qw(pp);
use Digest::SHA qw(sha256_hex);
use File::Copy qw(copy);
use File::Slurper qw(write_text read_text);
use IPC::Run3;
 
my %cached = (
    abstraction        => 1,
    compatibility_hint => 1,
    device             => 0,    # no need, fast
    fs                 => 1,
    fs_uuid            => 1,
    hints_string       => 1,
    partmap            => 1,
);
 
my $cachedir = '/var/cache/local-grub-probe';
my $real = 'grub-probe.cache-real';
 
unless (-d $cachedir) {
    mkdir($cachedir);
}
 
my @targets = find_targets();
if (0 == @targets) {
    warn "No --target argument?";
    forward_to_real(); # does not return
} elsif (1 == @targets) {
    my $target = $targets[0];
    exists $cached{$target}
        or warn "Unknown target $target (treating as uncached)";
    if ($cached{$target}) {
        exit handle_cached();
    } else {
        forward_to_real() # does not return;
    }
} else {
    warn "Multiple --target arguments";
    forward_to_real(); # does not return;
}
 
sub find_targets {
    my @targets;
    for (my $i = 0; $i < @ARGV; ) {
        if ($ARGV[$i] eq '-t') {
            push @targets, $ARGV[1+$i];
            $i += 2;
        } elsif ($ARGV[$i] =~ /^--target=(.+)$/) {
            push @targets, $1;
            $i += 1;
        } else {
            $i += 1
        }
    }
 
    return @targets;
}
 
sub forward_to_real { exec {$real} 'grub-probe', @ARGV }
 
sub handle_cached {
    my $hash = sha256_hex(join(q{!}, @ARGV));
    my $cmd = "$cachedir/$hash.cmd"; # final one written + useful debug
    my $out = "$cachedir/$hash.out";
    my $err = "$cachedir/$hash.err";
    my $res = "$cachedir/$hash.res";
 
    -e $cmd || run_and_cache($cmd, $res, $out, $err);
 
    copy($out, \*STDOUT);
    copy($err, \*STDERR);
 
    return 0+read_text($res);
}
 
sub run_and_cache {
    my ($cmd, $res, $out, $err) = @_;
 
    run3 [ $real, @ARGV ], undef, $out, $err;
    ($? & 0xFF) and die "$real died terribly: $?";
    write_text($res, ($?>>8)."\n");
    write_text($cmd, scalar(pp @ARGV)."\n");
    return;
}