view release on metacpan or  search on metacpan

lib/App/DBBrowser/DB.pm  view on Meta::CPAN

package # hide from PAUSE
App::DBBrowser::DB;

use warnings;
use strict;
use 5.016;

our $VERSION = '2.440';

use Encode       qw( decode );
#use bytes;      # required
use Scalar::Util qw( looks_like_number );

use DBI::Const::GetInfoType;


sub new {
    my ( $class, $info, $opt ) = @_;
    my $db_module = "App::DBBrowser::DB::$info->{plugin}";
    eval "require $db_module" or die $@;
    my $plugin = $db_module->new( $info, $opt );
    bless { Plugin => $plugin }, $class;
}


sub get_db_driver {
    my ( $sf ) = @_;
    return $sf->{Plugin}->get_db_driver();
}


sub read_login_data {
    my ( $sf ) = @_;
    return [] if ! $sf->{Plugin}->can( 'read_login_data' );
    my $read_args = $sf->{Plugin}->read_login_data();
    return $read_args // [];
}


sub env_variables {
    my ( $sf ) = @_;
    return [] if ! $sf->{Plugin}->can( 'env_variables' );
    my $env_variables = $sf->{Plugin}->env_variables();
    return $env_variables // [];
}


sub read_attributes {
    my ( $sf ) = @_;
    return [] if ! $sf->{Plugin}->can( 'read_attributes' );
    my $read_attributes = $sf->{Plugin}->read_attributes();
    return $read_attributes // [];
}


sub set_attributes {
    my ( $sf ) = @_;
    return [] if ! $sf->{Plugin}->can( 'set_attributes' );
    my $set_attributes = $sf->{Plugin}->set_attributes();
    return $set_attributes // [];
}


sub get_db_handle {
    my ( $sf, $db ) = @_;
    my $dbh = $sf->{Plugin}->get_db_handle( $db );
    if ( $dbh->{Driver}{Name} eq 'SQLite' ) {
        $dbh->sqlite_create_function( 'regexp', 3, sub {
                my ( $regex, $string, $case_sensitive ) = @_;
                $string = '' if ! defined $string;
                return $string =~ m/$regex/sm if $case_sensitive;
                return $string =~ m/$regex/ism;
            }
        );
        $dbh->sqlite_create_function( 'trunc', -1, sub {
                my ( $number, $places ) = @_;
                return $number if ! looks_like_number( $number );
                $places //= 0;
                return int( $number * 10 ** $places ) / 10 ** $places;
            }
        );
        $dbh->sqlite_create_function( 'octet_length', 1, sub {
                require bytes;
                return if ! defined $_[0];
                return bytes::length $_[0];
            }
        );
    }
    return $dbh;
}


sub get_databases {
    my ( $sf ) = @_;
    my ( $user_db, $sys_db ) = $sf->{Plugin}->get_databases();
    return $user_db // [], $sys_db // [];
}


sub get_schemas {
    my ( $sf, $dbh, $db, $is_system_db ) = @_;
    my ( $user_schemas, $sys_schemas );
    my $driver = $dbh->{Driver}{Name}; #
    my $dbms = $sf->{Plugin}{i}{dbms};
    if ( $sf->{Plugin}->can( 'get_schemas' ) ) {
        ( $user_schemas, $sys_schemas ) = $sf->{Plugin}->get_schemas( $dbh, $db, $is_system_db );
    }
    else {
        if ( $dbms eq 'SQLite' ) {
            $user_schemas = [];
        }
        elsif( $dbms =~ /^(?:mysql|MariaDB)\z/ ) {
            # MySQL 8.0 Reference Manual / MySQL Glossary / Schema:
            # In MySQL, physically, a schema is synonymous with a database.
            # You can substitute the keyword SCHEMA instead of DATABASE in MySQL SQL syntax,
            $user_schemas = [ $db ];
        }
        elsif ( $dbms eq 'Firebird' ) {
            $user_schemas = [];
        }
        elsif ( $dbms eq 'Oracle' ) {
            # To separate system schemas from the user schemas.
            my ( $tmp_user_schemas, $tmp_sys_schemas ) = ( [], [] );
            for my $sch ( $dbh->selectall_array( "SELECT USERNAME, ORACLE_MAINTAINED FROM ALL_USERS" ) ) {
                if ( $sch->[1] =~ /^N/i ) {
                    push @$tmp_user_schemas, $sch->[0];
                }
                else {
                    push @$tmp_sys_schemas, $sch->[0];
                }
            }
            $user_schemas = [ sort @$tmp_user_schemas ];
            $sys_schemas = [ sort @$tmp_sys_schemas, 'PUBLIC' ];
        }
        else {
            my $table_schem;
            if ( $driver eq 'Pg' ) {