view release on metacpan or  search on metacpan

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

			return $obj->io_set_error(-1, "System error: can't recv() msg body; closing connection.", '08S01')
				unless defined($rspmsg) && length($rspmsg);
		}
		$lrspmsg = length($rspmsg);

		DBI->trace_msg("GOT $lrspmsg BYTES, NEEDED $tdmsglen\n",2)
			if $debug && ($lrspmsg < $tdmsglen);

		substr($hdr, $hdrlen, length($rspmsg)) = $rspmsg;
		$tdmsglen -= $lrspmsg;
		$hdrlen += $lrspmsg;
	}

	close($c);
	DBI->trace_msg(io_pcldump(substr($hdr, 52), length($hdr) - 52, 0), 1)
		if $debug;

	my ($f, $l)  = unpack('SS', substr($hdr, $cfgpos));
	return $obj->io_set_error(-1,
"Unknown response parcel $f recv'd during CONFIG; closing connection.",
		'08C01')
		if ($f != 43) || ($l < 4);
	$cfgpos += 14;
	my $pe_cnt = unpack('S', substr($hdr, $cfgpos));
	$cfgpos += 2 + ($pe_cnt * 4);
	my $amp_cnt = unpack('S', substr($hdr, $cfgpos));
	$cfgpos += 2 + ($amp_cnt * 2);
	my $dflt_charset = unpack('C', substr($hdr, $cfgpos));
	$cfgpos += 2;
	my $charset_cnt = unpack('S', substr($hdr, $cfgpos));
	$cfgpos += 2 + ($charset_cnt * 32) + 6;
	my $defmode = unpack('A', substr($hdr, $cfgpos));
	$defmode = ($defmode eq 'A') ? 'ANSI' : 'TERADATA';
	$attr->{tdat_mode} = $defmode
		if ($attr->{tdat_mode} eq 'DEFAULT');
	return $obj->io_set_error(-1,
		"Only DBC/SQL sessions allowed in ANSI mode; closing connection.",
		'08C01')
		if ($attr->{tdat_mode} eq 'ANSI') && ($attr->{tdat_utility} ne 'DBC/SQL');
	$obj->[10] = $attr->{tdat_mode};
	($obj->[7], $obj->[8]) =
		($attr->{tdat_mode} eq 'ANSI') ?
			('COMMIT WORK', 'ROLLBACK WORK') : ('ET', 'ABORT');

	return $dflt_charset;
}

sub io_connect {
	my ($obj, $dbsys, $port, $username, $password, $dbname, $attr) = @_;
	$obj->[18] = -1;
	$obj->[24] = 'S1000';
	$obj->[17] = '';
	my $dflt_charset = $obj->io_getconfig($dbsys, $port, $attr) or
		return undef;
	$obj->[40] = 0;
	my $rspmsg;
	$obj->[19] = 1;
	$obj->[20] = $attr->{tdat_lsn} || undef;
	my $lgnsrc = $attr->{tdat_logonsrc};
	unless ($lgnsrc) {
		my $uid = getlogin || getpwuid $< || '????';
		$dbsys .= ' ' x (12 - length($dbsys))
			if (length($dbsys) < 12);
		my $app = $0;
		$app = substr($app, 0, 20)
			if (length($app) > 20);
		$app .= ' ' x (4 - length($app))
			if (length($app) < 4);
		$lgnsrc = "$dbsys  $$  $uid  $app  01  LSS";
	}
	$password = '' unless defined($password);
	my $charset = $attr->{tdat_charset};
	$obj->[9] =
		(($obj->[9] & 128) ? 128 : 0) |
			(
			(! $charset)			? $dflt_charset :
			($charset eq 'UTF8')	? 63 :
			($charset eq 'ASCII')	? 127 : 64);
	$attr->{tdat_charset} = $charset =
		(($dflt_charset & 127) == 63) ? 'UTF8' :
		(($dflt_charset & 127) == 127) ? 'ASCII' : 'EBCDIC'
		unless $charset;
	$obj->[25] = (($obj->[9] & 127) == 63);

	$dbsys=~s/COP\d+\s*$//i;
	my $logonstr = "$dbsys/$username,$password";
	my ($hostid, $sessno, $version);
	($obj->[15], $obj->[18], $obj->[17],
		$hostid, $sessno, $version) =
			DBD::Teradata::Cli->new(
				$logonstr, $attr->{tdat_mode}, $lgnsrc, $obj->[9], $debug);
	$obj->[24] = '08C01',
	return undef
		if defined($obj->[18]);
	$obj->[13] = $sessno;
	$obj->[29] = $hostid & 0x3FF;
	$obj->[28] = "V2R$version";
	$obj->[21] = $1,
	$obj->[27] = $2,
	$obj->[36] = $3,
	$obj->[37] = $4,
	$obj->[40] = ($1 * 1000000) + ($2 * 10000) + ($3 * 100) + $4
		if ($version=~/^(\d+)[A-Za-z]*\.(\d+)\.(\d+)\.(\d+)/);
	DBI->trace_msg(
		"Session $$obj[13] connected via CLI for $$obj[28]\n", 1)
		if $debug;
	$obj->[2] = 1;
	$obj->[14] = 0;

	DBI->trace_msg("Session $$obj[13] connected\n", 1) if $debug;
	$obj->[38] =
		(($obj->[40] < 5000000) ||
			($obj->[19] != 1) ||
			defined($attr->{tdat_lsn})) ?
			DBD::Teradata::ReqFactory->new() :
		($obj->[40] < 6010000) ?
			DBD::Teradata::APHReqFactory->new() :
			DBD::Teradata::BigAPHReqFactory->new();
	$obj->[18] = 0;
	$obj->[24] = '00000';
	$obj->[11] = 0;