view release on metacpan or  search on metacpan

lib/Archive/SCS.pm  view on Meta::CPAN

use v5.34;
use warnings;
use Object::Pad 0.73;

class Archive::SCS 1.09;

use stable 0.031 'isa';

use Archive::SCS::CityHash qw(cityhash64 cityhash64_hex cityhash64_as_hex);
use Carp 'croak';
use List::Util 1.45 qw(first uniqstr);
use Module::Load 'load';
use Path::Tiny 0.054 'path';

use Archive::SCS::Directory;
use Archive::SCS::HashFS;
use Archive::SCS::HashFS2;
use Archive::SCS::Zip;

field @formats = qw( HashFS2 HashFS Directory Zip );

field @mounts;
field %entries;

my @ROOTS = ('', 'locale');


method formats () {
  @formats
}


method set_formats {
  load __PACKAGE__ . "::$_" for @_;
  @formats = @_;
  return $self;
}


method format_module ($path) {
  my $header = '';
  if (! $path->is_dir) {
    open my $fh, '<:raw', $path or croak
      sprintf "%s: $!", $path->basename;
    read $fh, $header, 8 or croak
      sprintf "%s: $!", $path->basename;
    close $fh;
  }

  my @modules = map { __PACKAGE__ . "::$_" } @formats;
  my $module = first { $_->handles_path($path, $header) } @modules or croak
    sprintf "%s: No suitable format handler found", $path->basename;
  return $module;
}


method mount ($mountable) {
  if ( not $mountable isa Archive::SCS::Mountable ) {
    my $path = path $mountable;
    my $format = $self->format_module($path);
    $mountable = $format->new(path => $path);
  }
  my $basename = $mountable->path->basename;

  $self->is_mounted($mountable) and croak
    sprintf "%s: Already mounted", $basename;

  my $mount = $mountable->mount;
  $mount->read_dir_tree(@ROOTS);
  push @mounts, $mount;
  push $entries{$_}->@*, $mount for my @entries = $mount->entries;

  return $mount;
}


method unmount ($mount) {
  if ( not $mount isa Archive::SCS::Mountable ) {
    my $path = path $mount;
    $mount = first { $path->realpath eq $_->path->realpath } @mounts or croak
      sprintf "%s: Not mounted", $path->basename;
  }

  $mount->unmount;