view release on metacpan or  search on metacpan

lib/Data/TagDB.pm  view on Meta::CPAN

# Copyright (c) 2024-2025 Philipp Schafft

# licensed under Artistic License 2.0 (see LICENSE file)

# ABSTRACT: Work with Tag databases

package Data::TagDB;

use v5.10;
use strict;
use warnings;

use Scalar::Util qw(weaken blessed);

use Carp;
use DBI;

use Data::TagDB::Tag;
use Data::TagDB::Relation;
use Data::TagDB::Metadata;
use Data::TagDB::LinkIterator;
use Data::TagDB::MultiIterator;
use Data::TagDB::WellKnown;
use Data::TagDB::Cloudlet;
use Data::URIID::Colour;

our $VERSION = v0.12;

my %_queries = (
    _default => {
        tag_by_hint         => 'SELECT tag FROM hint WHERE name = ?',
        _tag_simple_identifier => 'SELECT data FROM metadata WHERE relation = (SELECT tag FROM hint WHERE name = \'also-shares-identifier\') AND type = (SELECT tag FROM hint WHERE name = ?) AND context = 0 AND encoding = 0 AND tag = ? ORDER BY data D...
        _tag_by_dbid_type_and_data => 'SELECT tag FROM metadata WHERE relation = (SELECT tag FROM hint WHERE name = \'also-shares-identifier\') AND type = ? AND context = 0 AND encoding = 0 AND data = ?',
        _create_tag         => 'INSERT INTO tag DEFAULT VALUES',
        _create_metadata    => 'INSERT OR IGNORE INTO metadata (tag,relation,context,type,encoding,data) VALUES (?,?,?,?,?,?)',
        _create_relation    => 'INSERT OR IGNORE INTO relation (tag,relation,related,context,filter) VALUES (?,?,?,?,?)',
    },
    Pg => {
        _create_tag         => 'INSERT INTO tag DEFAULT VALUES RETURNING id',
        _create_metadata    => 'INSERT INTO metadata (tag,relation,context,type,encoding,data) VALUES (?,?,?,?,?,?) ON CONFLICT DO NOTHING',
        _create_relation    => 'INSERT INTO relation (tag,relation,related,context,filter) VALUES (?,?,?,?,?) ON CONFLICT DO NOTHING',
    },
);



sub new {
    my ($pkg, $first, @rest) = @_;
    my $DBI_name;
    my $dbh;
    my %query;

    croak 'No dsn or dbh given to new' unless defined $first;

    if (scalar(@rest) == 0 && eval { $first->can('prepare'); }) {
        $dbh = $first;
    } else {
        $dbh = DBI->connect($first, @rest) or croak 'Cannot connect to database';
    }

    $DBI_name = $dbh->{Driver}{Name};
    foreach my $name (keys %{$_queries{_default}}) {
        $query{$name} = $dbh->prepare($_queries{$DBI_name}{$name} // $_queries{_default}{$name});
    }

    return bless {
        dbh => $dbh,
        _DBI_name => $DBI_name,
        cache_tag => {},
        cache_ise => {},
        cache_default_type => {},
        cache_default_encoding => {},
        backup_type => {},

lib/Data/TagDB.pm  view on Meta::CPAN

    unless (defined($self->{transaction_type})) {
        $self->{transaction_type} = $type;
        $self->{transaction_open} = 0;
        $self->dbh->begin_work;
    }

    if ($self->{transaction_type} eq $type || $self->{transaction_type} eq 'rw') {
        # no-op
    } elsif ($self->{transaction_type} eq 'ro' && $type eq 'rw') {
        $self->{transaction_type} = $type;
    } else {
        $error = 'Transaction type missmatch';
    }

    unless (defined $error) {
        $self->{transaction_open}++;
        eval { $code->() };
        $self->{transaction_open}--;
    }

    unless ($self->{transaction_open}) {
        delete $self->{transaction_type};
        $self->dbh->commit;
    }

    croak $error if defined $error;
}

# ---- Virtual methods ----

# ---- Private helpers ----

sub DESTROY {
    my ($self) = @_;
    eval { $self->disconnect };
}

sub assert_connected {
    my ($self) = @_;
    my $dbh = $self->{dbh};
    confess 'Not connected to any database' unless defined $dbh;
    return $dbh;
}

sub tag_by_dbid {
    my ($self, $dbid) = @_;
    my $cache = $self->{cache_tag};
    if (defined $cache->{$dbid}) {
        return $cache->{$dbid};
    } else {
        state $done = 0;
        my $tag = Data::TagDB::Tag->_new(db => $self, dbid => $dbid);

        if ($done++ > 1024) {
            $self->_cache_maintain;
            $done = 0;
        }

        $cache->{$dbid} = $tag;
        weaken($cache->{$dbid});

        return $tag;
    }
}

sub _tag_by_ise_cached {
    my ($self, $ise, $autocreate) = @_;
    if (defined $self->{cache_ise}{$ise}) {
        return $self->tag_by_dbid($self->{cache_ise}{$ise});
    } else {
        my $tag = $self->tag_by_id(uuid => $ise, $autocreate); # TODO: Allow all ISE here.
        $self->{cache_ise}{$ise} = $tag->dbid;
        return $tag;
    }
}

sub _cache_maintain {
    my ($self) = @_;
    my $cache = $self->{cache_tag};

    foreach my $key (keys %{$cache}) {
        delete $cache->{$key} unless defined $cache->{$key};
    }
}

sub _cache_clear {
    my ($self) = @_;
    $self->_cache_maintain;
    %{$self->{cache_ise}} = ();
}

sub _as_tag {
    my ($self, $id, $autocreate) = @_;
    return undef unless defined $id;
    return $id if eval {$id->isa('Data::TagDB::Tag')};
    return $self->tag_by_id(Data::Identifier->new(from => $id, db => $self), $autocreate);
}

sub _default_type {
    my ($self, $relation) = @_;
    my $relation_dbid = $relation->dbid;
    if (defined $self->{cache_default_type}{$relation_dbid}) {
        return $self->tag_by_dbid($self->{cache_default_type}{$relation_dbid});
    } else {
        my $type = eval {$self->relation(tag => $relation, relation => $self->wk->default_type)->one->related};
        if (defined $type) {
            $self->{cache_default_type}{$relation_dbid} = $type->dbid;
        } elsif (defined $self->{backup_type}{$relation_dbid}) {
            return $self->tag_by_dbid($self->{cache_default_type}{$relation_dbid} = $self->{backup_type}{$relation_dbid});
        } else {
            die 'No default type known';
        }
        return $type;
    }
}

sub _default_encoding {
    my ($self, $type) = @_;
    my $type_dbid = $type->dbid;
    if (defined $self->{cache_default_encoding}{$type_dbid}) {