view release on metacpan or  search on metacpan

lib/Data/TagDB/Migration.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::Migration;

use v5.10;
use strict;
use warnings;

use Scalar::Util qw(weaken);
use Carp;

use Data::TagDB;

use parent 'Data::TagDB::WeakBaseObject';

use constant RE_UUID => qr/^[0-9a-f]{8}-(?:[0-9a-f]{4}-){3}[0-9a-f]{12}$/;

use constant {
    FORMAT_TAGPOOL_SOURCE_FORMAT => 'e5da6a39-46d5-48a9-b174-5c26008e208e',
    FORMAT_TAGPOOL_TAGLIST_V1    => 'afdb46f2-e13f-4419-80d7-c4b956ed85fa',

    FEATURE_MODERN_LIMITED       => 'f06c2226-b33e-48f2-9085-cd906a3dcee0',
    FEATURE_HYBRID               => '5a1895b8-61f1-4ce1-a44f-1a239b7d9de7',
};

our $VERSION = v0.12;

my %table_defs = (
    SQLite => {
        tag      => 'CREATE TABLE IF NOT EXISTS tag (id INTEGER NOT NULL UNIQUE PRIMARY KEY AUTOINCREMENT);',
        metadata => 'CREATE TABLE IF NOT EXISTS metadata (tag INTEGER NOT NULL REFERENCES tag(id), relation INTEGER NOT NULL REFERENCES tag(id), context INTEGER NOT NULL REFERENCES tag(id) DEFAULT 0, type INTEGER NOT NULL REFERENCES tag(id) DEFAULT 0...
        relation => 'CREATE TABLE IF NOT EXISTS relation (tag INTEGER NOT NULL REFERENCES tag(id), relation INTEGER NOT NULL REFERENCES tag(id), context INTEGER NOT NULL REFERENCES tag(id) DEFAULT 0, related INTEGER NOT NULL REFERENCES tag(id), filte...
    },
    Pg => {
        tag      => 'CREATE TABLE IF NOT EXISTS tag (id SERIAL UNIQUE PRIMARY KEY);',
        metadata => 'CREATE TABLE IF NOT EXISTS metadata (tag INTEGER NOT NULL REFERENCES tag(id), relation INTEGER NOT NULL REFERENCES tag(id), context INTEGER NOT NULL REFERENCES tag(id) DEFAULT 0, type INTEGER NOT NULL REFERENCES tag(id) DEFAULT 0...
    },
    _default => {
        hint     => 'CREATE TABLE IF NOT EXISTS hint (name VARCHAR(32) NOT NULL UNIQUE PRIMARY KEY, tag INTEGER NOT NULL REFERENCES tag(id));',
        relation => 'CREATE TABLE IF NOT EXISTS relation (tag INTEGER NOT NULL REFERENCES tag(id), relation INTEGER NOT NULL REFERENCES tag(id), context INTEGER NOT NULL REFERENCES tag(id) DEFAULT 0, related INTEGER NOT NULL REFERENCES tag(id), filte...
    },
);

my %extra_sql = (
    SQLite => {
        insert_hint     => 'INSERT OR IGNORE INTO hint (name,tag) VALUES (?,?)',
        insert_tag      => 'INSERT INTO tag DEFAULT VALUES',
        insert_metadata => 'INSERT OR IGNORE INTO metadata (tag,relation,context,type,encoding,data) VALUES (?,?,0,?,0,?)',
    },
    Pg => {
        insert_hint     => 'INSERT INTO hint (name,tag) VALUES (?,?) ON CONFLICT DO NOTHING',
        insert_tag      => 'INSERT INTO tag DEFAULT VALUES RETURNING id',
        insert_metadata => 'INSERT INTO metadata (tag,relation,context,type,encoding,data) VALUES (?,?,0,?,0,?) ON CONFLICT DO NOTHING',
    },
);

my %indices = (
    _all => [
        [tag      => qw(id)],
        [hint     => qw(name)],
        [metadata => qw(tag)],
        [metadata => qw(tag relation)],
        [metadata => qw(data)],
        [relation => qw(tag)],
        [relation => qw(tag relation)],
        [relation => qw(related)],
    ],
    SQLite => [
        [metadata => 'data COLLATE NOCASE']

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

    qw(also_shares_identifier tagname uuid uri oid wikidata_identifier small_identifier),  # recommend
    qw(important no_direct has_type owned_by implies flagged_as using_namespace for_type), # friendly
);

my %simple_relations = (
    'tag-type'          => '7f265548-81dc-4280-9550-1bd0aa4bf748',
    'tag-owner'         => '0ad7f760-8ee7-4367-97f2-ada06864325e',
    'tag-implies'       => 'e48cd5c6-83d7-411e-9640-cb370f3502fc',
    'tag-suggests'      => '56388bfe-39cd-4ea6-8224-f36a2a0b92ef', # filterless form only!
    'tag-replaced-by'   => 'd6e028d4-279e-453e-a7a3-16646bf091f7',
    'tag-generated-by'  => '8efbc13b-47e5-4d92-a960-bd9a2efa9ccb',
    'tag-links'         => 'd926eb95-6984-415f-8892-233c13491931',
);

my %simple_metadata = (
    'tag-description'       => 'ca33b058-b4ce-4059-9f0b-61ca0fd39c35',
    'tag-generator-request' => 'ab573786-73bc-4f5c-9b03-24ef8a70ae45',
    'tag-description-uri'   => '0a5e125d-d863-4013-b961-648205c2c460',
);

my %simple_flags = (
    'tag-mark-important'    => 'e6135f02-28c1-4973-986c-ab7a6421c0a0',
    'tag-remove'            => '34d5124b-7f47-4ddd-ab02-560396acee56',
    'tag-mark-no-direct'    => '05648b38-e73c-485c-b536-286ce0918193',
);



sub upgrade {
    my ($self) = @_;
    $self->_create_tables;
    $self->_create_indices;
    $self->_create_hints_indispensable;
    $self->_create_hints;
}


sub create {
    my ($pkg, $first, @rest) = @_;
    my Data::TagDB $db;
    my __PACKAGE__ $self;
    my DBI $dbh;

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

    $dbh->begin_work;

    $self = $pkg->_new(dbh => $dbh);

    $self->_create_tables;
    $self->_create_tag_null;
    $self->_create_hints_indispensable;

    $db = Data::TagDB->new($dbh);

    $self->{db} = $db;
    weaken($self->{db});

    $self->upgrade;

    $dbh->commit;

    return $db;
}


sub db {
    my ($self) = @_;
    return $self->{db};
}


sub dbh {
    my ($self) = @_;
    return $self->{dbh};
}


sub include {
    my ($self, @sources) = @_;
    my $cache = $self->db->create_cache;
    my Data::TagDB $db = $self->db;
    my Data::TagDB::WellKnown $wk = $db->wk;

    $cache->add(
        $wk->also_shares_identifier(1),
        $wk->uuid(1),
        $wk->tagname(1),
    );

    foreach my $entry (@sources) {
        my $source;

        $entry = {source => $entry} unless ref $entry;
        $source = $entry->{source};

        if ($source eq 'Data::TagDB::WellKnown') {
            my Data::TagDB::Tag $asi = $wk->also_shares_identifier(1);
            my Data::TagDB::Tag $tagname = $wk->tagname(1);
            my Data::TagDB::Tag $sid = $wk->small_identifier(1);
            my Data::TagDB::Tag $default_type = $wk->default_type(1);
            my Data::TagDB::Tag $default_encoding = $wk->default_encoding(1);
            my Data::TagDB::Tag $sirtx_logical = $wk->sirtx_logical(1);
            foreach my $name ($wk->_list) {
                my Data::TagDB::Tag $tag = $wk->_call($name, 1);
                my $info = $wk->_info($name);
                $db->create_metadata(tag => $tag, relation => $asi, type => $tagname,       data_raw => $info->{tagname}) if defined $info->{tagname};
                $db->create_metadata(tag => $tag, relation => $asi, type => $sid,           data_raw => $info->{sid})     if defined $info->{sid};
                $db->create_metadata(tag => $tag, relation => $asi, type => $sirtx_logical, data_raw => $info->{logical}) if defined $info->{logical};
                $db->create_relation(tag => $tag, relation => $default_type,     related => $wk->_call($info->{default_type},     1)) if defined $info->{default_type};
                $db->create_relation(tag => $tag, relation => $default_encoding, related => $wk->_call($info->{default_encoding}, 1)) if defined $info->{default_encoding};
            }
        } elsif ($source eq 'Data::URIID') {
            require Data::URIID;
            my Data::TagDB::Tag $uuid = $wk->uuid(1);
            my $extractor = Data::URIID->new;