gistfile1.txt

package OFP::Asset;
use Mojo::Base -strict, -signatures;

use Mojo::Collection qw(c);
use Mojo::File;

has [qw(fat oat)];
has [qw(core sup partner sil1 sil2 sil3)];
has warnings => sub { Mojo::Collection->new };

sub add_file ($self, $path) {
  my $basename = Mojo::File->new($path)->basename;
  return unless scalar grep { defined $self->$_ && $self->$_ eq $basename } qw(jp fileid filename);
  my $asset = Mojo::Asset::File->with_roles('+OFP::File')->new(path => $path) or return;
  return unless $asset->is(jp => $self->jp) || $asset->is(fileid => $self->fileid) || $asset->is(filename => $self->filename);
  my $from = $asset->from;
  return if $self->$from;
  $self->$from($asset) if $from;
}

sub get ($self, $field) {
  my $value = c(map { ref $self->$_ ? [$_ => $self->$_->$field] : undef } qw(fat oat core sup partner sil1 sil2 sil3))
    ->grep(sub { defined $_ })
    ->uniq;
  return $value->first->[1] if $value->size == 1;
  warn "Multiple values for $field: " . $value->map(sub { "$_->[0]:$_->[1]" })->join(', ') if $value->size > 1;
  return undef;
}

sub jp ($self) { $self->get('jp') }
sub fileid ($self) { $self->get('fileid') }
sub filename ($self) { $self->get('filename') }
sub file ($self) { $self->get('file') }
sub dmm_filename ($self) { $self->get('dmm_filename') }
sub host_filename ($self) { $self->get('host_filename') }
sub crc ($self) { $self->get('crc') }
sub ccs ($self) { $self->get('ccs') }

1;

package Mojo::Asset::File::Role::OFP::File;
use Mojo::Base -role, -signatures;
use overload '""' => sub { shift->to_string }, fallback => 1;

use Digest::SHA;
use Mojo::Collection;
use Mojo::File;
use Mojo::Util;

has simple_path => undef;

has fileid => undef;
has filename => undef;
has jp => undef;

has from_core => undef;
has from_sup => undef;
has from_partner => undef;
has from_sil1 => undef;
has from_sil2 => undef;
has from_sil3 => undef;

has on_pc => undef;
has on_disk1 => undef;
has on_disk2 => undef;

has warnings => sub { Mojo::Collection->new };

sub from ($self) {
  return 'core' if $self->from_core;
  return 'sup' if $self->from_sup;
  return 'partner' if $self->from_partner;
  return 'sil1' if $self->from_sil1;
  return 'sil2' if $self->from_sil2;
  return 'sil3' if $self->from_sil3;
  return undef;
}

sub from_sil ($self) { $self->from_sil1 || $self->from_sil2 || $self->from_sil3 };

sub file ($self) { $self->fileid ? sprintf 'ABCD%04d.XYZ', $self->fileid : undef }

sub flip_sum ($self) {
  my $path = Mojo::File->new($self->path);
  my $sum_file = $path->sibling(sprintf '.%s.flip_sum', $path->basename);
  return $sum_file->slurp if -s $sum_file;

  my $sha1 = Digest::SHA->new(1);

  open my $fh, '<:raw', $self->path or die qq{Could not open "@{[$self->path]}": $!};

  my $size = -s $fh;

  while ($size > 0) {
    my $read_size = $size >= 4 ? 4 : $size;
    $size -= $read_size;

    seek $fh, $size, 0 or die qq{Could not seek in "@{[$self->path]}": $!};

    my $buffer;
    my $bytes_read = read $fh, $buffer, $read_size;
    die qq{Could not read from "@{[$self->path]}": $!} if !defined $bytes_read;
    die qq{Short read from "@{[$self->path]}"} if $bytes_read != $read_size;

    $sha1->add(scalar reverse $buffer);
  }

  close $fh or die qq{Could not close "@{[$self->path]}": $!};

  my $hexdigest = $sha1->hexdigest;
  $sum_file->spurt($hexdigest);
  return $hexdigest;
}

sub is ($self, $field, $value) { defined $self->$field && defined $value && $self->$field eq $value }
sub is_flip ($self, $sum) { $self->flip_sum eq $sum }
sub is_orig ($self, $sum) { $self->orig_sum eq $sum }
sub is_same ($self, $sum) { $self->is_flip($sum) || $self->is_orig($sum) }
sub ok ($self, $field) { defined $self->$field }

sub on ($self) {
  return 'pc' if $self->on_pc;
  return 'disk1' if $self->on_disk1;
  return 'disk2' if $self->on_disk2;
  return undef;
}

sub on_disk ($self) { $self->on_disk1 || $self->on_disk2 };

sub orig_sum ($self) {
  my $path = Mojo::File->new($self->path);
  my $sum_file = $path->sibling(sprintf '.%s.orig_sum', $path->basename);
  return $sum_file->slurp if -s $sum_file;
  my $sha1 = Mojo::Util::sha1_sum($path->slurp);
  $sum_file->spurt($sha1);
  return $sha1;
}

sub set_file ($self, $file) { $self->set_fileid($file) }
sub set_fileid ($self, $fileid) { defined $self->fileid and warn "FileID is already set" and push @{$self->warnings}, [fileid => $fileid] and return $self; $self->fileid(sprintf '%04s', $fileid =~ s/^(ABCD)?(\w{4})(\.XYZ)?$/$2/r); return $self }
sub set_filename ($self, $filename) { defined $self->filename and warn "Filename is already set" and push @{$self->warnings}, [filename => $filename] and return $self; $self->filename($filename); return $self }
sub set_jp ($self, $jp) { defined $self->jp and warn "JP is already set" and push @{$self->warnings}, [jp => $jp] and return $self; $self->jp($jp); return $self }

sub to_string ($self) {
  sprintf 'JP: %s, FileID: %s, File: %s, Filename: %s',
    defined $self->jp ? $self->jp : 'undef',
    defined $self->fileid ? $self->fileid : 'undef',
    defined $self->file ? $self->file : 'undef',
    defined $self->filename ? $self->filename : 'undef',
}

1;

gistfile2.txt

use Mojo::Base -strict, -signatures;

$ARGV[0] ||= '.';

my $ofp = OFP->new(path => path($ARGV[0]));

package OFP;
use Mojo::Base -base, -signatures;

use Mojo::Collection qw(c);

has fat => sub { OFP::FAT->new(path => shift->path) };
has files => sub { Mojo::Collection->new };
has oat => sub { OFP::OAT->new(path => shift->path) };
has path => sub { die "Path is required" };

sub new {
  my $self = shift->SUPER::new(@_);
  my $hash = $self->path->list_tree->map(sub {
    my $fat = $self->fat->fetch($_->basename);
    my $oat = $self->oat->fetch($_->basename);
    OFP::File->new(path => $self->path, %$fat, %$oat);
  })->reduce(sub {
    push @{$a->{$b->sha1_sum}}, $b;
    return $a;
  }, {});
  push @{$self->files}, c(@{$hash->{$_}}) for keys %$hash;

  return $self;
}

1;

package OFP::File;
use Mojo::Base -base, -signatures;

use Digest::SHA qw(sha1_hex);
use Fcntl qw(SEEK_SET SEEK_END);

use constant WORDS_PER_CHUNK => 65536; # 262_144

# File
has path => undef;
has simple_path => undef;
has basename => undef;
#has fileid
#has jp
has size ($self) {
  my $size = -s $self->path;
  defined $size or die sprintf "could not stat(%s)", $self->path;
  return $size;
}

sub new {
  my $self = shift->SUPER::new(@_);
  $self->_digest_all_transforms;
  return $self;
}

sub _read_len_bytes ($self, $fh, $len) {
  my $buf = '';
  my $got = 0;

  while ($got < $len) {
    my $n = sysread($fh, $buf, $len - $got, $got);
    die "sysread failed: $!" unless defined $n;
    die "unexpected EOF" if $n == 0;
    $got += $n;
  }

  return $buf;
}

sub _open_raw_read ($self) {
  open my $fh, '<:raw', $self->path or die sprintf "open(%s): %s", $self->path, $!;
  return $fh;
}

sub _swap32_copy ($buf) { pack('(V*)', unpack('(N*)', $buf)) }

sub _reverse_word_order32_copy ($buf) { join '', reverse unpack('(a4)*', $buf) }

sub _digest_all_transforms ($self, $words_per_chunk = WORDS_PER_CHUNK) {
  my $path = $self->path;
  $words_per_chunk = WORDS_PER_CHUNK if !defined $words_per_chunk || $words_per_chunk < 1;

  my $size = $self->size;
  die "file size must be a multiple of 4 bytes\n" if $size % 4 != 0;

  my $chunk_bytes = $words_per_chunk * 4;

  my $sha_exact                  = Digest::SHA->new(1);
  my $sha_swap32                 = Digest::SHA->new(1);
  my $sha_reverse_words32        = Digest::SHA->new(1);
  my $sha_reverse_words32_swap32 = Digest::SHA->new(1);

  {
    my $fh = $self->_open_raw_read;

    my $remaining = $size;
    while ($remaining > 0) {
      my $take = $remaining < $chunk_bytes ? $remaining : $chunk_bytes;
      my $buf = $self->_read_len_bytes($fh, $take);

      $sha_exact->add($buf);
      $sha_swap32->add(_swap32_copy($buf));

      $remaining -= $take;
    }

    close $fh or die "close($path): $!";
  }

  {
    my $fh = $self->_open_raw_read;

    my $remaining = $size;
    while ($remaining > 0) {
      my $take = $remaining < $chunk_bytes ? $remaining : $chunk_bytes;
      my $offset = $remaining - $take;

      sysseek($fh, $offset, SEEK_SET) == $offset
        or die "sysseek failed at offset $offset: $!";

      my $buf = $self->_read_len_bytes($fh, $take);

      my $rev_words = _reverse_word_order32_copy($buf);

      $sha_reverse_words32->add($rev_words);
      $sha_reverse_words32_swap32->add(_swap32_copy($rev_words));

      $remaining -= $take;
    }

    close $fh or die "close($path): $!";
  }

  $self
    ->exact($sha_exact->hexdigest)
    ->swap32($sha_swap32->hexdigest)
    ->reverse_words32($sha_reverse_words32->hexdigest)
    ->reverse_words32_swap32($sha_reverse_words32_swap32->hexdigest);
}

package OFP::OFP_File;
use Mojo::Base -base, -signatures;

# Contains the FAT/OAT attributes and a collection of OFP::File objects

has files => sub { Mojo::Collection->new };
has warnings => sub { Mojo::Collection->new };

# All
has id => undef;
has jp => undef;

# File
has from_core => undef;
has from_sup => undef;
has from_partner => undef;
has from_sil1 => undef;
has from_sil2 => undef;
has from_sil3 => undef;

has on_pc => undef;
has on_disk1 => undef;
has on_disk2 => undef;

sub from ($self) {
  return 'core' if $self->from_core;
  return 'sup' if $self->from_sup;
  return 'partner' if $self->from_partner;
  return 'sil1' if $self->from_sil1;
  return 'sil2' if $self->from_sil2;
  return 'sil3' if $self->from_sil3;
  return undef;
}

sub from_sil ($self) { $self->from_sil1 || $self->from_sil2 || $self->from_sil3 };

sub on ($self) {
  return 'pc' if $self->on_pc;
  return 'disk1' if $self->on_disk1;
  return 'disk2' if $self->on_disk2;
  return undef;
}

sub on_disk ($self) { $self->on_disk1 || $self->on_disk2 };

# FAT
#has id
has dmm_filename => undef;
#has jp
has host_filename => undef;

# OAT
#has jp
#has id
has oat_type => undef;
has ccs => undef;
has ipt => undef;
has filename => undef;
has crc => undef;

sub add_fat ($self, $str) {
  my ($id, $dmm_filename, $jp, $host_filename) = split /\s*,\s*/, $str;
  $self->id($id) if defined $id && !$self->id;
  $self->jp($jp) if defined $jp && !$self->jp;
  $self->dmm_filename($dmm_filename) if defined $dmm_filename && !$self->dmm_filename;
  $self->host_filename($host_filename) if defined $host_filename && !$self->host_filename;
}

sub add_file ($self, $path) {
  my $file = OFP::File->new(path => $path);
  if ( $file->basename =~ s/^(ABCD)?(\w{4})(\.XYZ)?$/$2/ ) {
    $self->id(sprintf '%04s', $2) if defined $2 && !$self->id;
  }
  elsif ( $file->basename =~ /^5K\w{13}$/ ) {
    $self->jp($file->basename) if !$self->jp;
  }
  else {
    warn "Unrecognized file name format: " . $file->basename;
  }
  push @{$self->files}, $file;
}

sub add_oat ($self, $str) {}

sub fileiddat ($self) { $self->id ? sprintf 'ABCD%04d.XYZ', $self->id : undef }

1;