File Coverage

blib/lib/Geoffrey/Converter/SQLite.pm

Criterion	Covered	Total	%
statement	126	126	100.0
branch	23	26	88.4
condition	16	24	66.6
subroutine	40	40	100.0
pod	17	17	100.0
total	222	233	95.2

package Geoffrey::Converter::SQLite;

use utf8;
use 5.016;
use strict;
use Readonly;
use warnings;

$Geoffrey::Converter::SQLite::VERSION = '0.000205';

use parent 'Geoffrey::Role::Converter';

Readonly::Scalar my $I_CONST_LENGTH_VALUE      => 2;
Readonly::Scalar my $I_CONST_NOT_NULL_VALUE    => 3;
Readonly::Scalar my $I_CONST_PRIMARY_KEY_VALUE => 4;
Readonly::Scalar my $I_CONST_DEFAULT_VALUE     => 5;

{

    package Geoffrey::Converter::SQLite::Constraints;

    use parent 'Geoffrey::Role::ConverterType';

    sub new {
        my $class = shift;
        return bless $class->SUPER::new(
            not_null    => q~NOT NULL~,
            unique      => q~UNIQUE~,
            primary_key => q~PRIMARY KEY~,
            foreign_key => q~FOREIGN KEY~,
            check       => q~CHECK~,
          ),
          $class;
    }
}
{

    package Geoffrey::Converter::SQLite::View;

    use parent 'Geoffrey::Role::ConverterType';

    sub add { return 'CREATE VIEW {0} AS {1}'; }

    sub drop { return 'DROP VIEW {0}'; }

    sub list {
        my ( $self, $schema ) = @_;
        require Geoffrey::Utils;
        return
            q~SELECT * FROM  ~
          . Geoffrey::Utils::add_schema($schema)
          . q~sqlite_master WHERE type='view'~;
    }
}
{

    package Geoffrey::Converter::SQLite::ForeignKey;
    use parent 'Geoffrey::Role::ConverterType';
    sub add { return 'FOREIGN KEY ({0}) REFERENCES {1}({2})' }
}
{
    package Geoffrey::Converter::SQLite::PrimaryKey;
    use parent 'Geoffrey::Role::ConverterType';
    sub add    { return 'CONSTRAINT {0} PRIMARY KEY ( {1} )'; }
}
{

    package Geoffrey::Converter::SQLite::UniqueIndex;
    use parent 'Geoffrey::Role::ConverterType';
    sub append { return 'CREATE UNIQUE INDEX IF NOT EXISTS {0} ON {1} ( {2} )'; }
    sub add    { return 'CONSTRAINT {0} UNIQUE ( {1} )'; }
    sub drop   { return 'DROP INDEX IF EXISTS {1}'; }
}
{

    package Geoffrey::Converter::SQLite::Trigger;
    use parent 'Geoffrey::Role::ConverterType';

    sub add {
        my ( $self, $options ) = @_;
        my $s_sql_standard = <<'EOF';
CREATE TRIGGER {0} UPDATE OF {1} ON {2}
BEGIN
    {4}
END
EOF
        my $s_sql_view = <<'EOF';
CREATE TRIGGER {0} INSTEAD OF UPDATE OF {1} ON {2}
BEGIN
    {4}
END
EOF
        return $options->{for_view} ? $s_sql_view : $s_sql_standard;
    }

    sub drop { return 'DROP TRIGGER IF EXISTS {1}'; }
}

sub new {
    my $class = shift;
    my $self  = $class->SUPER::new(@_);
    $self->{min_version} = '3.7';
    return bless $self, $class;
}

sub defaults {
    return {
        current_timestamp => 'CURRENT_TIMESTAMP',
        autoincrement     => 'AUTOINCREMENT',
    };
}

sub types {
    return {
        blob      => 'BLOB',
        integer   => 'INTEGER',
        numeric   => 'NUMERIC',
        real      => 'REAL',
        text      => 'TEXT',
        bool      => 'BOOL',
        double    => 'DOUBLE',
        float     => 'FLOAT',
        char      => 'CHAR',
        varchar   => 'VARCHAR',
        timestamp => 'DATETIME',
    };
}

sub select_get_table {
    return
      q~SELECT t.name AS table_name FROM sqlite_master t WHERE type='table' AND t.name = ?~;
}

sub convert_defaults {
    my ( $self, $params ) = @_;
    return $params->{default};
}
sub can_create_empty_table { return 0 }

sub colums_information {
    my ( $self, $ar_raw_data ) = @_;
    return [] if scalar @{$ar_raw_data} == 0;
    my $table_row = shift @{$ar_raw_data};
    $table_row->{sql} =~ s/^.*(CREATE|create) (.*)\(/$2/g;
    my $columns = [];
    for ( split m/,/, $table_row->{sql} ) {
        s/^TABLE\s+\S+\s+\((.*)/$1/g;
        s/^\s*(.*)\s*$/$1/g;
        my $rx_not_null      = 'NOT NULL';
        my $rx_primary_key   = 'PRIMARY KEY';
        my $rx_default       = 'AUTOINCREMENT|DEFAULT';
        my $rx_column_values = qr/($rx_not_null)*\s($rx_primary_key)*.*($rx_default \w{1,})*/;
        my @column           = m/^(\w+)\s([[:upper:]]+)(\(\d*\))*\s$rx_column_values$/;
        next if scalar @column == 0;
        $column[$I_CONST_LENGTH_VALUE] =~ s/([\(\)])//g if $column[$I_CONST_LENGTH_VALUE];
        push @{$columns},
          {
            name => $column[0],
            type => $column[1],
            (
                $column[$I_CONST_LENGTH_VALUE] ? ( length => $column[$I_CONST_LENGTH_VALUE] )
                : ()
            ),
            (
                $column[$I_CONST_NOT_NULL_VALUE]
                ? ( not_null => $column[$I_CONST_NOT_NULL_VALUE] )
                : ()
            ),
            (
                $column[$I_CONST_PRIMARY_KEY_VALUE]
                ? ( primary_key => $column[$I_CONST_PRIMARY_KEY_VALUE] )
                : ()
            ),
            (
                $column[$I_CONST_DEFAULT_VALUE]
                ? ( default => $column[$I_CONST_DEFAULT_VALUE] )
                : ()
            ),
          };
    }
    return $columns;
}

sub index_information {
    my ( $self, $ar_raw_data ) = @_;
    my @mapped = ();
    for ( @{$ar_raw_data} ) {
        next if !$_->{sql};
        my ($s_columns) = $_->{sql} =~ m/\((.*)\)$/;
        my @columns = split m/,/, $s_columns;
        s/^\s+|\s+$//g for @columns;
        push @mapped,
          {
            name    => $_->{name},
            table   => $_->{tbl_name},
            columns => \@columns
          };
    }
    return \@mapped;
}

sub view_information {
    my ( $self, $ar_raw_data ) = @_;
    return [] unless $ar_raw_data;
    return [ map { { name => $_->{name}, sql => $_->{sql} } } @{$ar_raw_data} ];
}

sub constraints {
    my ($self) = @_;
    $self->{constraints} //= Geoffrey::Converter::SQLite::Constraints->new;
    return $self->{constraints};
}

sub index {
    my ( $self, $new_value ) = @_;
    require Geoffrey::Converter::SQLite::Index;
    $self->{index} = $new_value if defined $new_value;
    $self->{index} //= Geoffrey::Converter::SQLite::Index->new;
    return $self->{index};
}

sub table {
    my ($self) = @_;
    require Geoffrey::Converter::SQLite::Tables;
    $self->{table} //= Geoffrey::Converter::SQLite::Tables->new;
    return $self->{table};
}

sub view {
    my ($self) = @_;
    $self->{view} //= Geoffrey::Converter::SQLite::View->new;
    return $self->{view};
}

sub foreign_key {
    my ( $self, $new_value ) = @_;
    $self->{foreign_key} = $new_value if defined $new_value;
    $self->{foreign_key} //= Geoffrey::Converter::SQLite::ForeignKey->new;
    return $self->{foreign_key};
}

sub trigger {
    my ( $self, $o_trigger ) = @_;
    $self->{trigger} = $o_trigger if defined $o_trigger;
    $self->{trigger} //= Geoffrey::Converter::SQLite::Trigger->new;
    return $self->{trigger};
}

sub primary_key {
    my ($self) = @_;
    $self->{primary_key} //= Geoffrey::Converter::SQLite::PrimaryKey->new;
    return $self->{primary_key};
}

sub unique {
    my ($self) = @_;
    $self->{unique} //= Geoffrey::Converter::SQLite::UniqueIndex->new;
    return $self->{unique};
}

1;    # End of Geoffrey::Converter::SQLite

__END__