view release on metacpan or  search on metacpan

lib/DBD/Teradata.pm  view on Meta::CPAN

use Config;
use Exporter;
use DBI qw(:sql_types);
use Time::Local;

BEGIN {
our @ISA = qw(Exporter);

our @EXPORT    = ();
our @EXPORT_OK = qw(
	%td_type_code2str
	%td_type_str2baseprec
	%td_type_str2basescale
	%td_lob_scale
	@td_decszs
	%td_type_str2dbi
	%td_type_str2size
	%td_type_str2pack
	%td_type_str2stringtypes
	%td_type_str2binarytypes
	%td_type_dbi2stringtypes
	%td_type_dbi2str
	%td_activity_types
	%td_sqlstates
	@td_indicbits
	@td_indicmasks
	@td_decstrs
	@td_decscales
	@td_decfactors
	%td_type_dbi2preconly
	%td_type_dbi2hasprec
	%td_type_dbi2hasscale
	%td_type_dbi2pack
	%td_type_code2dbi
	%td_type_dbi2code
	%td_type_dbi2size
	%td_type_str2ddcodes
	%td_type_ddcode2str
);

	$platform = $ENV{TDAT_PLATFORM_CODE};
	$hostchars = (ord('A') != 65) ? 64 : 127;

	my $netval = unpack('n', pack('s', 1234));
	$platform = ($hostchars == 64) ? 3 :
		(($netval == 1234) ? 7 : 8)
		unless $platform && ($platform=~/^\d+$/);
	$hostchars |= 128 if ($netval == 1234);

	my $phsz = $ENV{TDAT_PH_SIZE};
	$phdfltsz = $phsz
		if defined($phsz) && ($phsz=~/^\d+$/) && ($phsz > 0) && ($phsz < 1024);
	($dechi, $declo) = ($platform == 7) ? (0, 1) : (1, 0);

	$debug = $ENV{TDAT_DBD_DEBUG} || 0;

	$use_arm = ($Config{archname}=~/^arm-linux/i);
our $HAS_WEAKEN = eval {
	    require Scalar::Util;
	    Scalar::Util::weaken(my $test = \"foo");
	    1;
	};
};

our %td_type_code2str = (
400, 'BLOB',
404, 'DEFERRED BLOB',
408, 'BLOB LOCATOR',
416, 'CLOB',
420, 'DEFERRED CLOB',
424, 'CLOB LOCATOR',
448, 'VARCHAR',
452, 'CHAR',
456, 'LONG VARCHAR',
464, 'VARGRAPHIC',
468, 'GRAPHIC',
472, 'LONG VARGRAPHIC',
480, 'FLOAT',
484, 'DECIMAL',
496, 'INTEGER',
500, 'SMALLINT',
600, 'BIGINT',
688, 'VARBYTE',
692, 'BYTE',
696, 'LONG VARBYTE',
752, 'DATE',
756, 'BYTEINT',
760, 'TIMESTAMP',
764, 'TIME',
);

our %td_type_code2dbi = (
400, 30,
404, 30,
408, 31,
416, 40,
420, 40,
424, 41,
448, 12,
452, 1,
456, 12,
464, -9,
468, -8,
472, -10,
480, 6,
484, 3,
496, 4,
500, 5,
600, -5,
688, -3,
692, -2,
696, -3,
752, 9,
756, -6,
760, 11,
764, 10,
);

our %td_type_str2baseprec = (
'DEC', 5, 'DECIMAL', 5, 'CHAR', 1, 'VARCHAR', 1, 'BYTE', 1,

lib/DBD/Teradata.pm  view on Meta::CPAN

		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