File Coverage

blib/lib/WWW/Suffit/Model.pm

Criterion	Covered	Total	%
statement	47	57	82.4
branch	10	42	23.8
condition	9	26	34.6
subroutine	11	16	68.7
pod	9	9	100.0
total	86	150	57.3

package WWW::Suffit::Model;
use strict;
use warnings;
use utf8;

=encoding utf8

=head1 NAME

WWW::Suffit::Model - This library provides methods for access to WWW::Suffit models

=head1 SYNOPSIS

    use WWW::Suffit::Model;

    my $model = WWW::Suffit::Model->new(
        ds => "sqlite:///tmp/test.db?sqlite_unicode=1"
    );

    $model = $model->connect_cached->init;

=head1 DESCRIPTION

A lightweight and extensible model layer that streamlines database interaction within the WWW::Suffit framework, providing a clean foundation for building consistent, reusable data models

=head1 METHODS

This class inherits all methods from L and implements the following new ones

=head2 init

    $model = $model->connect->init($package, $schema, $prefix);
    $model = $model->connect->init(__PACKAGE__, 'public', 'schema');
    $model = $model->connect_cached->init;

This method initializes the database schema prior to using the connection.

=over 4

=item B<$package>

Specifies the package that holds the C<__DATA__> section containing the C blocks

Default: your package name of the class inheriting from this one, C<__PACKAGE__>

=item B<$schema>

Specifies schema name. Default: C<'public'>

=item B<$prefix>

Specifies preffix of the DDL section name. Default: C<'schema'>

For eg., if you specify "test" as the prefix, you will need to declare
your C blocks in your class as follows:

    __DATA__

    @@ test_sqlite

    ... your DDL for sqlite here ...

    @@ test_mysql

    ... your DDL for mysql here ...

    @@ test_postgresql

    ... your DDL for postgresql here ...

=back

=head2 is_mariadb

    print $model->is_mariadb ? "Is MariaDB" : "Is NOT MariaDB";

Returns true if type of current database is MariaDB

=head2 is_mysql

    print $model->is_mysql ? "Is MySQL" : "Is NOT MySQL";

Returns true if type of current database is MySQL

=head2 is_oracle

    print $model->is_oracle ? "Is Oracle" : "Is NOT Oracle";

Returns true if type of current database is Oracle

=head2 is_postgresql

    print $model->is_postgresql ? "Is PostgreSQL" : "Is NOT PostgreSQL";

Returns true if type of current database is PostgreSQL

=head2 is_sqlite

    print $model->is_sqlite ? "Is SQLite" : "Is NOT SQLite";

Returns true if type of current database is SQLite

=head2 is_initialized

    print $model->is_initialized ? "Initialized" : "Is NOT initialized";

This method returns the initialization status of the model.
It returns true if the model is initialized, and false otherwise.

=head2 initiator

    print $model->initiator; # MyModel

This method returns the name of the class that called the init method

=head2 schema

    print $model->schema; # public

This method returns the schema name

=head1 EXAMPLE

Add the following block describing the schemas to the end of your class in the "C<__DATA__>" section:

    @@ schema_sqlite

    -- # main
    CREATE TABLE IF NOT EXISTS "test" (
      "id"          INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT UNIQUE,
      "comment"     TEXT DEFAULT NULL -- Comment
    );

    @@ schema_mysql

    -- # main
    CREATE DATABASE IF NOT EXISTS `test-db` CHARACTER SET utf8mb4 COLLATE utf8mb4_bin;
    USE `test-db`;
    CREATE TABLE IF NOT EXISTS `test` (
      `id`          INT NOT NULL AUTO_INCREMENT,
      `comment`     LONGTEXT DEFAULT NULL, -- Comment
      PRIMARY KEY (`id`)
    ) ENGINE=InnoDB DEFAULT CHARSET=utf8mb4 COLLATE=utf8mb4_bin;

    @@ schema_postgresql

    -- # main
    CREATE TABLE IF NOT EXISTS "test" (
      "id"          INTEGER GENERATED BY DEFAULT AS IDENTITY PRIMARY KEY,
      "comment"     TEXT DEFAULT NULL -- Comment
    );

See also F for an example of how to use this class correctly

=head1 HISTORY

See C file

=head1 TO DO

See C file

=head1 SEE ALSO

L, L, F

=head1 AUTHOR

Serż Minus (Sergey Lepenkov) L [e-mail]

=head1 COPYRIGHT

Copyright (C) 1998-2026 D&D Corporation

=head1 LICENSE

This program is distributed under the terms of the Artistic License Version 2.0

See the C file or L for details

=cut

our $VERSION = '1.02';

use parent 'Acrux::DBI';

use Acrux::Util qw/touch/;
use Acrux::RefUtil qw/isnt_void/;

use constant {
    SCHEMA_NAME             => 'public',
    SCHEMA_SECTION_PREFIX   => 'schema',
    SCHEMA_SECTION_FORMAT   => '%s_%s',
    DRIVERS => {
        sqlite      => 'sqlite',
        file        => 'sqlite',
        mysql       => 'mysql',
        mariadb     => 'mariadb',
        maria       => 'mariadb',
        pg          => 'postgresql',
        pgsql       => 'postgresql',
        postgres    => 'postgresql',
        postgresql  => 'postgresql',
        oracle      => 'oracle',
        ora         => 'oracle',
        sponge      => 'sponge', # For tests only
    },
    DEFAULT_MODEL_URI   => 'sponge://',
    DEFAULT_MODEL_DSN   => 'DBI:Sponge:',
    DEFAULT_MODEL_ATTR  => {
            RaiseError => 0,
            PrintError => 0,
            PrintWarn  => 0,
        },
};

sub is_sqlite { DRIVERS->{(shift->driver)} eq 'sqlite' ? 1 : 0 }
sub is_mysql { DRIVERS->{(shift->driver)} eq 'mysql' ? 1 : 0 }
sub is_mariadb { DRIVERS->{(shift->driver)} eq 'mariadb' ? 1 : 0 }
sub is_postgresql { DRIVERS->{(shift->driver)} eq 'postgresql' ? 1 : 0 }
sub is_oracle { DRIVERS->{(shift->driver)} eq 'oracle' ? 1 : 0 }

# Initialize schema
sub init {
    my $self = shift; # shift->connect_cached;
    my $package = shift // ref($self); # __PACKAGE__
    my $schema = shift // SCHEMA_NAME;
    my $prefix = shift // SCHEMA_SECTION_PREFIX;
    my $dbh = $self->dbh or return $self; # Skip if no connect established
    my $is_inited = $self->{'_is_initialized'} || 0; # Not initialized
    return $self if $is_inited; # Already initialized

    # Check SQLite
    if ($self->is_sqlite) {
        my $file = $dbh->sqlite_db_filename();
        unless ($file && (-e $file) && !(-z $file)) {
            touch($file);
        }

        # Get table info
        if (my $sth = $dbh->table_info(undef, undef, undef, 'TABLE')) {
            $is_inited = isnt_void($sth->fetchall_arrayref) ? 1 : 0;
        }
    }

    # Check MariaDB
    elsif ($self->is_mariadb || $self->is_mysql) {
        # Get table info
        if (my $sth = $dbh->table_info('', $schema, '', 'TABLE')) {
            $is_inited = isnt_void($sth->fetchall_arrayref) ? 1 : 0;
        }
    }

    # Check PostgreSQL
    elsif ($self->is_postgresql) {
        # Get table info
        if (my $sth = $dbh->table_info('', $schema, undef, 'TABLE')) { # schema = 'public'
            $is_inited = isnt_void($sth->fetchall_arrayref) ? 1 : 0;
        }
    }

    # Skip initialize otherwise
    else {
        return $self;
    }

    # Get dump instance
    my $name = sprintf(SCHEMA_SECTION_FORMAT, $prefix, DRIVERS->{($self->driver)} || 'unknown');
    my $dump = $self->dump(name => $name)->from_data($package);

    # Import initial schema if is not inited
    unless ($is_inited) {
        $dump->poke(); # main section (default)
        return $self if $self->error;
    }

    # Check connect
    return $self->error(sprintf("Can't init database \"%s\". Ping failed: %s",
        $self->dsn, $self->errstr() || "unknown error")) unless $self->ping;

    # Ok
    $self->{'_is_initialized'} = 1;
    $self->{'_initiator'} = $package;
    $self->{'_schema'} = $schema;
    return $self;
}

sub is_initialized { shift->{'_is_initialized'} || 0 }
sub initiator { shift->{'_initiator'} // '' }
sub schema { shift->{'_schema'} // '' }

1;

__END__