view release on metacpan or  search on metacpan

lib/File/Information/Tagpool.pm  view on Meta::CPAN

# Copyright (c) 2024-2025 Philipp Schafft <lion@cpan.org>

# licensed under Artistic License 2.0 (see LICENSE file)

# ABSTRACT: generic module for extracting information from filesystems


package File::Information::Tagpool;

use v5.10;
use strict;
use warnings;

use parent 'File::Information::Base';

use Carp;
use File::Spec;
use Sys::Hostname ();
use Scalar::Util qw(weaken);

use File::Information::Lock;

our $VERSION = v0.16;

my $HAVE_FILE_VALUEFILE = eval {require File::ValueFile::Simple::Reader; require File::ValueFile::Simple::Writer; 1;};

my %_properties = (
    tagpool_pool_path => {loader => \&_load_tagpool, rawtype => 'filename'},
);

if ($HAVE_FILE_VALUEFILE) {
    $_properties{tagpool_pool_uuid} = {loader => \&_load_tagpool, rawtype => 'uuid'};
}

sub _new {
    my ($pkg, %opts) = @_;
    my $self = $pkg->SUPER::_new(%opts, properties => \%_properties);

    croak 'No path is given' unless defined $self->{path};

    return $self;
}


#@returns File::Information::Lock
sub lock {
    my ($self) = @_;
    my $locks = $self->{locks} //= {};

    unless (scalar keys %{$locks}) {
        my $lockfile = $self->_catfile('lock');
        my $lockname = $self->_tempfile('lock');
        open(my $out, '>', $lockname) or die $!;
        print $out ".\n";
        close($out);

        for (my $i = 0; $i < 3; $i++) {
            if (link($lockname, $lockfile)) {
                # Success.
                $self->{lockfile} = $lockfile;
                $self->{lockname} = $lockname;
                {
                    my $lock = File::Information::Lock->new(parent => $self, on_unlock => \&_unlock);
                    $locks->{$lock} = $lock;
                    weaken($locks->{$lock}); # it holds a reference to us, so our's will be weak.
                    return $lock;
                }
            }
            sleep(1);
        }

        unlink($lockname);
        croak 'Can not lock pool';
    }

    {
        my $lock = File::Information::Lock->new(parent => $self, on_unlock => \&_unlock);
        $locks->{$lock} = $lock;
        weaken($locks->{$lock}); # it holds a reference to us, so our's will be weak.
        return $lock;
    }
}


sub locked {
    my ($self, $func) = @_;
    my $lock = $self->lock;
    return $func->();
}


sub load_sysfile_cache {
    my ($self) = @_;
    my $locks = $self->{locks} //= {};

    unless (scalar keys %{$locks}) {
        croak 'The pool must be locked to read the sysfile cache';
    }

    unless (defined $self->{sysfile_cache}) {
        my $local_cache = $self->instance->_tagpool_sysfile_cache->{$self->{path}} //= {};
        my $data_path = $self->_catdir('data');
        my %cache;

        opendir(my $dir, $data_path) or croak $!;

        while (my $entry = readdir($dir)) {
            my @c_stat;

            $entry =~ /^file\./ or next; # skip everything that is not a file.* to begin with.

            @c_stat = stat($self->_catfile('data', $entry));
            next unless scalar @c_stat;

            $cache{$c_stat[1].'@'.$c_stat[0]} = $entry;
        }

        %{$local_cache} = (%cache, complete => 1);

        return $self->{sysfile_cache} = \%cache;
    }

    return $self->{sysfile_cache};
}


sub file_add {
    my ($self, $files, %opts) = @_;
    my $instance = $self->instance;
    my $local_cache = $instance->_tagpool_sysfile_cache->{$self->{path}} //= {};
    my $lock;
    my $sysfile_cache;
    my %to_add;

    # First setup %to_add:
    $files = [$files] unless ref($files) eq 'ARRAY';
    foreach my $file (@{$files}) {
        my $link;
        my $inode;