class Archive::SCS 1.06;
field
@formats
=
qw( HashFS2 HashFS Directory )
;
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_file) {
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;
push
@mounts
,
$mount
;
push
$entries
{
$_
}->@*,
$mount
for
my
@entries
=
$mount
->entries;
$mount
->read_dir_tree(
@ROOTS
);
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;
for
my
$hash
(
keys
%entries
) {
$entries
{
$hash
} = [
grep
{
$mount
!=
$_
}
$entries
{
$hash
}->@* ];
$entries
{
$hash
}->@* == 0 and
delete
$entries
{
$hash
};
}
@mounts
=
grep
{
$mount
!=
$_
}
@mounts
;
return
$mount
;
}
method is_mounted (
$mountable
) {
first {
$mountable
->path->realpath eq
$_
->path->realpath }
@mounts
}
method entry_mounts (
$path
) {
my
$mounts
=
$entries
{ cityhash64
$path
};
$mounts
//=
$entries
{ cityhash64_hex
$path
};
my
@mounts
=
$mounts
?
$mounts
->@* : ();
return
@mounts
;
}
method read_entry (
$path
) {
my
$hash
;
my
$mounts
=
$entries
{
$hash
= cityhash64
$path
};
$mounts
//=
$entries
{
$hash
= cityhash64_hex
$path
};
$mounts
or croak
sprintf
"'%s': no entry found"
,
$path
;
my
$mount
=
$mounts
->[ $
return
$mount
->read_entry(
$hash
);
}
method list_dirs (
$root
=
''
) {
my
@dirs
= uniqstr
sort
map
{
$_
->list_dirs }
@mounts
;
@dirs
=
grep
/^\Q
$root
\E(?:\/|$)/,
@dirs
if
length
$root
;
shift
@dirs
unless
length
$dirs
[0];
return
@dirs
;
}
method list_files (
$root
=
''
) {
my
@files
= uniqstr
sort
map
{
$_
->list_files }
@mounts
;
@files
=
grep
/^\Q
$root
\E(?:\/|$)/,
@files
if
length
$root
;
return
@files
;
}
method list_orphans () {
my
@paths
= (
eval
{
$self
->list_dirs },
eval
{
$self
->list_files } );
my
%paths
=
map
{( cityhash64
$_
=>
$_
)}
@paths
,
@ROOTS
;
my
@orphans
;
for
my
$hash
(
keys
%entries
) {
defined
$paths
{
$hash
} or
push
@orphans
,
$hash
;
}
return
map
{ cityhash64_as_hex
$_
} uniqstr
sort
@orphans
;
}
1;
=head1 NAME
Archive::SCS - SCS archive controller
=head1 SYNOPSIS
my
$scs
= Archive::SCS->new;
$scs
->mount(
"$path/base.scs"
);
$scs
->mount(
"$path/def.scs"
);
my
@contents
=
sort
$scs
->list_dirs,
$scs
->list_files;
say
$scs
->read_entry(
'def/env_data.sii'
);
=head1 DESCRIPTION
Handles the union file
system
used by SCS archive files.
Allows mounting of multiple files or extracted directories and
performs lookups in all of them using the SCS hash algorithm.
These modules exist primarily to support the F<scs_archive>
command-line tool included in this distribution.
=head1 METHODS
=head2 formats
@formats
=
$scs
->formats;
Returns the list of currently active formats.
See C<set_formats()>.
=head2 list_dirs
@directories
=
$scs
->list_dirs;
Returns an ordered list of all directory paths in currently
mounted archives. The root directory, represented by an empty
string, is currently omitted from the list.
Paths are returned without a leading C</> because that's the
way they are stored internally. This is subject to change,
but the output of C<list_dirs()> will always be good to
use
as path
for
C<read_entry()>.
=head2 list_files
@files
=
$scs
->list_files;
Returns an ordered list of all file paths in currently mounted
archives.
Paths are returned without a leading C</> because that's the
way they are stored internally. This is subject to change,
but the output of C<list_files()> will always be good to
use
as path
for
C<read_entry()>.
=head2 list_orphans
@orphan_hashes
=
$scs
->list_orphans;
Returns a list of hash
values
for
orphans in currently mounted archives.
Some file formats allow files (or subdirs) without a directory entry.
These files may be accessed directly using their hash value. This
software refers to such files as orphans. For example, the following
orphans are known to exist in 1.49.3.14:
05c075dc23d8d177
0eeaffbe65995414
0fb3a3294f8ac99c
2a794836b65afe88
34f7048e2d3b04b6
507dcc5fb3fb6443
83a9902d7733b94d
88a1194cb25b253c
c09356068ea66aac
d9d3d2a218c69f3d
e773fb1407c8468d
=head2 mount
$archive
=
$scs
->mount(
$pathname
);
$archive
=
$scs
->mount(
$mountable
);
Adds the
given
SCS archive to the currently mounted archives.
Returns an L<Archive::SCS::Mountable> object. If a file
system
path is
given
as argument, the object will be created by
attempting to load the
given
archive
with
the currently active
formats. See C<set_formats()>.
=head2 new
$scs
= Archive::SCS->new;
Creates a new L<Archive::SCS> object.
=head2 read_entry
$data
=
$scs
->read_entry(
$pathname
);
$data
=
$scs
->read_entry(
$hash
);
Returns the contents of the
given
entry. Directories will be
returned as L<Archive::SCS::DirIndex> objects and S<HashFS v2>
texture objects as L<Archive::SCS::TObj>.
The argument may be the pathname within the archive or its hash
value,
hex
-encoded in network byte order as a 16-byte
scalar
PV.
Paths are expected without a leading C</> because that's the
way they are stored internally. This is subject to change,
but the output of C<list_files()> will always be good to
use
as path
for
C<read_entry()>.
=head2 set_formats
$scs
=
$scs
->set_formats(
qw[ HashFS Zip ]
);
Sets the list of currently active formats. All formats must be
in the C<Archive::SCS> namespace. By
default
, the list includes
all formats implemented in this distribution, which currently
are the following:
=over
=item * L<Archive::SCS::Directory>
=item * L<Archive::SCS::HashFS>
=item * L<Archive::SCS::HashFS2>
=back
=head2 unmount
$archive
=
$scs
->unmount(
$pathname
);
$archive
=
$scs
->unmount(
$mountable
);
Removes the
given
SCS archive from currently mounted archives.
Returns the archive's L<Archive::SCS::Mountable> object.
=head1 SEE ALSO
=over
=item * L<Archive::SCS::GameDir>
=back
=head1 AUTHOR
=head1 COPYRIGHT
This software is copyright (c) 2025 by nautofon.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language
system
itself.
Copyright (c) 2011 Google, Inc. (MIT license)