gistfile1.txt

#!/usr/bin/env perl
use v5.40;
use strict;
use warnings;
use Fcntl qw(SEEK_CUR);
use IO::Uncompress::Gunzip qw(gunzip $GunzipError);
use IO::Uncompress::Bunzip2 qw(bunzip2 $Bunzip2Error);
use IO::Uncompress::UnXz qw(unxz $UnXzError);
use Time::Piece qw(localtime);

my $tar = shift or die "usage: $0 archive.tar\n";

scan_tar_file($tar, 0, $tar);

sub scan_tar_file ($path, $depth, $label) {
    open my $fh, '<:raw', $path or die "open $path: $!";
    scan_tar_fh($fh, $depth, $label);
    close $fh;
}

sub scan_tar_fh ($fh, $depth, $label) {
    my $zero_blocks = 0;

    while (1) {
        my $hdr = read_exact($fh, 512);
        last unless defined $hdr;

        if ($hdr eq ("\0" x 512)) {
            last if ++$zero_blocks >= 2;
            next;
        }

        $zero_blocks = 0;

        my $entry = parse_tar_header($hdr);
        last unless $entry;

        my $indent = '  ' x $depth;

        printf "%s%s\t%s\t%s\n", $indent, $entry->{name}, $entry->{size}, localtime($entry->{mtime})->strftime('%FT%T')
	  if $entry->{typeflag} == 0;

        my $size   = $entry->{size};
        my $padded = padded_size($size);

        if (is_tar_name($entry->{name}) && $entry->{typeflag} =~ /^[0\0]?$/) {
            my $data = read_exact($fh, $padded);
            my $payload = substr($data, 0, $size);

            my $nested = open_nested_tar($payload, $entry->{name});
            if ($nested) {
                scan_tar_fh($nested, $depth + 1, $entry->{name});
                close $nested;
            }
        }
        else {
            seek_or_read_skip($fh, $padded);
        }
    }
}

sub parse_tar_header ($hdr) {
    my (
        $name,
        $mode,
        $uid,
        $gid,
        $size,
        $mtime,
        $chksum,
        $typeflag,
        $linkname,
        $magic,
        $version,
        $uname,
        $gname,
        $devmajor,
        $devminor,
        $prefix,
    ) = unpack(
        'Z100 Z8 Z8 Z8 Z12 Z12 Z8 A1 Z100 Z6 Z2 Z32 Z32 Z8 Z8 Z155',
        $hdr
    );

    $typeflag = '0' if $typeflag eq "\0";

    my $full_name = $prefix ne ''
        ? "$prefix/$name"
        : $name;

    return {
        name     => $full_name,
        size     => octal($size),
        mode     => octal($mode),
        uid      => octal($uid),
        gid      => octal($gid),
        mtime    => octal($mtime),
        chksum   => octal($chksum),
        typeflag => $typeflag,
        linkname => $linkname,
        magic    => $magic,
        uname    => $uname,
        gname    => $gname,
    };
}

sub octal ($s) {
    $s =~ s/\0.*//;
    $s =~ s/\s+$//;
    $s =~ s/^\s+//;
    return $s eq '' ? 0 : oct($s);
}

sub padded_size ($size) {
    return $size + ((512 - ($size % 512)) % 512);
}

sub read_exact ($fh, $want) {
    my $buf = '';

    while (length($buf) < $want) {
        my $n = read($fh, $buf, $want - length($buf), length($buf));
        die "read failed: $!" unless defined $n;
        return undef if $n == 0 && length($buf) == 0;
        die "unexpected EOF\n" if $n == 0;
    }

    return $buf;
}

sub seek_or_read_skip ($fh, $bytes) {
    return if $bytes == 0;

    if (seek($fh, $bytes, SEEK_CUR)) {
        return;
    }

    my $buf;
    while ($bytes > 0) {
        my $chunk = $bytes > 1024 * 1024 ? 1024 * 1024 : $bytes;
        my $n = read($fh, $buf, $chunk);
        die "skip read failed: $!" unless defined $n;
        die "unexpected EOF while skipping\n" if $n == 0;
        $bytes -= $n;
    }
}

sub is_tar_name ($name) {
    return $name =~ /\.(?:tar|tar\.gz|tgz|tar\.bz2|tbz2|tar\.xz|txz)$/i;
}

sub open_nested_tar ($payload, $name) {
    open my $raw, '<:raw', \$payload or die "open scalar: $!";

    if ($name =~ /\.(?:tar)$/i) {
        return $raw;
    }

    if ($name =~ /\.(?:tar\.gz|tgz)$/i) {
        my $out = '';
        gunzip \$payload => \$out
            or die "gunzip $name: $GunzipError";
        open my $fh, '<:raw', \$out or die "open gunzipped scalar: $!";
        return $fh;
    }

    if ($name =~ /\.(?:tar\.bz2|tbz2)$/i) {
        my $out = '';
        bunzip2 \$payload => \$out
            or die "bunzip2 $name: $Bunzip2Error";
        open my $fh, '<:raw', \$out or die "open bunzipped scalar: $!";
        return $fh;
    }

    if ($name =~ /\.(?:tar\.xz|txz)$/i) {
        my $out = '';
        unxz \$payload => \$out
            or die "unxz $name: $UnXzError";
        open my $fh, '<:raw', \$out or die "open unxz scalar: $!";
        return $fh;
    }

    return undef;
}

gistfile2.txt

$ perlbrew exec --with perl-5.40.0@default perl tar_headers.pl <(case $(file tar.tar.gz) in *gzip*) gunzip < tar.tar.gz;; *tar*archive*) cat < tar.tar;; esac)
a.tar	10240	2026-06-03T18:33:50
  tmp/a/a	11	2026-06-03T18:32:58
  tmp/b/b	11	2026-06-03T18:33:06
  tmp/c/c	11	2026-06-03T18:33:13
b.tar	10240	2026-06-03T18:44:43
  tmp/a/a	11	2026-06-03T18:32:58
  tmp/b/b	11	2026-06-03T18:33:06
  tmp/c/c	11	2026-06-03T18:33:13
c.tar	10240	2026-06-03T18:44:45
  tmp/a/a	11	2026-06-03T18:32:58
  tmp/b/b	11	2026-06-03T18:33:06
  tmp/c/c	11	2026-06-03T18:33:13
a	7	2026-06-03T18:16:18
b	7	2026-06-03T18:16:22
c	7	2026-06-03T18:16:26

gistfile3.txt

$ perlbrew exec --with perl-5.40.0@default perl -Mojo -E 'my $tar = f("tar.tar")->open("<"); while(sysread($tar, $_, 512)){next unless /.{257}ustar.{250}/; @_ = map { s/\x00//gr } unpack "A100A8A8A8A12A12A8A100A8A32A32A192", $_; $_[4] = oct $_[4]; $_[5] = Mojo::Date->new(oct $_[5]); say join ",", @_[0,4,5]}'
a.tar,10240,Wed, 03 Jun 2026 23:33:50 GMT
tmp/a/,0,Wed, 03 Jun 2026 23:32:58 GMT
tmp/a/a,11,Wed, 03 Jun 2026 23:32:58 GMT
tmp/b/,0,Wed, 03 Jun 2026 23:33:06 GMT
tmp/b/b,11,Wed, 03 Jun 2026 23:33:06 GMT
tmp/c/,0,Wed, 03 Jun 2026 23:33:13 GMT
tmp/c/c,11,Wed, 03 Jun 2026 23:33:13 GMT
b.tar,10240,Wed, 03 Jun 2026 23:44:43 GMT
tmp/a/,0,Wed, 03 Jun 2026 23:32:58 GMT
tmp/a/a,11,Wed, 03 Jun 2026 23:32:58 GMT
tmp/b/,0,Wed, 03 Jun 2026 23:33:06 GMT
tmp/b/b,11,Wed, 03 Jun 2026 23:33:06 GMT
tmp/c/,0,Wed, 03 Jun 2026 23:33:13 GMT
tmp/c/c,11,Wed, 03 Jun 2026 23:33:13 GMT
c.tar,10240,Wed, 03 Jun 2026 23:44:45 GMT
tmp/a/,0,Wed, 03 Jun 2026 23:32:58 GMT
tmp/a/a,11,Wed, 03 Jun 2026 23:32:58 GMT
tmp/b/,0,Wed, 03 Jun 2026 23:33:06 GMT
tmp/b/b,11,Wed, 03 Jun 2026 23:33:06 GMT
tmp/c/,0,Wed, 03 Jun 2026 23:33:13 GMT
tmp/c/c,11,Wed, 03 Jun 2026 23:33:13 GMT
a,7,Wed, 03 Jun 2026 23:16:18 GMT
b,7,Wed, 03 Jun 2026 23:16:22 GMT
c,7,Wed, 03 Jun 2026 23:16:26 GMT

gistfile4.txt

#!/usr/bin/env perl

# perl avi.pl --width 640 --height 480 --fps 10 --seconds 1 --target 95 --output avi3.avi

use v5.38;
use strict;
use warnings;
use Getopt::Long qw(GetOptions);

my $width     = 640;
my $height    = 480;
my $fps       = 10;
my $seconds   = 60;
my $target    = 95;        # desired gzip compression percent
my $output    = 'synthetic_camera.avi';

GetOptions(
    'width=i'   => \$width,
    'height=i'  => \$height,
    'fps=i'     => \$fps,
    'seconds=i' => \$seconds,
    'target=f'  => \$target,
    'output=s'  => \$output,
) or die "Invalid options\n";

die "--target must be between 0 and 99.9\n"
    unless $target >= 0 && $target < 100;

my $frames = $fps * $seconds;

# Approximation:
# 95% target compression means roughly 5% incompressible/random bytes.
my $random_fraction = (100 - $target) / 100;

my $row_bytes = $width * 3;
my $row_pad   = (4 - ($row_bytes % 4)) % 4;
my $stride    = $row_bytes + $row_pad;
my $frame_len = $stride * $height;

open my $fh, '>:raw', $output or die "Cannot write $output: $!";

sub le16 ($n) { pack 'v', $n }
sub le32 ($n) { pack 'V', $n }

sub chunk ($id, $data) {
    return $id . le32(length($data)) . $data . ("\0" x (length($data) % 2));
}

sub list_chunk ($type, $data) {
    return 'LIST' . le32(length($data) + 4) . $type . $data;
}

sub avih_chunk ($width, $height, $fps, $frames, $frame_len) {
    my $usec_per_frame = int(1_000_000 / $fps);

    return chunk('avih', pack 'V13',
        $usec_per_frame,
        $frame_len * $fps,
        0,
        0x10,
        $frames,
        0,
        1,
        $frame_len,
        $width,
        $height,
        0,
        0,
        0,
        0,
    );
}

sub strh_chunk ($width, $height, $fps, $frames, $frame_len) {
    return chunk('strh',
        'vids' .
        'DIB ' .
        pack('V', 0) .
        pack('v', 0) .
        pack('v', 0) .
        pack('V', 0) .
        pack('V', 1) .
        pack('V', $fps) .
        pack('V', 0) .
        pack('V', $frames) .
        pack('V', $frame_len) .
        pack('V', 0xFFFFFFFF) .
        pack('V', 0) .
        pack('v4', 0, 0, $width, $height)
    );
}

sub strf_chunk ($width, $height) {
    return chunk('strf', pack 'V3v2V6',
        40,
        $width,
        $height,
        1,
        24,
        0,
        0,
        0,
        0,
        0,
        0,
    );
}

sub make_frame ($frame_no, $width, $height, $stride, $random_fraction) {
    my $buf = "\0" x ($stride * $height);

    my $box_size = int($height / 6);
    my $box_x = int(($frame_no * 7) % ($width - $box_size));
    my $box_y = int($height / 2 + sin($frame_no / 8) * ($height / 5));

    for my $y (0 .. $height - 1) {
        my $base = ($height - 1 - $y) * $stride;

        for my $x (0 .. $width - 1) {
            my $pos = $base + $x * 3;

            my $r = int(20 + 20 * sin(($x + $frame_no) / 60));
            my $g = int(30 + 20 * sin(($y + $frame_no) / 80));
            my $b = int(40 + 20 * sin(($x + $y) / 100));

            if (
                $x >= $box_x && $x < $box_x + $box_size &&
                $y >= $box_y && $y < $box_y + $box_size
            ) {
                $r = 220;
                $g = 220;
                $b = 220;
            }

            substr($buf, $pos, 3) = pack 'C3', $b, $g, $r;
        }
    }

    # Add tunable entropy as random byte mutations.
    # This approximates gzip output size; exact ratio depends on gzip version and file size.
    my $noise_bytes = int(length($buf) * $random_fraction);

    for (1 .. $noise_bytes) {
        my $pos = int(rand(length($buf)));
        substr($buf, $pos, 1) = chr int rand 256;
    }

    return $buf;
}

my $hdrl = list_chunk('hdrl',
    avih_chunk($width, $height, $fps, $frames, $frame_len) .
    list_chunk('strl',
        strh_chunk($width, $height, $fps, $frames, $frame_len) .
        strf_chunk($width, $height)
    )
);

my @frame_chunks;
my $movi_data = '';

for my $i (0 .. $frames - 1) {
    my $frame = make_frame($i, $width, $height, $stride, $random_fraction);
    $movi_data .= chunk('00db', $frame);
}

my $movi = list_chunk('movi', $movi_data);

my $riff_data = $hdrl . $movi;

print {$fh} 'RIFF', le32(length($riff_data) + 4), 'AVI ', $riff_data;
close $fh;

say "Wrote $output";
say "Resolution: ${width}x${height}";
say "FPS: $fps";
say "Seconds: $seconds";
say "Frames: $frames";
say "Target gzip compression: $target%";
say "Random entropy fraction: " . sprintf('%.4f', $random_fraction);