DBD-Teradata
view release on metacpan or search on metacpan
lib/DBD/Teradata.pm view on Meta::CPAN
return $drh->DBI::set_err(-1, "Bad request buffer size $val. Value must be between 256 and 2097151.", 'S1000')
unless ($val=~/^\d+$/);
$attr->{tdat_reqsize} = 256 unless ($val >= 256);
$attr->{tdat_reqsize} = 2097151 unless ($val < 2097152);
}
elsif ($key eq 'tdat_charset') {
return $drh->DBI::set_err(-1, 'Bad character set.', 'S1000')
unless ($val=~/^ASCII|UTF8|EBCDIC$/i);
}
elsif ($attr->{tdat_reconnect}) {
return $drh->DBI::set_err(-1, 'Cannot reconnect non-SQL sessions.', 'S1000')
if ($attr->{tdat_utility} ne 'DBC/SQL');
return $drh->DBI::set_err(-1, 'Invalid tdat_reconnect value: must be scalar or coderef.', 'S1000')
if (ref $attr->{tdat_reconnect} ne 'CODE');
}
}
return $drh->DBI::set_err(-1, 'Username required for connect.', 'S1000')
unless defined($user) || $attr->{tdat_passthru};
$attr->{tdat_bufsize} = $maxbufsz
unless exists $attr->{tdat_bufsize};
$attr->{tdat_reqsize} = $attr->{tdat_bufsize}
unless exists $attr->{tdat_reqsize};
$attr->{tdat_respsize} = $attr->{tdat_bufsize}
unless exists $attr->{tdat_respsize};
my ($iobj, $err, $errstr, $state) =
DBD::Teradata::impl->new($host, $port, $user, $auth, undef, $attr);
return $drh->set_err($err, $errstr, $state)
unless $iobj;
$attr->{tdat_reqsize} = $iobj->io_set_reqsz($maxbufsz)
if $attr->{tdat_reqsize} &&
($attr->{tdat_reqsize} > $maxbufsz) &&
(($iobj->[40] < 5000000) ||
(($attr->{tdat_utility} ne 'DBC/SQL') && ($iobj->[40] < 6000000)));
$attr->{tdat_respsize} = $iobj->io_set_respsz($maxbufsz)
if $attr->{tdat_respsize} &&
($attr->{tdat_respsize} > $maxbufsz) &&
($iobj->[40] < 6000000);
my ($outer, $dbh) = DBI::_new_dbh($drh,{
Name => $dsn,
USER => $user,
CURRENT_USER => $user,
tdat_utility => $attr->{tdat_utility},
tdat_sessno => $iobj->[13],
tdat_hostid => $iobj->[29],
tdat_mode => $attr->{tdat_mode},
tdat_version => $iobj->[28],
tdat_compatible => (defined($attr->{tdat_compatible}) ? $attr->{tdat_compatible} : 99.0),
tdat_reconnect => $attr->{tdat_reconnect},
tdat_charset => $attr->{tdat_charset},
tdat_reqsize => $attr->{tdat_reqsize},
tdat_respsize => $attr->{tdat_respsize},
tdat_no_bigint => $attr->{tdat_no_bigint},
});
$dbh->{tdat_password} = $auth
if $attr->{tdat_lsn};
$iobj->[31] = $dbh;
$dbh->{tdat_uses_cli} = 1;
$dbh->{tdat_versnum} = $iobj->[40];
$dbh->{_iobj} = $iobj;
$dbh->{_stmts} = { };
$dbh->{_nextcursor} = 0;
$dbh->{_cursors} = { };
$dbh->{_debug} = $ENV{TDAT_DBD_DEBUG};
$dbh->{_utf8} = ($attr->{tdat_charset} eq 'UTF8');
$dbh->{Active} = 1;
$drh->{_connections}{($dsn . '_' . $dbh->{tdat_sessno})} = $dbh
unless $attr->{tdat_passthru};
return $outer;
}
sub data_sources {}
sub DESTROY {
$_[0]->disconnect_all();
}
sub disconnect_all {
foreach (values %{$_[0]->{_connections}}) {
$_->disconnect if defined($_);
}
$_[0]->{_connections} = { };
}
sub FirstAvailable {
my ($drh, $dbhlist, $timeout) = @_;
my @sesslist = ();
my %seshash;
foreach my $dbh (@$dbhlist) {
push(@sesslist, defined($dbh) ?
(ref $dbh) ? $dbh->{_iobj} : $dbh : undef);
}
my @outlist = DBD::Teradata::impl::io_FirstAvailList(\@sesslist, $timeout);
return (@outlist ? $outlist[0] : undef);
}
*tdat_FirstAvailable = \&FirstAvailable;
sub FirstAvailList {
my ($drh, $dbhlist, $timeout) = @_;
my @sesslist = ();
foreach my $dbh (@$dbhlist) {
push(@sesslist, defined($dbh) ?
(ref $dbh) ? $dbh->{_iobj} : $dbh : undef);
}
return DBD::Teradata::impl::io_FirstAvailList(\@sesslist, $timeout);
}
*tdat_FirstAvailList = \&FirstAvailList;
1;
package DBD::Teradata::db;
use DBI qw(:sql_types);
$DBD::Teradata::db::imp_data_size = 0;
our %readonly_attrs = qw(
tdat_utility 1
tdat_sessno 1
tdat_hostid 1
tdat_mode 1
tdat_version 1
tdat_compatible 1
tdat_charset 1
);
our %valid_attrs = (
'ChopBlanks', 1,
'tdat_sp_print', 1,
'tdat_sp_save', 1,
'tdat_compatible', 1,
'tdat_formatted', 1,
'tdat_keepresp', 1,
'tdat_nowait', 1,
lib/DBD/Teradata.pm view on Meta::CPAN
}
);
}
elsif ($stmt=~/^EXPLAIN\b/i) {
return _make_sth($dbh,
{
%$attribs,
Statement => $stmt,
tdat_stmt_info => [
undef,
{
ActivityType => 'Explain',
ActivityCount => 0,
StartsAt => 0,
EndsAt => 0,
}
],
NUM_OF_FIELDS => 1,
NAME => [ 'Explanation' ],
TYPE => [ 12 ],
PRECISION => [ 80 ],
SCALE => [ undef ],
NULLABLE => [ 0 ],
tdat_TYPESTR => [ 'VARCHAR(80)' ],
tdat_TITLE => [ 'Explanation' ],
tdat_FORMAT => [ 'X(80)' ],
_unpackstr => [ 'A*' ],
NUM_OF_PARAMS => 0,
}
);
}
elsif ($stmt=~/^(CREATE|REPLACE)\s+PROCEDURE\s+/i) {
return _make_sth($dbh,
{
%$attribs,
Statement => $stmt,
tdat_stmt_info => [
undef,
{
ActivityType => 'Create Procedure',
ActivityCount => 0,
StartsAt => 0,
EndsAt => 0,
},
],
NUM_OF_FIELDS => 1,
NAME => [ 'COMPILE_ERROR' ],
TYPE => [ 12 ],
PRECISION => [ 255 ],
SCALE => [ undef ],
NULLABLE => [ 0 ],
tdat_TYPESTR => [ 'VARCHAR(255)' ],
tdat_TITLE => [ 'Compile Error' ],
tdat_FORMAT => [ 'X(255)' ],
_unpackstr => [ 'S/A' ],
NUM_OF_PARAMS => 0,
}
);
}
my $rowid = undef;
$rowid = $dbh->{_cursors}{uc $1}{_rowid}
if ($stmt=~/\s+WHERE\s+CURRENT\s+OF\s+([^\s;]+)\s*;?\s*$/i);
my $sth = $iobj->io_prepare($dbh, \&_make_sth, $stmt, $rowid, $attribs, $compatible, $passthru);
return $sth || $dbh->DBI::set_err($iobj->io_get_error());
}
sub _make_sth {
my ($dbh, $args) = @_;
delete $args->{tdat_clone};
delete $args->{tdat_passthru};
$args->{CursorName} = 'CURS' . $dbh->{_nextcursor};
$dbh->{_nextcursor}++;
$args->{tdat_stmt_num} = 0;
$args->{tdat_sessno} = $dbh->{tdat_sessno};
$args->{tdat_compatible} = '999.0'
unless $args->{tdat_compatible};
$args->{tdat_no_bigint} = $dbh->{tdat_no_bigint}
unless exists $args->{tdat_no_bigint};
$args->{ParamValues} = {}
unless $args->{ParamValues};
$args->{ParamArrays} = {}
unless $args->{ParamArrays};
my @sthp = ();
$sthp[13] = -1;
$sthp[18] = delete $args->{_packstr};
$sthp[10] = delete $args->{_unpackstr};
$sthp[11] = $dbh->{_iobj};
$sthp[5] = [];
$sthp[2] = delete $args->{_ptypes};
$sthp[9] = delete $args->{_plens};
$sthp[15] = delete $args->{_usephs};
$sthp[21] = delete $args->{_usenames};
$sthp[22] = 1;
$sthp[24] = 0;
$sthp[4] = delete $args->{_parmdesc};
$sthp[8] = delete $args->{_parmmap};
$sthp[23] = $dbh;
$args->{_p} = \@sthp;
if ($args->{tdat_vartext_in}) {
my ($ptypes, $plens) = ($sthp[2], $sthp[9]);
foreach (0..$#$ptypes) {
$dbh->set_err(0,
'Using VARTEXT input with other than VARCHAR USING parameter.', '00000'),
$ptypes->[$_] = 12,
$plens->[$_] = 16
unless ($ptypes->[$_] == 12);
}
$sthp[18] = ('S/a*' x (scalar @$ptypes));
}
my $stmtinfo = $args->{tdat_stmt_info};
my ($outer, $sth) = DBI::_new_sth($dbh,
{
Statement => $args->{Statement},
CursorName => $args->{CursorName}
})
or return $dbh->set_err(-1, 'Unable to create statement handle.', 'S1000');
$sth->STORE('NUM_OF_PARAMS', delete $args->{NUM_OF_PARAMS});
$sth->STORE('NUM_OF_FIELDS', delete $args->{NUM_OF_FIELDS});
my ($key, $val);
$sth->{$key} = $val
while (($key, $val) = each %$args);
$dbh->{_stmts}{$sth->{CursorName}} = $sth;
Scalar::Util::weaken($dbh->{_stmts}{$sth->{CursorName}})
if $DBD::Teradata::HAS_WEAKEN;
$dbh->{_cursors}{$sth->{CursorName}} = $sth,
$sth->{tdat_keepresp} = 1,
$sthp[16] = 1
if ($#$stmtinfo == 1) &&
($stmtinfo->[1]{ActivityType} eq 'Select') &&
($sth->{Statement}=~/\s+FOR\s+CURSOR\s*;?\s*$/i);
$dbh->{tdat_nowait} = $sth->{tdat_nowait}
if ($dbh->{tdat_utility} ne 'DBC/SQL');
$sth->{tdat_TYPESTR} = DBD::Teradata::st::map_type2str($sth)
unless defined $sth->{tdat_TYPESTR} || (! $sth->{NUM_OF_FIELDS});
return wantarray ? ($outer, $sth) : $outer;
}
sub DESTROY {
my $dbh = shift;
return 1
unless (defined($dbh->{tdat_sessno}) &&
defined($dbh->{Name}) &&
defined($dbh->{Driver}));
my $host = $dbh->{Name} . '_' . $dbh->{tdat_sessno};
return 1
unless defined($dbh->{Driver}{_connections}{$host});
$dbh->disconnect;
}
sub disconnect {
my $dbh = shift;
my $i;
$dbh->{Active} = undef;
$dbh->{_stmts} = $dbh->{_cursors} = undef;
return 1
unless defined($dbh->{tdat_sessno}) &&
defined($dbh->{Name}) && defined($dbh->{Driver});
my $sessno = $dbh->{tdat_sessno};
my $host;
my $drh = $dbh->{Driver};
if ($sessno) {
$host = $dbh->{Name} . '_' . $sessno;
$dbh->set_err(0, 'Session not found'),
return 1
unless defined($drh->{_connections}{$host});
}
my $iobj = $dbh->{_iobj};
$iobj->io_disconnect unless $dbh->{_ignore_destroy};
$dbh->{_iobj} = undef;
delete $drh->{_connections}{$host}
if defined($host);
1;
}
sub commit {
my $dbh = shift;
my $xactmode = $dbh->{AutoCommit};
if (defined($xactmode) && ($xactmode == 1)) {
warn('Commit ineffective while AutoCommit is on')
if $dbh->{Warn};
return 1;
}
my $iobj = $dbh->{_iobj};
return 1 unless $iobj->[11];
foreach (values(%{$dbh->{_stmts}})) {
$_->finish
unless $_->{_p}[22] ||
($_->{tdat_keepresp} &&
(! $_->{_p}[16]));
}
$iobj->io_commit;
$dbh->DBI::set_err($iobj->io_get_error());
$iobj->[11] = 0;
return 1;
}
sub rollback {
my $dbh = shift;
my $xactmode = $dbh->{AutoCommit};
if (defined($xactmode) && ($xactmode == 1)) {
warn('Rollback ineffective while AutoCommit is on')
if $dbh->{Warn};
return 1;
}
my $iobj = $dbh->{_iobj};
return 1 unless $iobj->[11];
foreach (values(%{$dbh->{_stmts}})) {
$_->finish
unless $_->{_p}[22] ||
($_->{tdat_keepresp} &&
(! $_->{_p}[16]));
}
$iobj->io_rollback;
$dbh->DBI::set_err($iobj->io_get_error());
$iobj->[11] = 0;
return 1;
lib/DBD/Teradata.pm view on Meta::CPAN
*BindParamArray = \&bind_param;
*tdat_BindParamArray = \&bind_param;
*bind_param_array = \&bind_param;
sub bind_param_status {
return $_[0]->DBI::set_err(-1, 'Status argument must be arrayref.', 'S1000')
unless (ref $_[1] eq 'ARRAY');
$_[0]->{_p}[3] = $_[1];
return 1;
}
sub cvt_arm_flt {
my ($lo, $hi) = unpack('LL', pack('d', $_[0]));
return unpack('d', pack('LL', $hi, $lo));
}
sub bind_param_inout {
my ($sth, $pNum, $val, $maxlen, $attr) = @_;
my $sthp = $sth->{_p};
unless ($pNum=~/^\d+$/) {
return $sth->DBI::set_err(-1, 'Invalid parameter name.', 'S1000')
unless (substr($pNum, 0, 1) eq ':') && $sthp->[21];
my $i = 0;
$pNum = uc substr($pNum, 1);
$i++
while (($i <= $#{$sthp->[21]}) &&
($sthp->[21][$i] ne $pNum));
return $sth->DBI::set_err(-1, 'Invalid parameter name.', 'S1000')
if ($i > $#{$sthp->[21]});
$pNum = $i + 1;
}
$sth->bind_col($sthp->[8]{$pNum}+1, $val)
if $sthp->[8] &&
defined($sthp->[8]{$pNum});
return bind_param($sth, $pNum, $val, $attr)
}
sub execute {
return _execute_any({}, @_);
}
sub _execute_any {
my ($attrs, $sth, @bind_values) = @_;
my $sthp = $sth->{_p};
my $iobj = $sthp->[11];
$sth->finish
if $sthp->[26];
delete $iobj->[1]{$sthp->[12]}
if defined($sthp->[12]);
my $params = $attrs->{_fetch_sub} ? undef :
(scalar @bind_values) ? \@bind_values :
$sthp->[5];
$params = delete $attrs->{_residual}
if $attrs->{_residual};
my $numParam = $sth->{NUM_OF_PARAMS} || 0;
if ($sth->{tdat_vartext_in} && ($#bind_values >= 0)) {
return undef
unless $sth->bind_param(1, $bind_values[0]);
$params = $sthp->[5];
}
my ($ptypes, $plens, $usephs) =
($sthp->[2], $sthp->[9], $sthp->[15]);
my ($sessno, $dbh, $partition) =
($sth->{tdat_sessno}, $sthp->[23], $iobj->[19]);
my $loading = (($partition == 5) || ($partition == 4));
my ($use_cursor, $cursnm, $cursth) = (0, '', undef);
if ($sth->{Statement}=~/\s+WHERE\s+CURRENT\s+OF\s+([^\s;]+)\s*;?$/i) {
$cursnm = uc $1;
$cursth = $dbh->{_cursors}{$cursnm};
return $sth->DBI::set_err(-1, 'Specified cursor not defined or not updatable.', 'S1000')
unless $cursth;
return $sth->DBI::set_err(-1, 'Specified cursor not positioned on a valid row.', 'S1000')
unless $cursth->{_p}[6];
$use_cursor = 1;
}
$iobj->[14] = 0,
$sth->{tdat_keepresp} = 1
if ($sth->{Statement}=~/\s+FOR\s+CURSOR\s*;?$/i);
my $rawmode = $sth->{tdat_raw_in};
my $modepcl =
($partition == 4) ? 104 :
(($partition == 6) ||
($rawmode && ($rawmode eq 'RecordMode'))) ? 3 :
68;
$numParam = 0
unless ($partition != 6) ||
($iobj->[6] && ($#$params >= 0));
return $sth->DBI::set_err(-1, 'Too many parameters provided.', 'S1000')
if defined($params) && (@$params > $numParam);
return $sth->DBI::set_err(-1, 'No parameters provided for parameterized statement.', 'S1000')
unless ($numParam == 0) || defined($params) || defined($dbh->{tdat_loading}) ||
$attrs->{_fetch_sub};
my $stmtno = 0;
my $maxparmlen = 1;
if ($attrs->{_fetch_sub}) {
$maxparmlen = MAX_PARM_TUPLES;
}
else {
foreach (0..$numParam-1) {
$maxparmlen = scalar(@{$$params[$_]})
if (ref $$params[$_] eq 'ARRAY') &&
(scalar(@{$$params[$_]}) > $maxparmlen);
}
}
my $fldcnt = $numParam;
my ($tuples, $datainfo, $indicdata) = (0, '', '');
my $pos = 0;
if (($params && scalar @$params) || $attrs->{_fetch_sub}) {
($tuples, $datainfo, $indicdata) =
$usephs ? _process_ph_params($sth, $fldcnt, $params, $attrs) :
_process_using_params($sth, $fldcnt, $rawmode, $modepcl, $params, $attrs);
return undef
unless $tuples;
}
$iobj->io_tddo('BT'),
$iobj->[11] = 1
if ($partition == 1) && (!$dbh->{AutoCommit}) &&
($dbh->{tdat_mode} ne 'ANSI') && ($iobj->[11] == 0);
$iobj->[11] = 1
if ($partition == 1) && ($dbh->{tdat_mode} eq 'ANSI');
return $tuples
if $attrs->{_fetch_sub};
my $rowcnt = $iobj->io_execute($sth, $datainfo, $indicdata,
($use_cursor ? $cursth->{_p}[6] : undef));
$sthp->[13] = $rowcnt;
return $sth->DBI::set_err($iobj->io_get_error())
unless defined($rowcnt);
$sth->{Active} = ($sth->{NUM_OF_FIELDS} != 0);
undef $sthp->[6]
if ($sth->{Statement}=~/^DELETE\s+.+\s+WHERE\s+CURRENT\s+OF\s+\w+$/i);
$sthp->[26] = 1
unless $sthp->[22] && (! $sth->{tdat_keepresp});
return ($rowcnt == 0) ? -1 : $rowcnt
if ($sth->{tdat_compatible} lt '2.0');
return ($rowcnt == 0) ? '0E0' : $rowcnt;
}
sub _gen_datainfo {
my ($fldcnt, $ptypes, $plens, $maxszs) = @_;
my $packstr = '';
my $datainfo = pack('S', $fldcnt) . ("\0" x ($fldcnt * 4));
my $prec;
my $j = 2;
foreach (0..$fldcnt-1) {
my $tdtype = $td_type_dbi2code{$ptypes->[$_]}+1;
$plens->[$_] ||= 0
if ($ptypes->[$_] == 12) || ($ptypes->[$_] == -3);
$prec = ($ptypes->[$_] == 3) ?
$td_decszs[($plens->[$_] >> 8) & 31] : $plens->[$_];
$packstr .=
(($ptypes->[$_] == -2) ||
($ptypes->[$_] == 3)) ? "a$prec " :
($ptypes->[$_] == 1) ? "A$prec " :
$td_type_dbi2pack{$ptypes->[$_]} . ' ';
$prec = 2 + $plens->[$_]
if ($maxszs->[$_] < $plens->[$_]) &&
(($ptypes->[$_] == 12) ||
($ptypes->[$_] == -3));
substr($datainfo, $j, 4) = pack('SS', $tdtype, $plens->[$_]);
$maxszs->[$_] = $prec;
$j += 4;
}
return ($datainfo, $packstr);
}
sub _process_ph_params {
my ($sth, $fldcnt, $params, $attrs) = @_;
my $indicdata;
my $pos = 0;
my $maxsz = 100;
my ($i, $p);
my $sthp = $sth->{_p};
my $iobj = $sthp->[11];
my $ptypes = $sthp->[2];
my $plens = $sthp->[9];
my $fetch_sub = $attrs->{_fetch_sub};
my @maxszs = ((0) x $fldcnt);
my ($datainfo, $packstr) = _gen_datainfo($fldcnt, $ptypes, $plens, \@maxszs);
my @tmpary = ();
my $ttype = 12;
my @indicvec = ();
my $tuples = 0;
my $deccvt =
($sth->{tdat_no_bigint} || (!$has_bigint)) ? \&cvt_flt2dec :
($^O eq 'MSWin32') ? \&cvt_bigint2dec :
\&cvt_eval_bigint2dec;
( run in 0.586 second using v1.01-cache-2.11-cpan-39bf76dae61 )