view release on metacpan or  search on metacpan

lib/Geoffrey/Converter/SQLite.pm  view on Meta::CPAN

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) = @_;