File-FStore
view release on metacpan or search on metacpan
lib/File/FStore.pm view on Meta::CPAN
# Copyright (c) 2025 Philipp Schafft
# licensed under Artistic License 2.0 (see LICENSE file)
# ABSTRACT: Module for interacting with file stores
package File::FStore;
use v5.10;
use strict;
use warnings;
use Carp;
use DBI;
use File::Spec;
use Data::Identifier;
use Data::Identifier::Generate;
use Scalar::Util qw(weaken);
use File::FStore::File;
use parent 'Data::Identifier::Interface::Known';
our $VERSION = v0.06;
use constant {
DEFAULT_LINK_STYLE => '1-level',
DEFAULT_STORE_STYLE => '1-level-contentise',
};
my %_types = (
db => 'Data::TagDB',
extractor => 'Data::URIID',
fii => 'File::Information',
);
our %_valid_digests = map {$_ => int((/^[^-]+-[^-]-([0-9]+)$/)[0]/4)} (
qw(md-5-128 sha-1-160),
(map {'sha-2-'.$_, 'sha-3-'.$_} 224, 256, 384, 512),
);
our %_valid_link_styles = map {$_ => 1} qw(none 1-level 2-level);
our %_valid_store_styles = map {$_ => 1} qw(1-level-contentise 2-level-contentise);
my %_flat_settings = map {$_ => $_} qw(link_style store_style);
sub create {
my ($pkg, %opts) = @_;
my $path = delete($opts{path});
my $digests = delete($opts{digests}) // [keys %_valid_digests];
my %extra;
my $dbh;
foreach my $key (keys(%_types), qw(weak)) {
my $v = delete $opts{$key};
$extra{$key} = $v if defined $v;
}
croak 'Stray options passed' if scalar keys %opts;
$digests = [split(/\s*,\s*|\s+/, $digests)] unless ref $digests;
foreach my $digest (@{$digests}) {
croak 'Invalid digest: '.$digest unless defined $_valid_digests{$digest};
}
mkdir($path) or croak $!;
mkdir(File::Spec->catdir($path, qw(v2))) or croak $!;
mkdir(File::Spec->catdir($path, qw(v2 store))) or croak $!;
mkdir(File::Spec->catdir($path, qw(v2 by))) or croak $!;
foreach my $digest (@{$digests}) {
mkdir(File::Spec->catdir($path, qw(v2 by), $digest)) or croak $!;
}
$dbh = DBI->connect('dbi:SQLite:dbname='.File::Spec->catfile($path => v2 => store => 'db.sqlite'), undef, undef, { RaiseError => 1, PrintError => undef });
#@inject SQLITE
$dbh->do($_) for split /;/, << 'SQL';
CREATE TABLE file (
id INTEGER NOT NULL UNIQUE PRIMARY KEY AUTOINCREMENT,
filename VARCHAR(128) NOT NULL UNIQUE
);
CREATE TABLE file_properties (
file INTEGER NOT NULL REFERENCES file (id),
key VARCHAR(64) NOT NULL,
value VARCHAR(128) NOT NULL,
UNIQUE (file, key)
);
CREATE TABLE file_hash (
file INTEGER NOT NULL REFERENCES file (id),
algo VARCHAR(32) NOT NULL,
hash VARCHAR(255) NOT NULL UNIQUE,
UNIQUE (file, algo)
);
SQL
$dbh->disconnect;
return $pkg->new(path => $path, %extra);
}
#@returns __PACKAGE__
sub new {
my ($pkg, %opts) = @_;
my $path = delete $opts{path} // croak 'No path given';
my $weak = delete $opts{weak};
my @used_digests;
my $self = bless {
path => $path,
used_digests => \@used_digests,
transaction_count => 0,
link_style => DEFAULT_LINK_STYLE,
store_style => DEFAULT_STORE_STYLE,
}, $pkg;
foreach my $key (keys %_types) {
my $v = delete $opts{$key};
next unless defined $v;
croak 'Invalid type for key: '.$key unless eval {$v->isa($_types{$key})};
$self->{$key} = $v;
weaken($self->{$key}) if $weak;
}
if (defined(my $link_style = delete $opts{link_style})) {
$link_style = DEFAULT_LINK_STYLE if $link_style eq 'default';
croak 'Not a valid link style: '.$link_style unless defined $_valid_link_styles{$link_style};
$self->{link_style} = $link_style;
}
if (defined(my $store_style = delete $opts{store_style})) {
$store_style = DEFAULT_STORE_STYLE if $store_style eq 'default';
croak 'Not a valid store style: '.$store_style unless defined $_valid_store_styles{$store_style};
$self->{store_style} = $store_style;
}
croak 'Stray options passed' if scalar keys %opts;
opendir(my $dir, $self->_directory(v2 => 'by')) or croak $!;
while (defined(my $ent = readdir($dir))) {
next if $ent =~ /^\./;
croak 'Invalid store, unsupported/invalid digest used: '.$ent unless $_valid_digests{$ent};
push(@used_digests, $ent);
}
closedir($dir);
$self->{dbh} = DBI->connect('dbi:SQLite:dbname='.$self->_file(v2 => store => 'db.sqlite'), undef, undef, { RaiseError => 1, PrintError => undef });
return $self;
}
sub close {
my ($self) = @_;
$self->DESTROY;
}
sub setting {
my ($self, $key) = @_;
croak 'No key given' unless defined $key;
if (defined(my $flatkey = $_flat_settings{$key})) {
return $self->{$flatkey};
}
croak 'Unknown key: '.$key;
}
sub in_transaction {
my ($self, $type, $code) = @_;
my $error;
croak 'Bad transaction type' unless $type eq 'ro' || $type eq 'rw';
return undef if defined $self->{transaction_error};
if ($self->{transaction_count}) {
if ($type ne 'ro' && $type ne $self->{transaction_type}) {
croak 'Invalid inner transaction type '.$type.' within outer '.$self->{transaction_type}.' transaction';
lib/File/FStore.pm view on Meta::CPAN
if ($fix eq 'scrub') {
$self->scrub;
} elsif ($fix eq 'scan') {
$self->scan;
} elsif ($fix eq 'upgrade') {
$self->migration->upgrade;
} elsif ($fix =~ /^remove-(inode|mediasubtype|inodeise)$/) {
my $what = $1;
my $sth = $self->{dbh}->prepare('DELETE FROM file_properties WHERE key = ?');
$sth->execute($what);;
} else {
croak 'BUG';
}
}
if (scalar keys %fixes) {
croak 'Invalid/unknown fixes passed: '.join(', ', keys %fixes);
}
}
#@returns File::FStore::Adder
sub new_adder {
my ($self) = @_;
require File::FStore::Adder;
return File::FStore::Adder->_new(store => $self);
}
#@returns File::FStore::Migration
sub migration {
my ($self) = @_;
require File::FStore::Migration;
return File::FStore::Migration->_new(store => $self);
}
sub export {
my ($self, @args) = @_;
return $self->migration->export_data(@args);
}
sub import_data {
my ($self, @args) = @_;
return $self->migration->import_data(@args);
}
sub attach {
my ($self, %opts) = @_;
my $weak = delete $opts{weak};
foreach my $key (keys %_types) {
my $v = delete $opts{$key};
next unless defined $v;
croak 'Invalid type for key: '.$key unless eval {$v->isa($_types{$key})};
$self->{$key} //= $v;
croak 'Missmatch for key: '.$key unless $self->{$key} == $v;
weaken($self->{$key}) if $weak;
}
croak 'Stray options passed' if scalar keys %opts;
}
#@returns Data::TagDB
sub db {
my ($self, %opts) = @_;
return $self->{db} if defined $self->{db};
return $opts{default} if exists $opts{default};
croak 'No database known';
}
#@returns Data::URIID
sub extractor {
my ($self, %opts) = @_;
return $self->{extractor} if defined $self->{extractor};
return $opts{default} if exists $opts{default};
croak 'No extractor known';
}
#@returns File::Information
sub fii {
my ($self) = @_;
return $self->{fii} if defined $self->{fii};
require File::Information;
File::Information->VERSION(v0.06);
return $self->{fii} = File::Information->new(
db => $self->db(default => undef),
extractor => $self->extractor(default => undef),
);
}
# --- Overrides for Data::Identifier::Interface::Known ---
sub _known_provider {
my ($pkg, @args) = @_;
return $pkg->File::FStore::File::_known_provider(@args);
}
# ---- Private helpers ----
sub _placeholders {
my ($self, $field, $list) = @_;
my $placeholders = '?,' x scalar(@{$list});
$placeholders =~ s/,$//;
return sprintf('%s IN (%s)', $field, $placeholders);
}
sub DESTROY {
my ($self) = @_;
$self->{dbh}->disconnect if defined $self->{dbh};
%{$self} = ();
lib/File/FStore.pm view on Meta::CPAN
=item C<digests>
List of digests to be used in the store. Each digest is given in the universal tag format (or utag)
(e.g. C<sha-3-224>.
The list can be passed as a arrayref or as a comma seperated list.
The list can contain digests that are not supported by the system this runs on.
They may for example still be used with import/export functions.
The list can be adjusted at a later time.
=back
=head2 new
my File::FStore $store = File::FStore->new(path => ..., ...);
Creates a new instance of the store and opens it.
The following options are supported:
=over
=item C<db>
A L<Data::TagDB> object. See L</db>.
=item C<extractor>
A L<Data::URIID> object. See L</extractor>.
=item C<fii>
A L<File::Information> object. See L</fii>.
=item C<link_style>
(since v0.05)
The style to use for links. One of: C<none>, C<1-level>, or C<2-level>.
B<Note:>
This does not affect already existing links unless one of the relevant calls is made.
=item C<path>
The path to the store.
=item C<store_style>
(since v0.05)
The style to use for storing files. One of: C<1-level-contentise>, or C<1-level-contentise>.
B<Note:>
This does not affect already existing files.
=item C<weak>
Marks the value for C<db>, C<extractor>, C<fii> as weak.
If only a specific one needs needs to be weaken use L</attach>.
=back
=head2 close
$store->close;
Closes the store. Any interaction with this object or any related objects after this call is invalid.
=head2 setting
my $value = $store->setting($key);
(since v0.05)
Gets a setting of the store.
The type of the returned value depends on the key.
=head2 in_transaction
$db->in_transaction(ro => sub { ....});
# or:
$db->in_transaction(rw => sub { ....});
Runs a block of code (a subref) inside a transaction.
The passed block is run in a transaction. The transaction is commited after the code finishes.
The type of the transaction can be C<ro> (read only) or C<rw> (read-write).
The module may optimise based on this information.
If a write operation is performed in a transaction that is marked C<ro> the behaviour is unspecified.
Calls to this method can be stacked freely.
For example the following is valid:
$store->in_transaction(ro => sub {
# do some read...
$store->in_transaction(rw => sub {
# do some write...
});
# do more reading, writing is invalid here
});
B<Note:>
If the code C<die>s the transaction is aborted and the error is raised again.
Note that this affects all currently open transactions (as per stacking).
If the (parent) transaction is already aborted when this method is called the code block might not be run at all.
B<Note:>
Data written might only be visible to other handles of the same database once I<all>
transactions have been finished.
B<Note:>
It is undefined what the state of C<@_> is within the callback.
=head2 query
my File::FStore::File $file = $store->query(...);
# or:
( run in 1.562 second using v1.01-cache-2.11-cpan-483215c6ad5 )