view release on metacpan or  search on metacpan

lib/File/FStore/File.pm  view on Meta::CPAN

    'text/plain'                => 'txt',
);

my %_db_tags = (
    # well known tags:
    final_file_size     => Data::Identifier->new(uuid => '1cd4a6c6-0d7c-48d1-81e7-4e8d41fdb45d'),
    final_file_encoding => Data::Identifier->new(uuid => '448c50a8-c847-4bc7-856e-0db5fea8f23b'),
    final_file_hash     => Data::Identifier->new(uuid => '79385945-0963-44aa-880a-bca4a42e9002'),
    also_has_role       => Data::Identifier->new(uuid => 'd2750351-aed7-4ade-aa80-c32436cc6030'),
    also_has_state      => Data::Identifier->new(uuid => '4c426c3c-900e-4350-8443-e2149869fbc9'),
    has_final_state     => Data::Identifier->new(uuid => '54d30193-2000-4d8a-8c28-3fa5af4cad6b'),
    specific_proto_file_state => Data::Identifier->new(uuid => '63da70a8-78a4-51b0-8b87-86872b474a5d'),
);


sub dbname {
    my ($self) = @_;
    return $self->{dbname} //= do {
        my $sth = $self->_prepare('SELECT filename FROM file WHERE id = ?');
        my $res;

        $sth->execute($self->{dbid});
        $res = $sth->fetchall_arrayref;

        $res->[0][0] // croak 'Database error';
    };
}


sub filename {
    my ($self) = @_;
    return $self->{filename} //= do {
        $self->store->_file(qw(v2 store), $self->dbname);
    };
}


sub open {
    my ($self) = @_;
    my $fh = $self->_open;

    $self->stat;
    $self->_detach_fh;

    return $fh;
}


sub link_out {
    my ($self, $filename) = @_;
    link($self->filename, $filename) or croak $!;
}


sub symlink_out {
    my ($self, $filename) = @_;
    symlink($self->filename, $filename) or croak $!;
}


sub update {
    my ($self, %opts) = @_;
    my File::FStore $store = $self->store;
    my $no_digests  = delete($opts{no_digests});
    my $on_pre_set  = delete($opts{on_pre_set});
    my $on_post_set = delete($opts{on_post_set});
    my $inode;
    my $properties;
    my $digests;

    croak 'Stray options passed' if scalar keys %opts;

    $store->_init_link_style;

    $store->in_transaction(rw => sub {
            my $fh = $self->_open;

            delete $self->{stat}; #clear stat cache.

            $inode = $self->as('File::Information::Inode');

            # Perform a verify via File::Information
            unless ($no_digests) {
                my $verify_result = $inode->verify;
                unless ($verify_result->has_passed || $verify_result->has_no_data || $verify_result->has_insufficient_data) {
                    croak sprintf('File (%s) is in bad state: %s', $self->dbname, $verify_result->status);
                }
            }

            # Perform a verify with our own data.
            {
                my $data = $self->get;
                my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
                    $atime,$mtime,$ctime,$blksize,$blocks) = $self->stat;

                $properties = $data->{properties} //= {};
                $digests = $data->{digests} //= {};

                $properties->{size} //= $size;
                croak 'Size missmatch' if $properties->{size} != $size;
                $properties->{inode} //= $ino;
                croak 'inode missmatch' if $properties->{inode} != $ino;

                # Load some basic properties, first the final values, than the current ones.
                foreach my $lifecycle (qw(final current)) {
                    if (defined(my $v = $inode->get('size', lifecycle => $lifecycle, default => undef))) {
                        $properties->{size} //= $v;
                        croak 'Size missmatch' if $properties->{size} != $v;
                    }

                    if (defined(my $v = $inode->get('mediatype', lifecycle => $lifecycle, default => undef, as => 'mediatype'))) {
                        $properties->{mediasubtype} //= $v;
                        croak sprintf('Media subtype missmatch on (%s): "%s" vs. "%s"', $self->dbname, $properties->{mediasubtype}, $v) if $properties->{mediasubtype} ne $v;
                    }

                    if (defined(my $v = $inode->get('inodeise', lifecycle => $lifecycle, default => undef, as => 'mediatype'))) {
                        $properties->{inodeise} //= $v;
                        # XXX:  We ignore missmatches here. This can be for a number of reasons. Such as switches between different sources of the value.
                        # TODO: A better policy should be implemented later on.
                    }