view release on metacpan or  search on metacpan

DBI.pm  view on Meta::CPAN

  tmpl_    => { class => 'DBD::Template',	},
  tmplss_  => { class => 'DBD::TemplateSS',	},
  tuber_   => { class => 'DBD::Tuber',		},
  uni_     => { class => 'DBD::Unify',		},
  xbase_   => { class => 'DBD::XBase',		},
  xl_      => { class => 'DBD::Excel',		},
  yaswi_   => { class => 'DBD::Yaswi',		},
};

sub dump_dbd_registry {
    require Data::Dumper;
    local $Data::Dumper::Sortkeys=1;
    local $Data::Dumper::Indent=1;
    print Data::Dumper->Dump([$dbd_prefix_registry], [qw($dbd_prefix_registry)]);
}

# --- Dynamically create the DBI Standard Interface

my $keeperr = { O=>0x0004 };

%DBI::DBI_methods = ( # Define the DBI interface methods per class:

    common => {		# Interface methods common to all DBI handle classes
	'DESTROY'	=> $keeperr,

DBI.pm  view on Meta::CPAN

    my $connect_closure = sub {
	my ($old_dbh, $override_attr) = @_;

	my $attr = {
	    # copy so we can edit them each time we're called
	    %attributes,
	    # merge in modified attr in %$old_dbh, this should also copy in
	    # the dbi_connect_closure attribute so we can reconnect again.
	    %{ $override_attr || {} },
	};
	#warn "connect_closure: ".Data::Dumper::Dumper([\%attributes, $override_attr]);

	my $dbh;
	unless ($dbh = $drh->$connect_meth($dsn, $user, $pass, $attr)) {
	    $user = '' if !defined $user;
	    $dsn = '' if !defined $dsn;
	    # $drh->errstr isn't safe here because $dbh->DESTROY may not have
	    # been called yet and so the dbh errstr would not have been copied
	    # up to the drh errstr. Certainly true for connect_cached!
	    my $errstr = $DBI::errstr;
	    $errstr = '(no error string)' if !defined $errstr;

DBI.pm  view on Meta::CPAN

		$attr->{$k} = $v;
	    }
	    # explicitly set attributes which are unlikely to be in the
	    # attribute cache, i.e., boolean's and some others
	    $attr->{$_} = $old_dbh->FETCH($_) for (qw(
		AutoCommit ChopBlanks InactiveDestroy
		LongTruncOk PrintError PrintWarn Profile RaiseError
		ShowErrorStatement TaintIn TaintOut
	    ));
	}
	# use Data::Dumper; warn Dumper([$old_dbh, $attr]);
	my $new_dbh = &$closure($old_dbh, $attr);
	unless ($new_dbh) {
	    # need to copy err/errstr from driver back into $old_dbh
	    my $drh = $old_dbh->{Driver};
	    return $old_dbh->set_err($drh->err, $drh->errstr, $drh->state);
	}
	return $new_dbh;
    }

    sub quote_identifier {