view release on metacpan or  search on metacpan

lib/DBIx/Simplish.pm  view on Meta::CPAN

has keep_statements => (
    is      => 'ro',
    isa     => Int,
    default => 16,
);

has lc_columns => (
    is      => 'rw',
    isa     => Bool,
    default => 1,
);

has abstract => (
    is      => 'lazy',
    isa     => InstanceOf['SQL::Abstract'],
    handles => [qw/select insert update delete/],
);

has connection_mode => (
    is => 'ro',
    isa => $connection_mode,
    default => sub {'fixup'},
);

has _cache => (
    is       => 'lazy',
    init_arg => undef,
);

has _is_sqlite => (
    is       => 'lazy',
    init_arg => undef,
);

has _is_mysql => (
    is       => 'lazy',
    init_arg => undef,
);

has sql_quote_char => (
    is        => 'ro',
    predicate => 1,
);

has sql_name_sep => (
    is        => 'ro',
    predicate => 1,
);

sub _build_connector {
    my $self = shift;
    my $options = $self->options;
    $options->{PrintError} = 0 unless exists $options->{PrintError};
    $options->{RaiseError} = 1 unless exists $options->{RaiseError};
    if ($self->_is_mysql) {
        $options->{mysql_enable_utf8}    = 1 unless exists $options->{mysql_enable_utf8};
        $options->{mysql_enable_utf8mb4} = 1 unless exists $options->{mysql_enable_utf8mb4};
    } elsif ($self->_is_sqlite) {
        $options->{sqlite_use_immediate_transaction} = 1 unless exists $options->{sqlite_use_immediate_transaction};
        $options->{sqlite_unicode}                   = 1 unless exists $options->{sqlite_unicode};
    }
    my $connector = DBIx::Connector->new(
        $self->dsn,
        $self->user,
        $self->password,
        $options,
    );
    $connector->mode($self->connection_mode);
    return $connector;
}

sub _build_abstract {
    my $self = shift;
    my %args = (limit_dialect => $self->dbh);
    $args{quote_char} = $self->sql_quote_char if $self->has_sql_quote_char;
    $args{name_sep}   = $self->sql_name_sep   if $self->has_sql_name_sep;
    if ($self->_is_mysql) {
        $args{quote_char} = '`' unless $self->has_sql_quote_char;
        $args{name_sep}   = '.' unless $self->has_sql_name_sep;
    } elsif ($self->_is_sqlite) {
        $args{quote_char} = '"' unless $self->has_sql_quote_char;
        $args{name_sep}   = '.' unless $self->has_sql_name_sep;
    }
    return SQL::Abstract::Limit->new(%args);
}

sub _build__cache {
    my $self = shift;
    my $cache;
    tie %{$cache}, 'Tie::Cache::LRU', $self->keep_statements; ## no critic (ProhibitTies)
    return $cache
}

sub _build__is_mysql {
    my $self = shift;
    if ($self->has_connector) {
        return $self->dbh->{Driver}{Name} eq 'mysql';
    } else {
        return $self->dsn =~ /^(?i:dbi):mysql:/;
    }
}

sub _build__is_sqlite {
    my $self = shift;
    if ($self->has_connector) {
        return $self->dbh->{Driver}{Name} eq 'SQLite';
    } else {
        return $self->dsn =~ /^(?i:dbi):SQLite:/;
    }
}

sub DEMOLISH {
    my $self = shift;
    $_->finish for values %{$self->_cache};
}

sub connect { ## no critic (ProhibitBuiltinHomonyms)
    my ($self, $dsn, $user, $password, $options) = @_;
    my %opts = (dsn => $dsn);
    $opts{user}     = $user     if defined $user;