view release on metacpan or  search on metacpan

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

            $_emc                = 1;
            --$i;
        } elsif ($args[$i] eq 'connector_pool') {
            (undef, $connector_pool) = splice @args, $i, 2;
            $_cp = 1;
            --$i;
        } elsif ($args[$i] eq 'connector_pool_method') {
            (undef, $connector_pool_method) = splice @args, $i, 2;
            --$i;
        } elsif ($args[$i] eq 'connector_args') {
            (undef, $connector_args) = splice @args, $i, 2;
            --$i;
        } elsif ($args[$i] eq 'connector') {
            $_c = 1;
        } elsif ($args[$i] eq 'connector_object') {
            $defconn = 1;
            set_connector_object($args[$i + 1]);
            splice @args, $i, 2;
            --$i;
        }
    }
    if ($_emc) {
        no warnings 'redefine';
        no strict 'refs';
        *error_message = \&{$error_message_class . "::error_message"};
    }
    if ($_cp) {
        no warnings 'redefine';
        no strict 'refs';
        *connector = \&connector_from_pool;
        for my $aep (@already_exported_to) {
            *{"$aep\::connector"} = \&connector;
        }
    }
    my $callpkg = caller;
    push @already_exported_to, $callpkg if $_c;
    my %imps = map {$_ => undef} @args, @EXPORT;
    $class->export_to_level(1, $class, keys %imps);
}

sub _not_yet_connected {
    if (!$connector_pool && !$conn) {
        my ($dsn, $user, $password) = @_;
        if ($dsn && $dsn !~ /^dbi:/i) {
            $dsn = "dbi:Pg:dbname=$dsn";
        }
        my $connect_attrs = {
            AutoCommit          => 1,
            PrintError          => 0,
            AutoInactiveDestroy => 1,
            RaiseError          => 0,
        };
        if ($dsn) {
            my ($driver) = $dsn =~ /^dbi:(\w*?)(?:\((.*?)\))?:/i;
            if ($driver) {
                if ($driver eq 'Pg') {
                    $connect_attrs->{pg_enable_utf8} = 1;
                } elsif ($driver eq 'mysql') {
                    $connect_attrs->{mysql_enable_utf8} = 1;
                } elsif ($driver eq 'SQLite') {
                    $connect_attrs->{sqlite_unicode} = 1;
                }
            }
        }
        if (!@$connector_args) {
            @$connector_args = ($dsn, $user, $password, $connect_attrs);
        }
        $conn = $connector_module->$connector_constructor(@$connector_args)
          or error_message {
            message => "DB connect error",
            result  => 'SQLERR',
          };
        $conn->mode('fixup');
    }
    '' =~ /()/;
    $connector_driver = connector->driver->{driver};
    no warnings 'redefine';
    *connect = \&connector;
    populate();
    connector;
}

sub connect {
    goto &_not_yet_connected;
}

{
    my $md5 = Digest::MD5->new;

    sub make_name {
        my ($table) = @_;
        my $simple_table = (index($table, " ") == -1);
        my $ncn;
        if ($simple_table) {
            $ncn = $table_classes_namespace . "::" . join('', map {ucfirst($_)} split(/[^a-zA-Z0-9]/, $table));
        } else {
            $md5->add($table);
            $ncn = $query_classes_namespace . "::" . "G" . $md5->hexdigest;
            $md5->reset;
        }
        $ncn;
    }
}

sub populate {
    my @tables;
    DBIx::Struct::connect->run(
        sub {
            my $sth = $_->table_info('', '%', '%', "TABLE");
            return if not $sth;
            my $tables = $sth->fetchall_arrayref;
            @tables = map {
                (my $t = $_->[2]) =~ s/"//g;
                $t;
              } grep {
                $_->[3] eq 'TABLE' and $_->[2] !~ /^sql_/
              } @$tables;
        }
    );
    for (@tables) {
        my $ncn = setup_row($_);