DBD::Teradata - DBI driver for Teradata

  use DBI;

  $dbh = DBI->connect('dbi:Teradata:hostname', 'user', 'password');

	perl t/test.pl <host> <user> <password>

	perl t/test.pl 129.123.345.78 dbc dbc   # WRONG

	perl t/test.pl DBCCOP1 dbc dbc          # WRONG

	perl t/test.pl DBC dbc dbc              # RIGHT!

    perl Makefile.pl	# use a perl that's in your PATH
    nmake
    nmake install

    perl Makefile.pl	# use a perl that's in your PATH
    make
    make install

	dbi-announce@perl.org          for announcements
	dbi-dev@perl.org               for developer/maintainer discussions
	dbi-users@perl.org             for end user level discussion and help

require 5.008;
use DBI;
DBI->require_version(1.39);
use DBI::DBD;
use DBI qw(:sql_types);
use Encode;
use bytes;
our $phdfltsz = 16;
our $maxbufsz = 64256;
our $maxbigbufsz = 2097100;
our $platform;
our $copyright = "Copyright(c) 2001-2007, Presicient Corporation, USA";
our ($dechi, $declo);
our $hostchars;
our $debug;
our $inited;
our $use_arm;
package DBD::Teradata;

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,
'VARBYTE', 1, 'GRAPHIC', 1, 'VARGRAPHIC', 1,
'TIMESTAMP', 6, 'TIME', 6, 'GRAPHIC', 1, 'YEAR', 2,
'MONTH', 2, 'DAY', 2, 'HOUR', 2,
'SECOND', 2, 'BLOB', 2147483648, 'CLOB', 2147483648);

our %td_type_str2basescale = (
'DEC', 0, 'DECIMAL', 0, 'YEAR', 6, 'DAY', 6, 'HOUR', 6, 'SECOND', 6);

our %td_lob_scale = (
'K', 1024,
'M', 1048576,
'G', 1073741824);

our @td_decszs = (1, 1, 1, 2, 2, 4, 4, 4, 4, 4, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8);

our %td_type_str2dbi = (
'CHAR', 1,
'VARCHAR', 12,
'BYTE', -2,
'VARBYTE', -3,
'INT', 4,
'INTEGER', 4,
'SMALLINT', 5,
'BYTEINT', -6,
'FLOAT', 6,
'DEC', 3,
'DECIMAL', 3,
'DATE', 9,
'TIMESTAMP', 11,
'INTERVAL', 11,
'GRAPHIC', -2,
'VARGRAPHIC', -3,
'TIME', 10,
'INTERVAL DAY', 103,
'INTERVAL DAY TO HOUR', 108,
'INTERVAL DAY TO MINUTE', 109,
'INTERVAL DAY TO SECOND', 110,
'INTERVAL HOUR', 104,
'INTERVAL HOUR TO MINUTE', 111,
'INTERVAL HOUR TO SECOND', 112,
'INTERVAL MINUTE', 105,
'INTERVAL MINUTE TO SECOND', 113,
'INTERVAL MONTH', 102,
'INTERVAL SECOND', 106,
'INTERVAL YEAR', 101,
'INTERVAL YEAR TO MONTH', 107,
'TIMESTAMP WITH TIME ZONE', 95,
'TIME WITH TIME ZONE', 94,
'CLOB', 40,
'BLOB', 30,
);

our %td_type_str2size = (
'CHAR', 1,
'VARCHAR', 32000,
'BYTE', 1,
'VARBYTE', 32000,
'INT', 4,
'INTEGER', 4,
'SMALLINT', 2,
'BYTEINT', 1,
'FLOAT', 8,
'DEC', 4,
'DECIMAL', 4,
'DATE', 4,
'GRAPHIC', 2,
'VARGRAPHIC', 32000,
'TIME', 8,
'TIMESTAMP', 19,
'TIMESTAMP WITH TIME ZONE', 25,
'TIME WITH TIME ZONE', 14,
'INTERVAL DAY', 1,
'INTERVAL DAY TO HOUR', 4,
'INTERVAL DAY TO MINUTE', 7,
'INTERVAL DAY TO SECOND', 10,
'INTERVAL HOUR', 1,
'INTERVAL HOUR TO MINUTE', 4,
'INTERVAL HOUR TO SECOND', 7,
'INTERVAL MINUTE', 1,
'INTERVAL MINUTE TO SECOND', 4,
'INTERVAL MONTH', 1,
'INTERVAL SECOND', 1,
'INTERVAL YEAR', 1,
'INTERVAL YEAR TO MONTH', 4);

our %td_type_str2pack = (
	'VARCHAR', 'S/a*',
	'CHAR', 'A',
	'FLOAT', 'd',
	'DEC', 'a',
	'DECIMAL', 'a',
	'INT', 'l',
	'INTEGER', 'l',
	'SMALLINT', 's',
	'BYTEINT', 'c',
	'VARBYTE', 'S/a*',
	'BYTE', 'a',
	'DATE', 'l',
	'TIMESTAMP', 'A',
	'TIME', 'A',
	'INTERVAL DAY', 'A',
	'INTERVAL DAY TO HOUR', 'A',
	'INTERVAL DAY TO MINUTE', 'A',
	'INTERVAL DAY TO SECOND', 'A',
	'INTERVAL HOUR', 'A',
	'INTERVAL HOUR TO MINUTE', 'A',
	'INTERVAL HOUR TO SECOND', 'A',
	'INTERVAL MINUTE', 'A',
	'INTERVAL MINUTE TO SECOND', 'A',
	'INTERVAL MONTH', 'A',
	'INTERVAL SECOND', 'A',
	'INTERVAL YEAR', 'A',
	'INTERVAL YEAR TO MONTH', 'A',
	'TIMESTAMP WITH TIME ZONE', 'A',
	'TIME WITH TIME ZONE', 'A',
	'CLOB', 'Q/a*',
	'BLOB', 'Q/a*',
	);

our %td_type_str2stringtypes = (
	'VARCHAR', 1,
	'CHAR', 1,
	'TIMESTAMP', 1,
	'TIME', 1,
	'INTERVAL DAY', 1,
	'INTERVAL DAY TO HOUR', 1,
	'INTERVAL DAY TO MINUTE', 1,
	'INTERVAL DAY TO SECOND', 1,
	'INTERVAL HOUR', 1,
	'INTERVAL HOUR TO MINUTE', 1,
	'INTERVAL HOUR TO SECOND', 1,
	'INTERVAL MINUTE', 1,
	'INTERVAL MINUTE TO SECOND', 1,
	'INTERVAL MONTH', 1,
	'INTERVAL SECOND', 1,
	'INTERVAL YEAR', 1,
	'INTERVAL YEAR TO MONTH', 1,
	'TIMESTAMP WITH TIME ZONE', 1,
	'TIME WITH TIME ZONE', 1,
	'CLOB', 1,
	);

our %td_type_str2binarytypes = (
	'VARGRAPHIC', 1,
	'GRAPHIC', 1,
	'VARBYTE', 1,
	'BYTE', 1,
	'BLOB', 1,
	);

our %td_type_dbi2str = (
	12, 'VARCHAR',
	1, 'CHAR',
	6, 'FLOAT',
	3, 'DECIMAL',
	4, 'INTEGER',
	5, 'SMALLINT',
	-6, 'BYTEINT',
	-3, 'VARBYTE',
	-2, 'BYTE',
	9, 'DATE',
	11, 'TIMESTAMP',
	10, 'TIME',
	103, 'INTERVAL DAY',
	108, 'INTERVAL DAY TO HOUR',
	109, 'INTERVAL DAY TO MINUTE',
	110, 'INTERVAL DAY TO SECOND',
	104, 'INTERVAL HOUR',
	111, 'INTERVAL HOUR TO MINUTE',
	112, 'INTERVAL HOUR TO SECOND',
	105, 'INTERVAL MINUTE',
	113, 'INTERVAL MINUTE TO SECOND',
	102, 'INTERVAL MONTH',
	106, 'INTERVAL SECOND',
	101, 'INTERVAL YEAR',
	107, 'INTERVAL YEAR TO MONTH',
	95, 'TIMESTAMP WITH TIME ZONE',
	94, 'TIME WITH TIME ZONE',
	);

our %td_activity_types = (
0, 'Unknown',
1, 'Select',
2, 'Insert',
3, 'Update',
4, 'Update..RETRIEVING',
5, 'Delete',
6, 'Create Table',
7, 'Modify Table',
8, 'Create View',
9, 'Create Macro',
10, 'Drop Table',
11, 'Drop View',
12, 'Drop Macro',
13, 'Drop Index',
14, 'Rename Table',
15, 'Rename View',
16, 'Rename Macro',
17, 'Create Index',
18, 'Create Database',
19, 'Create User',
20, 'Grant',
21, 'Revoke',
22, 'Give',
23, 'Drop Database',
24, 'Modify Database',
25, 'Database',
26, 'Begin Transaction',
27, 'End Transaction',
28, 'Abort',
29, 'Null',
30, 'Execute',
31, 'Comment Set',
32, 'Comment Returning',
33, 'Echo',
34, 'Replace View',
35, 'Replace Macro',
36, 'Checkpoint',
37, 'Delete Journal',
38, 'Rollback',
39, 'Release Lock',
40, 'HUT Config',
41, 'Verify Checkpoint',
42, 'Dump Journal',
43, 'Dump',
44, 'Restore',
45, 'RollForward',
46, 'Delete Database',
47, 'internal use only',
48, 'internal use only',
49, 'Show',
50, 'Help',
51, 'Begin Loading',
52, 'Checkpoint Load',
53, 'End Loading',
54, 'Insert',
64, 'Exec MLOAD',
76, '2PC Vote Request',
77, '2PC Vote and Terminate',
78, '2PC Commit',
79, '2PC Abort',
80, '2PC Yes Vote',
83, 'Set Session Rate',
84, 'Monitor Session',
85, 'Identify Session',
86, 'Abort Session',
87, 'Set Resource Rate',
89, 'ANSI Commit Work',
91, 'Monitor Virtual Config',
92, 'Monitor Physical Config',
93, 'Monitor Virtual Summary',
94, 'Monitor Physical Summary',
95, 'Monitor Virtual Resource',
96, 'Monitor Physical Resource',
97, 'Create Trigger',
98, 'Drop Trigger',
99, 'Rename Trigger',
100, 'Replace Trigger',
101, 'Alter Trigger',
103, 'Drop Procedure',
104, 'Create Procedure',
105, 'Call',
106, 'Rename Procedure',
107, 'Replace Procedure',
108, 'Set Session Account',
110, 'Monitor SQL',
111, 'Monitor Version',
112, 'Begin DBQL',
113, 'End DBQL',
114, 'Create Role',
115, 'Drop Role',
116, 'Grant Role',
117, 'Revoke Role',
118, 'Create Profile',
119, 'Modify Profile',
120, 'Drop Profile',
121, 'Set Role',
122, 'UDF',
123, 'UDF',
124, 'UDF',
125, 'UDF',
126, 'UDF',
127, 'Merge Mixed',
128, 'Merge Update',
129, 'Merge Insert',
130, 'Alter Procedure',
131, 'TDQM Enable',
132, 'TDQM Stats',
133, 'TDQM Performance Group',
);
our %td_sqlstates = qw(
2147 53018 2149 53018 2161 22012 2162 22012 2163 22012 2164 22003 2165 22003 2166 22003
2232 22003 2233 22003 2239 22003 2240 22003 2450 40001 2603 53015 2604 53015 2605 53015
2606 53015 2607 53015 2608 53015 2614 22003 2615 22003 2616 22003 2617 22003 2618 22012
2619 22012 2620 22021 2621 22012 2622 53015 2623 53015 2631 40001 2661 22000 2662 22011
2663 22011 2664 54001 2665 22007 2666 22007 2674 22003 2675 22003 2676 22012 2679 22012
2680 22023 2682 22003 2683 22003 2684 22012 2687 22012 2689 23502 2700 23700 2726 23726
2727 23727 2728 23728 2801 23505 2802 23505 2803 23505 2805 57014 2827 58004 2828 58004
2843 57014 2892 01003 2893 22001 2894 24894 2895 24895 2896 24896 2938 00000 2980 23505
3002 46000 3003 46000 3004 46000 3006 08T06 3007 08T07 3014 46000 3015 46000 3016 46000
3023 46000 3025 08T25 3026 46000 3110 00000 3111 40502 3120 58004 3121 02000 3130 57014
3504 53003 3509 54001 3513 00000 3514 00000 3515 52011 3517 52011 3518 54008 3519 52010
3520 22003 3523 42000 3524 42000 3526 52004 3527 42015 3528 22012 3529 42015 3530 42015
3532 53021 3534 52010 3535 22018 3539 52004 3540 54001 3541 57014 3543 57014 3545 42502
3554 53003 3556 54011 3560 52011 3564 44000 3568 42507 3569 56003 3574 56003 3577 57014
3580 53015 3581 53015 3582 42582 3597 54001 3604 23502 3606 52001 3609 54001 3617 42015
3622 53019 3627 42507 3628 42507 3629 54001 3637 53005 3638 57014 3639 53018 3640 53018
3641 53021 3642 53021 3643 53019 3644 53019 3653 53026 3654 53025 3656 52004 3659 53008
3660 53015 3661 57014 3662 53015 3663 53015 3669 21000 3702 54001 3704 42506 3705 54001
3710 54001 3712 54001 3714 54001 3721 24721 3731 42501 3732 0A732 3733 42514 3735 01004
3737 01004 3738 01004 3741 54001 3744 52010 3747 01003 3751 42504 3752 22003 3753 22003
3754 22003 3755 22003 3756 22012 3757 22003 3758 22003 3759 42504 3760 42503 3775 42506
3789 42514 3801 52010 3802 52004 3803 52010 3804 52010 3805 52010 3807 42000 3809 52002
3810 52003 3811 23502 3812 42000 3813 42000 3816 42505 3817 42505 3818 42505 3819 53015
3820 42505 3821 42505 3822 52002 3823 53007 3824 52004 3827 56021 3829 56021 3833 56021
3848 52006 3850 54001 3851 54001 3856 42501 3857 53015 3858 42501 3865 42501 3866 42501
3867 54001 3872 56003 3880 42501 3881 42501 3883 53003 3885 52001 3889 42514 3896 54001
3897 58004 3919 54011 3968 42968 3969 42969 3970 42970 3971 42971 3973 42973 3974 42974
3975 42975 3976 53030 3977 42977 3978 42978 3979 42979 3980 42980 3981 42981 3982 42982
3989 01001 3990 42990 3991 42991 3992 42992 3993 42993 3994 42994 3995 42995 3996 22001
3997 22019 3998 22025 3999 01999 5300 42J00 5301 42J01 5302 52009 5303 42J03 5304 42J04
5305 42J05 5306 42J06 5307 42J07 5308 42J08 5309 42J09 5310 42J10 5311 42J11 5312 42J12
5313 42J13 5314 42J14 5315 42J15 5316 44000 5317 23000 5800 01800 5801 01801 5802 01802
5803 01803 5804 01804 5805 01805 5806 01806 5807 01807 5808 01808 5809 01809 5810 01810
5811 01811 5812 01812 5813 01813 5814 01814 5815 01815 5816 01816 5817 01817 5818 01818
5819 01819 5820 01820 5821 01821 5822 01822 5823 01823 5824 01824 5825 01825 5826 01826
5827 01827 5828 01828 5829 01829 5830 01830 5831 01831 5832 01832 5833 01833 5834 01834
5835 01835 5836 01836 5837 01837 5838 01838 5839 01839 5840 01840 5841 01841 7601 20000
7610 24502 7627 21000 7631 24501 7632 02000 );
our @td_indicbits = (128, 64, 32, 16, 8, 4, 2, 1);
our @td_indicmasks = (0x7F, 0xBF, 0xDF, 0xEF, 0xF7, 0xFB, 0xFD, 0xFE);
our @td_decstrs = ( 'c', 'c', 'c', 's', 's', 'l', 'l', 'l', 'l', 'l');
our @td_decscales = ( 1.0, 1.0E-1, 1.0E-2, 1.0E-3, 1.0E-4, 1.0E-5, 1.0E-6,
	1.0E-7, 1.0E-8, 1.0E-9, 1.0E-10, 1.0E-11, 1.0E-12,
	1.0E-13, 1.0E-14, 1.0E-15, 1.0E-16, 1.0E-17, 1.0E-18);

our @td_decfactors = ( 1.0, 1.0E1, 1.0E2, 1.0E3, 1.0E4, 1.0E5, 1.0E6,
	1.0E7, 1.0E8, 1.0E9, 1.0E10, 1.0E11, 1.0E12,
	1.0E13, 1.0E14, 1.0E15, 1.0E16, 1.0E17, 1.0E18);

our %td_type_dbi2preconly = (
	1, 1,
	12, 1,
	-1, 1,
	-2, 1,
	-3, 1,
	3, 2);

our %td_type_dbi2hasprec = (
1, 1,
12, 1,
-2, 1,
-3, 1,
3, 1,
10, 1,
11, 1);

our %td_type_dbi2hasscale = (
3, 1,
110, 1,
112, 1,
113, 1,
);

our %td_type_dbi2pack = (
	12, 'S/a*',
	1, 'A',
	6, 'd',
	3, 'a',
	4, 'l',
	5, 's',
	-6, 'c',
	-3, 'S/a*',
	-2, 'a',
	-4, 'S/a*',
	9, 'l',
	11, 'A',
	10, 'A',
	103, 'A',
	108, 'A',
	109, 'A',
	110, 'A',
	104, 'A',
	111, 'A',
	112, 'A',
	105, 'A',
	113, 'A',
	102, 'A',
	106, 'A',
	101, 'A',
	107, 'A',
	95, 'A',
	94, 'A',
	);

our %td_type_dbi2size = (
	12, 32000,
	1, 32000,
	6, 8,
	3, 8,
	4, 4,
	5, 2,
	-6, 1,
	-3, 32000,
	-2, 32000,
	-4, 32000,
	9, 4,
	11, 26,
	10, 17
	);

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

our %td_type_dbi2stringtypes = (
11, 1,
10, 1,
103, 1,
108, 1,
109, 1,
110, 1,
104, 1,
111, 1,
112, 1,
105, 1,
113, 1,
102, 1,
106, 1,
101, 1,
107, 1,
95, 1,
94,  1
);

our %td_type_ddcode2str = (
);

our %td_type_str2ddcodes = (
);

use vars qw($VERSION $drh);
our $VERSION = '1.52';
$drh = undef;
my $installed = undef;
use strict ;
sub driver {
	return $drh if $drh;
	my ($class, $attr) = @_;
	$class .= '::dr';
	$drh = DBI::_new_drh($class,
		{
			Name => 'Teradata',
			Version => $VERSION,
			Attribution => 'DBD::Teradata by Presicient Corp.'
		});
	unless ($DBD::Teradata::installed) {
		DBD::Teradata::dr->install_method('tdat_FirstAvailable');
		DBD::Teradata::dr->install_method('tdat_FirstAvailList');


		DBD::Teradata::st->install_method('tdat_BindColArray');
		DBD::Teradata::st->install_method('tdat_BindParmArray');
		DBD::Teradata::st->install_method('tdat_Rewind');
		DBD::Teradata::st->install_method('tdat_Realize');
		DBD::Teradata::st->install_method('tdat_CharSet');
		DBD::Teradata::st->install_method('tdat_Unpack');

		$DBD::Teradata::installed = 1;
	}
	DBI->trace_msg("DBD::Teradata v.$VERSION loaded on $^O\n", 1);
	$drh->{_connections} = {};
	return $drh;
}
sub CLONE {
	DBD::Teradata::impl->io_clone;
	undef $drh;
}
1;
package DBD::Teradata::dr;
$DBD::Teradata::dr::imp_data_size = 0;
sub connect {
	my ($drh, $dsn, $user, $auth, $attr) = @_;
	my $host = '';
	my $port = 1025;
	$attr = {}
		unless defined $attr;
	$attr->{tdat_utility} = 'DBC/SQL'
		unless exists $attr->{tdat_utility};
	$attr->{tdat_mode} = 'DEFAULT'
		unless exists $attr->{tdat_mode};
	if ($dsn=~/^(\d+\.\d+\.\d+\.\d+)(:(\d+))?$/) {
		return $drh->DBI::set_err(-1, 'CLI does not support numeric host addresses.', '08001');
	}
	elsif ($dsn=~/^(\w[^:]*)(:(\d+))?$/) {
		($host, $port) = ($1, $3);
	}
	else {
		return $drh->DBI::set_err(-1, "Malformed dsn $dsn", '08001');
	}
	$port = 1025 unless $port;
	my ($key, $val);
	while (($key, $val) = each %$attr) {
		if ($key eq 'tdat_mode') {
			return $drh->DBI::set_err(-1, "Unknown session mode $val specified.", 'S1000')
				unless ($val=~/^(ANSI|TERADATA|DEFAULT)$/i);
		}
		elsif ($key eq 'tdat_bufsize') {
			return $drh->DBI::set_err(-1, "Bad buffer size $val. Value must be between 64000 and 2097151.", 'S1000')
				unless ($val=~/^\d+$/);
			$attr->{tdat_bufsize} = 64000 unless ($val >= 64000);
			$attr->{tdat_bufsize} = 2097151 unless ($val < 2097152);
		}
		elsif ($key eq 'tdat_respsize') {
			return $drh->DBI::set_err(-1, "Bad reponse buffer size $val. Value must be between 64000 and 2097151.", 'S1000')
				unless ($val=~/^\d+$/);
			$attr->{tdat_respsize} = 64000 unless ($val >= 64000);
			$attr->{tdat_respsize} = 2097151 unless ($val < 2097152);
		}
		elsif ($key eq 'tdat_reqsize') {
			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,
'tdat_raw_in', 1,
'tdat_raw_out', 1,
'tdat_raw', 1,
'tdat_clone', 1,
'tdat_mload', 1,
'tdat_mlseq', 1,
'tdat_mlmask', 1,
'tdat_vartext_out', 1,
'tdat_vartext_in', 1,
'tdat_charset', 1,
'tdat_passthru', 1,
'tdat_no_bigint', 1,
);
my $pmapi_loaded;
sub table_info {
	my $dbh = shift;
	return undef
		unless ($dbh->{tdat_utility} eq 'DBC/SQL');
	my $sth = $dbh->prepare(
"SELECT NULL AS TABLE_CAT,
		DATABASENAME AS TABLE_SCHEM,
		TABLENAME AS TABLE_NAME,
		CASE TABLEKIND WHEN 'I' THEN 'JOIN INDEX'
		WHEN 'V' THEN 'VIEW'
		ELSE
		(CASE WHEN UPPER(REQUESTTEXT) LIKE '% GLOBAL TEMP% TABLE %'
				THEN 'GLOBAL TEMPORARY'
				ELSE (CASE WHEN UPPER(REQUESTTEXT) LIKE '% VOLATILE TABLE %'
						THEN 'VOLATILE'
				ELSE 'TABLE' END)
				END)
		END AS TABLE_TYPE,
		COMMENTSTRING (VARCHAR(256)) AS REMARKS
		FROM DBC.TABLESX
		WHERE TABLEKIND IN ('I', 'T', 'V')
		ORDER BY 2,3");
	$sth->execute;
	return $sth;
}
sub tables {
	my $dbh = shift;
	return undef
		unless ($dbh->{tdat_utility} eq 'DBC/SQL');
	my $sth = $dbh->prepare(
"SELECT TRIM(DATABASENAME) || '.' || TRIM(TABLENAME) AS ALL_TABLES
		FROM DBC.TABLESX
		WHERE TABLEKIND IN ('I', 'T', 'V')");
	$sth->execute;
	my @tbls = ();
	my $row;
	push(@tbls, $$row[0])
		while ($row = $sth->fetchrow_arrayref);
	return @tbls;
}
sub ping {
	return $_[0]->{_iobj}->io_ping ||
		$_[0]->DBI::set_err($_[0]->{_iobj}->io_get_error());
}
sub prepare {
	my ($dbh, $stmt, $attribs) = @_;
	$attribs = {}
		unless $attribs;
	$attribs->{tdat_raw_in} = $attribs->{tdat_raw},
	$attribs->{tdat_raw_out} = $attribs->{tdat_raw}
		if $attribs->{tdat_raw};
	return $dbh->DBI::set_err(-1, 'Raw output mode not compatible with formatted mode.', 'S1000')
		if $attribs->{tdat_raw_out} && $attribs->{tdat_formatted};
	return $dbh->DBI::set_err(-1, 'Raw input mode incompatible with vartext input mode.', 'S1000')
		if $attribs->{tdat_raw_in} && $attribs->{tdat_vartext_in};
	return $dbh->DBI::set_err(-1, 'Raw output mode incompatible with vartext output mode.', 'S1000')
		if $attribs->{tdat_raw_out} && $attribs->{tdat_vartext_out};
	my $passthru = $attribs->{tdat_passthru};
	my $csth = $attribs->{tdat_clone};
	return $dbh->DBI::set_err(-1, 'tdat_clone value must be DBI statement handle.', 'S1000')
		unless (! defined($csth)) ||
			(((ref $csth eq 'DBI::st') || (ref $csth eq 'DBD::Teradata::Utility::st')));
	foreach (keys %$attribs) {
		return $dbh->DBI::set_err(-1, "Unknown statement attribute \"$_\"." , 'S1000')
			unless $valid_attrs{$_};
		return $dbh->DBI::set_err(-1, 'Invalid raw mode value.', 'S1000')
			if (($_ eq 'tdat_raw_in') || ($_ eq 'tdat_raw_out')) &&
				($attribs->{$_} ne 'RecordMode') &&
				($attribs->{$_} ne 'IndicatorMode');
	}
	my $sessno = $dbh->{tdat_sessno};
	my $iobj = $dbh->{_iobj};
	my $partition = 1;
	$stmt =~s/\n/\r/g;
	$stmt=~s/^\s+//;
	$stmt=~s/\s+$//;
	return $dbh->DBI::set_err(-1, 'Cursor syntax only supported in ANSI mode.' , 'S1000')
		if ($dbh->{tdat_mode} ne 'ANSI') && ($stmt=~/\s+FOR\s+CURSOR\s*;?$/i);
	my $compatible = $attribs->{tdat_compatible} || $dbh->{tdat_compatible};
	if ($stmt=~/^\s*HELP\s+VOLATILE\s+TABLE\s*$/i) {
		return _make_sth($dbh,
			{
			%$attribs,
			Statement => $stmt,
			tdat_stmt_info => [
				undef,
				{
					ActivityType => 'Help',
					ActivityCount => 1,
					StartsAt => 0,
					EndsAt => 1,
				}
			],
			NUM_OF_FIELDS => 2,
			NAME => [ 'Table Name', 'Table Id' ],
			TYPE => [ 1, 1 ],
			PRECISION => [ 30, 12 ],
			SCALE => [ undef, undef ],
			NULLABLE => [ undef, undef ],
			tdat_TYPESTR => [ 'CHAR(30)', 'CHAR(30)' ],
			tdat_TITLE => [ 'Table Name', 'Table Id' ],
			tdat_FORMAT =>  [ 'X(30)', 'X(12)' ],
			_unpackstr => [ 'A30 A12' ],
			NUM_OF_PARAMS => 0,
			}
		);
	}
	elsif ($stmt=~/^ECHO\b/i) {
		return _make_sth($dbh,
			{
			%$attribs,
			Statement => $stmt,
			tdat_stmt_info => [
				undef,
				{
					ActivityType => 'Echo',
					ActivityCount => 0,
					StartsAt => 0,
					EndsAt => 0,
				}
			],
			NUM_OF_FIELDS => 1,
			NAME => [ 'ECHOTEXT' ],
			TYPE => [ 12 ],
			PRECISION => [ 255 ],
			SCALE => [ undef ],
			NULLABLE => [ 0 ],
			tdat_TYPESTR => [ 'VARCHAR(255)' ],
			tdat_TITLE => [ 'Echo Text' ],
			tdat_FORMAT => [ 'X(255)' ],
			_unpackstr => [ 'A*' ],
			NUM_OF_PARAMS => 0,
			}
		);
	}
	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;
}
sub STORE {
	my ($dbh, $attr, $val) = @_;
	return $dbh->SUPER::STORE($attr, $val)
		unless ($attr eq 'AutoCommit') || ($attr =~ /^(tdat_|_)/);
	$dbh->{$attr} = $val;
	$dbh->{tdat_respsize} = $dbh->{_iobj}->io_set_respsz($val)
		if ($attr eq 'tdat_respsize');
	$dbh->{tdat_reqsize} = $dbh->{_iobj}->io_set_reqsz($val)
		if ($attr eq 'tdat_reqsize');
	$dbh->{_iobj}->io_update_version($val),
	$dbh->{tdat_versnum} = $val
		if ($attr eq 'tdat_versnum') && ($val < 6020000);
	return 1;
}
sub FETCH {
	my ($dbh, $attr) = @_;
	return $dbh->{_iobj}[23] if ($attr eq 'tdat_active');
	return $dbh->{_iobj}[11] if ($attr eq 'tdat_inxact');
	return $dbh->{$attr}
		if ($attr eq 'AutoCommit') || ($attr =~ /^(tdat_|_)/);
	return $dbh->SUPER::FETCH($attr);
}
sub tdat_SetDebug {
	$_[0]->{_iobj}[15]->cli_set_debug($_[1]);
	return $_[0];
}
sub tdat_ProcessPrepare {
	my ($dbh, $flavor, $len, $parcel, $stmtno, $activity, $is_a_call) = @_;
	my %sthargs = (
		tdat_stmt_info => [ undef ],
		NAME => [],
		TYPE => [],
		tdat_TYPESTR => [],
		PRECISION => [],
		SCALE => [],
		NULLABLE => [],
		tdat_TITLE => [],
		tdat_FORMAT => [],
		_unpackstr => [],
		_parmdesc => [ ],
		_parmap => { },
		_parmnum => 0,
		_phnum => 0
	);
	my $nextcol = $dbh->{_iobj}->io_proc_prepinfo(
		$parcel, $stmtno, \%sthargs, $activity, $is_a_call, 0);
	return $nextcol ?
		{
			Names => $sthargs{NAME},
			Types => $sthargs{tdat_TYPESTR},
			Titles => $sthargs{tdat_TITLE},
			Formats => $sthargs{tdat_FORMAT},
		} :
		{};
}
sub get_info {
	my $v = $DBD::Teradata::GetInfo::info{int($_[1])};
	$v = $v->($_[0]) if ref $v eq 'CODE';
	return $v;
}
sub type_info_all
{
	return $DBD::Teradata::TypeInfo::type_info_all;
}
1;
package DBD::Teradata::st;
use DBI qw(:sql_types);
use Config;

use DBD::Teradata qw(
	@td_decstrs
	@td_decszs
	@td_decscales
	@td_decfactors
	%td_type_dbi2stringtypes
	%td_type_dbi2pack
	%td_type_dbi2code
	@td_indicmasks
	@td_indicbits
	%td_type_dbi2str
	%td_type_dbi2hasprec
	%td_type_dbi2hasscale
	%td_type_dbi2size
);
$DBD::Teradata::st::imp_data_size = 0;

our $has_bigint;

BEGIN {

	eval {
		require Math::BigInt;
	};
	$has_bigint = 1 unless $@;
}

our %nullvals = (
	12, '',
	1, '',
	6, 0.0,
	3,'',
	4, 0,
	5, 0,
	-6, 0,
	-3, '',
	-2, '',
	-4, '',
	9, 0,
	11, '',
	10, '',
	103, '',
	108, '',
	109, '',
	110, '',
	104, '',
	111, '',
	112, '',
	105, '',
	113, '',
	102, '',
	106, '',
	101, '',
	107, '',
	95, '',
	94, ''
	);
use constant MAX_PARM_TUPLES => 2147483648;
sub cvt_dec2flt {
	my ($decstr, $prec, $scale) = @_;
	return ((unpack($td_decstrs[$prec], $decstr)) * $td_decscales[$scale])
		if ($prec <= 9);
	my @ival = ($platform == 7) ?
		unpack('l L', $decstr) : unpack('L l', $decstr);
	return ($platform == 7) ?
		((($ival[0]*(2.0**32)) + $ival[1]) * $td_decscales[$scale]) :
		(($ival[1]*(2.0**32)) + $ival[0]) * $td_decscales[$scale];
}
sub cvt_eval_dec2bigint {
	my ($decstr, $prec, $scale) = @_;
	my $num;
	if ($prec <= 9) {
		$num = unpack($td_decstrs[$prec], $decstr);
	}
	else {
		my @ival = ($platform == 7) ?
			unpack('l L', $decstr) : unpack('L l', $decstr);
		eval {
			$num = Math::BigInt->new($ival[$dechi])->blsft(32)->badd($ival[$declo])->bstr();
		};
	}
	if ($scale) {
		my $sign = undef;
		($sign, $num) = (1, substr($num, 1))
			if (substr($num, 0, 1) eq '-');
		$num = ('0' x ($scale - length($num) + 1)) . $num
			if (length($num) <= $scale);
		$num = '-' . $num if $sign;
		substr($num, -$scale, 0) = '.';
	}
	return $num;
}
sub cvt_dec2bigint {
	my ($decstr, $prec, $scale) = @_;
	my $num;
	if ($prec <= 9) {
		$num = unpack($td_decstrs[$prec], $decstr);
	}
	else {
		my @ival = ($platform == 7) ?
			unpack('l L', $decstr) : unpack('L l', $decstr);
		$num = Math::BigInt->new($ival[$dechi])->blsft(32)->badd($ival[$declo])->bstr();
	}
	if ($scale) {
		my $sign = undef;
		($sign, $num) = (1, substr($num, 1))
			if (substr($num, 0, 1) eq '-');
		$num = ('0' x ($scale - length($num) + 1)) . $num
			if (length($num) <= $scale);
		$num = '-' . $num if $sign;
		substr($num, -$scale, 0) = '.';
	}
	return $num;
}
sub cvt_flt2dec {
	my ($dval, $packed) = @_;
	my ($prec, $scale) = (($packed >> 8) & 31, $packed & 31);
	$dval = int($dval * $td_decfactors[$scale]);
	return pack($td_decstrs[$prec], $dval) if ($prec <= 9);
	my $ival1 = int($dval/(2**32));
	$ival1-- if ($dval < 0);
	my $ival2 = int($dval - ($ival1*(2.0**32)));
	return ($platform == 7) ?
		pack('l L', $ival1, $ival2) :
		pack('L l', $ival2, $ival1);
}
sub cvt_eval_bigint2dec {
	return cvt_flt2dec(@_) if ($_[0]=~/[Ee]/);
	my $dval = shift;
	my ($prec, $scale) = (($_[0] >> 8) & 31, $_[0] & 31);
	my ($whole, $part) = split /\./, $dval;
	$part = '' unless defined($part);
	my $incr = ((length($part) > $scale) && (substr($part, $scale, 1) > 4)) ?
		(($dval < 0) ? -1 : 1) : 0;
	$dval =
		(length($part) < $scale) ? join('', $whole, $part, '0' x ($scale - length($part))) :
		(length($part) > $scale) ? join('', $whole, substr($part, 0, $scale)) :
		join('', $whole, $part);
	if ($incr) {
		eval {
			$dval = Math::BigInt->new($dval)->badd($incr)->bstr();
		};
	}
	return pack($td_decstrs[$prec], $dval)
		if ($prec <= 9);
	my ($ival1, $tval, $ival2, $out);
	eval {
		$ival1 = Math::BigInt->new($dval)->brsft(32);
		$tval = Math::BigInt->new($ival1)->blsft(32);
		$ival2 = Math::BigInt->new($dval)->bsub($tval);
		$out = ($platform == 7) ?
			pack('l L', $ival1->bstr(), $ival2->bstr()) :
			pack('L l', $ival2->bstr(), $ival1->bstr());
	};
	return $out;
}
sub cvt_bigint2dec {
	return cvt_flt2dec(@_) if ($_[0]=~/[Ee]/);
	my $dval = shift;
	my ($prec, $scale) = (($_[0] >> 8) & 31, $_[0] & 31);
	my ($whole, $part) = split /\./, $dval;
	$part = '' unless defined($part);
	my $incr = ((length($part) > $scale) && (substr($part, $scale, 1) > 4)) ?
		(($dval < 0) ? -1 : 1) : 0;
	$dval =
		(length($part) < $scale) ? join('', $whole, $part, '0' x ($scale - length($part))) :
		(length($part) > $scale) ? join('', $whole, substr($part, 0, $scale)) :
		join('', $whole, $part);
	$dval = Math::BigInt->new($dval)->badd($incr)->bstr()
		if $incr;
	return pack($td_decstrs[$prec], $dval)
		if ($prec <= 9);
	my $ival1 = Math::BigInt->new($dval)->brsft(32);
	my $tval = Math::BigInt->new($ival1)->blsft(32);
	my $ival2 = Math::BigInt->new($dval)->bsub($tval);
	return ($platform == 7) ?
		pack('l L', $ival1->bstr(), $ival2->bstr()) :
		pack('L l', $ival2->bstr(), $ival1->bstr());
}
sub BindColArray {
	my ($sth, $pNum, $ary, $maxlen) = @_;
	return $sth->DBI::set_err(-1, 'BindColArray() requires arrayref parameter.', 'S1000')
		if (ref $ary ne 'ARRAY');
	return $sth->DBI::set_err(-1, 'Invalid column number.', 'S1000')
		if ($pNum <= 0);
	my $sthp = $sth->{_p};
	my $c = $sthp->[1];
	$sthp->[1] = [ ],
	$c = $sthp->[1]
		unless $c;
	$$c[$pNum - 1] = $ary;
	if (defined($maxlen)) {
		my $ml = $sthp->[14];
		$sthp->[14] = $maxlen
			unless defined($ml) && ($ml >= $maxlen);
	}
	1;
}
*tdat_BindColArray = \&BindColArray;
*bind_col_array = \&BindColArray;
sub _split_vartext {
	my ($sth, $val) = @_;
	my $params = $sth->{_p}[5];
	my $numparms = $sth->{NUM_OF_PARAMS};
	my $p = (ref $val eq 'ARRAY') ? $val : (ref $val) ? [ $$val ] : [ $val ];
	map { $params->[$_] = []; } 0..$numparms-1;
	my $plens = $sth->{_p}[9];
	@$plens = (0) x $numparms;
	my @ps;
	my $notbar = ($sth->{tdat_vartext_in} eq '|') ? undef : $sth->{tdat_vartext_in};
	foreach my $v (@$p) {
		@ps = $notbar ? split($notbar, $v) : split('\|', $v);
		foreach (0..$numparms-1) {
			push (@{$params->[$_]}, $ps[$_]);
			$plens->[$_] = length($ps[$_])
				if defined($ps[$_]) && ($plens->[$_] < length($ps[$_]));
		}
	}
	map { $sth->{ParamArrays}{$_} = $sth->{ParamValues}{$_} = $params->[$_-1]; } 1..$numparms;
	return $params;
}
sub bind_param {
	my ($sth, $pNum, $val, $attr) = @_;
	my $sthp = $sth->{_p};
	my $pname = $pNum;
	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;
	}
	return $sth->DBI::set_err(-1, 'Only parameter number 1 valid for raw or vartext mode.', 'S1000')
		if ($pNum != 1) && ($sth->{tdat_raw_in} || $sth->{tdat_vartext_in});
	my $type = 12;
	my $tlen = $phdfltsz;
	my $usephs = $sthp->[15];
	if ($usephs && defined($attr)) {
		if (ref $attr) {
			$type = $attr->{TYPE} || 12;
			$tlen = ($type == 3) ?
				((($attr->{PRECISION} || 5) << 8) | ($attr->{SCALE} || 0)) :
				($td_type_dbi2hasprec{$type} && exists $attr->{PRECISION}) ? $attr->{PRECISION} :
				$td_type_dbi2size{$type};
		}
		else {
			$type = $attr;
			$tlen = ($type == 3) ? (5 << 8) : $td_type_dbi2size{$type};
		}
	}
	$sth->{ParamValues}{$pNum} = $val;
	$sth->{ParamArrays}{$pNum} = $val;
	_split_vartext($sth, $val),
	return 1
		if $sth->{tdat_vartext_in};
	$sthp->[5][$pNum-1] = $val;
	return 1
		unless $usephs;
	my $ptypes = $sthp->[2];
	$ptypes->[$pNum-1] = $td_type_dbi2stringtypes{$type} ? 12 : $type;
	my $plens = $sthp->[9];
	$plens->[$pNum-1] =
		(($type == 12) ||
		($type == -1) ||
		($type == -4) ||
		($type == -3)) ?
			(($attr && $attr->{PRECISION}) ? $tlen :
				(defined($val) && (! ref $val)) ? length($val) : $phdfltsz) :
			$tlen;
	1;
}
*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;
	$params = &$fetch_sub()
		unless $params && scalar @$params;
	while ($params) {
		@indicvec = (0xFF) x (($fldcnt & 7) ?
			($fldcnt>>3) + 1 : $fldcnt>>3);
		$pos = 0;
		@tmpary = ();
		foreach (0..$fldcnt-1) {
			$ttype = $ptypes->[$_];
			$p = $params->[$_];
			$p = (ref $p eq 'ARRAY') ? $p->[0] : $$p
				if defined($p) && (ref $p);
			push(@tmpary, $nullvals{$ttype}),
			$pos +=
				(($ttype == 12) ||
				($ttype == -3))	? 2 : $maxszs[$_],
			next
				unless defined($p);
			$indicvec[$_>>3] &= $td_indicmasks[$_ & 7],
			push(@tmpary,
				($ttype == 3)				? $deccvt->($p, $plens->[$_]) :
				(($ttype == 6) && $use_arm) ? cvt_arm_flt($p) : $p);
			$pos +=
				(($ttype == 12) ||
				($ttype == -3))	? 2 + length($p) :
				($ttype == 3)		? $td_decszs[(($plens->[$_]>>8) & 31)] :
				$plens->[$_];
			$maxszs[$_] = length($p) + 2,
			substr($datainfo, 4 + ($_ << 2), 2, pack('S', $maxszs[$_]))
				if (($ttype == 12) || ($ttype == -3)) &&
					($maxszs[$_] < length($p) + 2);
		}
		map { $maxsz += $_; } @maxszs;
		$maxsz += scalar @indicvec;
		$indicdata = "\0" x $maxsz;
		substr($indicdata, 0, scalar(@indicvec), pack('C*', @indicvec));
		substr($indicdata, scalar(@indicvec), $pos, pack($packstr, @tmpary));
		$pos += scalar(@indicvec);
		return (++$tuples, $datainfo, substr($indicdata, 0, $pos))
			;
	}
	substr($iobj->[16], $attrs->{_datainfop}, length($datainfo), $datainfo);
	return ($tuples, undef, undef);
}
sub _process_using_params {
	my ($sth, $fldcnt, $rawmode, $modepcl, $params, $attrs) = @_;
	my $indicdata;
	my $pos = 0;
	my $maxsz = (($fldcnt & 7) ? ($fldcnt>>3) + 1 : $fldcnt>>3);
	my ($i, $k, $p);
	my $sthp = $sth->{_p};
	my $iobj = $sthp->[11];
	my $ptypes = $sthp->[2];
	my $plens = $sthp->[9];
	my $packstr = $sthp->[18];
	my $fetch_sub = $attrs->{_fetch_sub};
	my $tuples = 0;
	my $deccvt =
		($sth->{tdat_no_bigint} || (!$has_bigint)) ? \&cvt_flt2dec :
		($^O eq 'MSWin32') ? \&cvt_bigint2dec :
		\&cvt_eval_bigint2dec;
	unless ($rawmode) {
		for ($i = 0; $i < $fldcnt; $i++) {
			$maxsz += (($ptypes->[$i] == 3) ?
				$td_decszs[(($plens->[$i]>>8) & 31)] : $plens->[$i]);
			$maxsz += 2
				if ($ptypes->[$i] == 12) || ($ptypes->[$i] == -3);
		}
	}
	my @tmpary = ();
	my $ttype = 12;
	my @indicvec = ();
	$params = &$fetch_sub()
		unless $params && scalar @$params;
	my $is_vartext = $sth->{tdat_vartext_in};
	my @ps;
	my $notbar = ($is_vartext && ($is_vartext eq '|')) ? undef : $is_vartext;
	while ($params) {
		if ($is_vartext && (scalar @$params == 1)) {
			@$params = $notbar ? split($notbar, $params->[0]) : split('\|', $params->[0]);
			foreach (0..$fldcnt-1) {
				$plens->[$_] = length($params->[$_])
					if defined($params->[$_]) && ($plens->[$_] < length($params->[$_]));
			}
		}
		unless ($rawmode) {
			@indicvec = (0xFF) x (($fldcnt & 7) ? ($fldcnt>>3) + 1 : $fldcnt>>3);
			$pos = 0;
			@tmpary = ();
			foreach (0..$fldcnt-1) {
				$ttype = $ptypes->[$_];
				$p = $params->[$_];
				$p = (ref $p eq 'ARRAY') ? $p->[0] : $$p
					if defined($p) && (ref $p);
				push(@tmpary, $nullvals{$ttype}),
				$pos +=
					(($ttype == 12) ||
					($ttype == -3))	? 2 :
					($ttype == 3)		? $td_decszs[($plens->[$_] >> 8) & 31] :
						$plens->[$_],
				next
					unless defined($p);
				$indicvec[$_>>3] &= $td_indicmasks[$_ & 7],
				push(@tmpary,
					($ttype == 3)				? $deccvt->($p, $plens->[$_]) :
					(($ttype == 6) && $use_arm) ? cvt_arm_flt($p) : $p);
				$pos +=
					(($ttype == 12) ||
					($ttype == -3))	? 2 + length($p) :
					($ttype == 3)		? $td_decszs[(($plens->[$_]>>8) & 31)] :
					$plens->[$_];
					$ttype = $ptypes->[$i];
					$p = $params->[$i];
					$p = $$p
						if defined($p) && (ref $p);
			}
			$indicdata = "\0" x $maxsz;
			substr($indicdata, 0, scalar(@indicvec), pack('C*', @indicvec));
			substr($indicdata, scalar(@indicvec), $pos, pack($packstr, @tmpary));
			$pos += scalar(@indicvec);
		}
		else {
			$p = $params->[0];
			$p = (ref $p eq 'ARRAY') ? $p->[0] : $$p
				if defined($p) && (ref $p);
			$pos = length($p) - 3;
			$indicdata = substr($p, 2, $pos);
		}
		return (++$tuples, undef, substr($indicdata, 0, $pos))
		;
	}
	return ($tuples, undef, undef);
}
sub Realize {
	return defined($_[0]->{_p}[11]->io_Realize($_[0])) ?
		1 : $_[0]->DBI::set_err($_[0]->{_p}[11]->io_get_error());
}
*tdat_Realize = \&Realize;
sub tdat_Rewind {
	return $_[0]->{_p}[11]->io_rewind($_[0]);
}
sub fetch {
	return $_[0]->tdat_Unpack();
}
sub tdat_Unpack {
	my ($sth, $rec, $recmode) = @_;
	my $sthp = $sth->{_p};
	my $sessno = $sth->{tdat_sessno};
	my $stmtno = $sth->{tdat_stmt_num};
	my $nowait = $sth->{tdat_nowait};
	my $stmtinfo = $sth->{tdat_stmt_info};
	my $rawmode = $sth->{tdat_raw_out};
	my $vartext = $sth->{tdat_vartext_out};
	my $colary = $sthp->[1];
	my $maxlen = $sthp->[14];
	my $iobj = $sthp->[11];
	my $data = '';
	my @tmpary = ();
	my $ary = (defined($colary) ? ($rawmode ? $$colary[0] : \@tmpary) : undef);
	my $rc;
	if (defined($rec)) {
		$data = $rec;
		$rc = 1;
	}
	else {
		$rc = $iobj->io_fetch($sth, $ary, \$data);
		return $sth->DBI::set_err($iobj->io_get_error())
			unless defined($rc);
		$sth->{Active} = undef
			unless ($rc > 0) || $sth->{tdat_more_results};
		return $rc if ($rc <= 0);
	}
	my $loopcnt = $rc;
	my $ftypes = $sth->{TYPE};
	my $fprec = $sth->{PRECISION};
	my $fscale = $sth->{SCALE};
	my $stmthash = $$stmtinfo[$stmtno];
	my $isCall = ($stmthash->{ActivityType} eq 'Call');
	my $actends = $stmthash->{EndsAt};
	my $actstarts = $stmthash->{StartsAt};
	my $actsumstarts = $stmthash->{SummaryStarts};
	my $actsumends = $stmthash->{SummaryEnds};
	my $issum = $stmthash->{IsSummary};
	my $numflds = defined($issum) ?
		$$actsumends[$issum] - $$actsumstarts[$issum] + 1 :
		$actends - $actstarts + 1;
	my $unpackstr = $sthp->[10][
		(defined($issum) ? $$actsumstarts[$issum] : $actstarts)];
	my $ibytes = ((($numflds & 7) !=  0) ? ($numflds>>3) + 1 : $numflds>>3);
	my @row;
	$#row = $sth->{NUM_OF_FIELDS} - 1;
	if ($rawmode) {
		return $sth->_set_fbav(\@row) if defined($colary);
		$data = substr($data, $ibytes) if ($rawmode eq 'RecordMode');
		$row[0] = pack('S a* c', length($data), $data, 10);
		return $sth->_set_fbav(\@row);
	}
	my $fpos = 0;
	$tmpary[0] = $data unless defined($colary);
	my $ibit = 0;
	my $pos = 0;
	my $prec = 0;
	my $ftype = 0;
	my $indstr ='';
	my @indics = ();
	my $lastpos = 0;
	my $chopem = $sth->{ChopBlanks};
	my $no_indics = (($stmthash->{ActivityType} eq 'Exec MLOAD') ||
		$recmode || ($stmthash->{ActivityType} eq 'Echo') ||
		($iobj->[19] == 6));
	if (defined($colary)) {
		map { @$_ = (undef) x $loopcnt; } @$colary;
	}
	my $use_arm = ($Config{archname}=~/^arm-linux/i) ? 1 : undef;
	my $i;
	my $deccvt =
		($sth->{tdat_no_bigint} || (!$has_bigint)) ? \&cvt_dec2flt :
		($^O eq 'MSWin32') ? \&cvt_dec2bigint :
		\&cvt_eval_dec2bigint;
	my $utf8 = $sthp->[23]{_utf8};
	my $vtext = $sth->{tdat_vartext_out};
	for (my $k = 0; $k < $loopcnt; $k++) {
		@row = $vtext ? (('') x $sth->{NUM_OF_FIELDS}) :
			((undef) x $sth->{NUM_OF_FIELDS});
		if (ref $data) {
			$data = $tmpary[$k] if defined($colary);
			$fpos = defined($issum) ? $$actsumstarts[$issum] : $actstarts;
			$lastpos = $fpos + $numflds - 1;
			@row[$fpos..$lastpos] = @$data;
			$#row = $numflds - 1
				if ($#row < $numflds-1);
			foreach $i ($fpos..$lastpos) {
				next unless defined($row[$i]);
				$row[$i] = Encode::decode_utf8($row[$i])
					if $utf8;
				$row[$i] =~ s/\s+$//
					if $chopem;
				next if defined($vtext);
				$colary->[$i][$k] = $row[$i] if $$colary[$i];
			}
			if (defined($vtext)) {
				$row[0] = join($vtext, @row);
				$numflds--;
				@row[1..$numflds] = (undef) x $numflds;
				$numflds++;
				$colary->[0][$k] = $row[0] if $$colary[0];
			}
			next;
		}
		$data = substr($tmpary[$k], 2, length($tmpary[$k]) - 3)
			if defined($colary);
		$pos = 0;
		$indstr = substr($data, 0, $ibytes),
		$data = substr($data, $ibytes)
			unless $no_indics;
		@indics = $no_indics ? (0) : unpack('C*', $indstr);
		$unpackstr=~tr/A/a/;
		$fpos = defined($issum) ? $$actsumstarts[$issum] : $actstarts;
		splice(@row, $fpos, $numflds, unpack($unpackstr, $data));
		$#row = $sth->{NUM_OF_FIELDS} - 1
			if ($#row < $sth->{NUM_OF_FIELDS}-1);
		for (my $i = 0; $i < $numflds; $i++, $fpos++) {
			my $ftype = $$ftypes[$fpos];
			$row[$fpos] = ($vtext ? '' : undef), next
				if defined($indics[$i>>3]) &&
					($indics[$i>>3] & $td_indicbits[($i & 7)]);
			$row[$fpos] =
				$deccvt->($row[$fpos], $$fprec[$fpos], $$fscale[$fpos])
				if ($ftype == 3);
			$row[$fpos] = cvt_arm_flt($row[$fpos])
				if $use_arm && ($ftype == 6);
			if (($ftype == 1) || ($ftype == 12)) {
				$row[$fpos] = Encode::decode_utf8($row[$fpos])
					if $utf8;
				$row[$fpos] =~ s/\s+$//
					if $chopem;
			}
			next if defined($vtext);
			$colary->[$i][$k] = $row[$fpos] if $$colary[$i];
		}
		if (defined($vtext)) {
			$row[0] = join($vtext, @row);
			$numflds--;
			@row[1..$numflds] = (undef) x $numflds;
			$numflds++;
			$colary->[0][$k] = $row[0] if $$colary[0];
		}
	}
	return $rec ? \@row : $sth->_set_fbav(\@row);
}
*fetchrow_arrayref = \&fetch;
sub STORE {
	my ($sth, $attr, $val) = @_;
	return $sth->SUPER::STORE($attr, $val)
		unless ($attr=~/^(tdat)?_/) ;
	$sth->{$attr} = $val;
	return 1;
}
sub tdat_get_param_values {
	my $sth = shift;
print "we got to get_param_values\n";
	return undef unless $sth->{NUM_OF_PARAMS};
	my $sthp = $sth->{_p};
	my $numParam = $sth->{NUM_OF_PARAMS};
	my $params = $sthp->[5];
	my %pval = ();
	if ($sthp->[15]) {
		map { $pval{$_+1} = $params->[$_]; } (0..$numParam-1);
		return \%pval;
	}
	my $pnames = $sthp->[21];
	map { $pval{$pnames->[$_]} = $params->[$_]; } (0..$#$pnames);
	return \%pval;
}
sub tdat_get_param_types {
	my $sth = shift;
	return undef unless $sth->{NUM_OF_PARAMS};
	my $sthp = $sth->{_p};
	my $numParam = $sth->{NUM_OF_PARAMS};
	my $ptypes = $sthp->[2];
	my $plens = $sthp->[9];
	my $pnames = $sthp->[21];
	my $callparms = $sthp->[4];
	my $name;
	my %pval = ();
	foreach (0..$numParam-1) {
		$name = $pnames ? $pnames->[$_] : $_+1;
		$pval{$name} = {
			TYPE => ($ptypes->[$_] || SQL_UNKNOWN_TYPE),
		};
		$pval{$name}->{IN_OR_OUT} = ($callparms->[$_] & 2) ?
			(($callparms->[$_] & 4) ? 'INOUT' : 'IN') : 'OUT'
			if $callparms;
		next unless $ptypes->[$_] && $td_type_dbi2hasprec{$ptypes->[$_]};
		$pval{$name}->{PRECISION} = $plens->[$_];
		$pval{$name}->{PRECISION} = ($plens->[$_] >> 8) && 0xFF,
		$pval{$name}->{SCALE} = $plens->[$_] & 0xFF
			if ($ptypes->[$_] == 3);
	}
	return \%pval;
}
sub FETCH {
	my ($sth, $attr) = @_;
	return ($attr eq 'tdat_param_types') ?
		tdat_get_param_types($sth) : $sth->{$attr}
		if ($attr =~ /^(tdat)?_/);
	return ($attr eq 'ParamTypes') ? tdat_get_param_types($sth) :
		$sth->SUPER::FETCH($attr);
}
sub rows {
	$_[0]->{_p}[13];
}
sub finish {
	my $sthp = $_[0]->{_p};
	my $iobj = $sthp->[11];
	$iobj->io_finish($_[0]) if $iobj;
	$sthp->[22] = 1;
	$_[0]->{Active} = $sthp->[26] = undef;
	$sthp->[17] = undef;
	$sthp->[19] = -1;
	delete $_[0]->{tdat_more_results};
	$_[0]->SUPER::finish;
	1;
}
sub cancel {
	my $sthp = $_[0]->{_p};
	my $iobj = $sthp->[11];
	$iobj->io_cancel($_[0]) if $iobj;
	unless ($_[0]->{tdat_nowait}) {
		$sthp->[22] = 1;
		$_[0]->{Active} = $sthp->[26] = undef;
		$sthp->[17] = undef;
		$sthp->[19] = -1;
	}
	1;
}
sub DESTROY {
	my ($sth) = @_;
	my $sthp = $sth->{_p};
	my $dbh = $sthp->[23];
	$sth->finish
		if $sthp->[26] && (! $dbh->{_ignore_destroy});
	delete $dbh->{_stmts}{$sth->{CursorName}}
		if $sth->{CursorName};
	$sthp->[23] = undef;
	$sthp->[11] = undef;
	$sthp->[17] = undef;
	delete $sth->{_p};
}
sub tdat_CharSet {
	return $_[0]->{_p}[23]{tdat_charset};
}
sub map_type2str {
	my ($sth) = @_;
	return undef unless $sth->{NUM_OF_FIELDS};
	my $types = $sth->{TYPE};
	my $precs = $sth->{PRECISION};
	my $scales = $sth->{SCALE};
	my @typestrs = ();
	foreach my $i (0..$#$types) {
		my $type = $td_type_dbi2str{$types->[$i]};
		push (@typestrs, "DECIMAL($$precs[$i],$$scales[$i])"), next
			if ($types->[$i] == 3);
		$type=~s/\(\)([^\(]+)\(\)/\($$precs[$i]\)$1\($$scales[$i]\)/,
		push (@typestrs, $type),
		next
			if $td_type_dbi2hasscale{$types->[$i]};
		$type .= "($$precs[$i])"
			if $td_type_dbi2hasprec{$types->[$i]};
		push (@typestrs, $type);
	}
	return \@typestrs;
}
1;
package DBD::Teradata::ReqFactory;
use strict;
use warnings;
sub new {
	my $class = shift;
	my $self = {
		noprepopts => pack('SSa10', 85, 14, 'RS'),
		prepopts => pack('SSa10', 85, 14, 'RP'),
		execopts => pack('SSa10', 85, 14, 'RE'),
		indicopts => pack('SSa10', 85, 14, 'IE'),
		tsrpcl => pack('SSSC', 128, 7, 1, 1)
	};
	return bless $self, $class;
}
sub simpleRequest {
	my ($self, $iobj, $respsz) = @_;
	my $reqlen = 4 + length($_[3]) + 6;
	my $reqmsg = $iobj->io_buildtdhdr(5, $reqlen);
	return undef unless $reqmsg;
	substr($reqmsg, 52, $reqlen) =
		pack('SSA* SSS',
			1,
			4 + length($_[3]),
			$_[3],
			4,
			6,
			$respsz);
	return $reqmsg;
}
sub continueReq {
	my ($self, $iobj, $reqno, $keepresp, $respsz) = @_;
	my $reqmsg = $iobj->io_buildtdhdr(6, 6, $reqno);
	return undef unless $reqmsg;
	substr($reqmsg, 52, 6) =
		pack('SSS', ($keepresp ? 5 : 4), 6, $respsz);
	return $reqmsg;
}
sub prepareRequest {
	my ($self, $iobj, $rowid, $usingvars, $respsz) = @_;
	my $reqlen = 14 + 4 + length($_[5]) + 6;
	$reqlen += 4 + length($rowid)
		if $rowid;
	my $reqmsg = $iobj->io_buildtdhdr(5, $reqlen);
	return undef unless $reqmsg;
	my $reqpos = 52;
	substr($reqmsg, $reqpos, 14) = $usingvars ?
		$self->{prepopts} : $self->{noprepopts};
	$reqpos += 14;
	substr($reqmsg, $reqpos, 4+length($_[5])) =
		pack('SSa*', 1, 4 + length($_[5]), $_[5]);
	$reqpos += 4 + length($_[5]);
	substr($reqmsg, $reqpos, 4 + length($rowid)) =
		pack('SSA*', 120, 4 + length($rowid), $rowid),
	$reqpos += 4 + length($rowid)
		if $rowid;
	substr($reqmsg, $reqpos, 6) = pack('SSS', 4, 6, $respsz);
	return $reqmsg;
}
sub spRequest {
	my ($self, $iobj, $sz, $pos, $segment, $sth, $respsz) = @_;
	my $reqlen = 7 + 4 + $sz + 6;
	$reqlen += 6 + 14
		unless $pos;
	my $reqmsg = $iobj->io_buildtdhdr(5, $reqlen);
	return undef unless $reqmsg;
	my $bufpos = 52;
	substr($reqmsg, $bufpos, 7) =
		pack('SSSC', 128, 7, $segment, (($pos + $sz < length($sth->{Statement})) ? 0 : 1));
	$bufpos += 7;
	substr($reqmsg, $bufpos, 14) = pack('SSa10', 85, 14, 'IE'),
	$bufpos += 14
		unless $pos;
	substr($reqmsg, $bufpos, 4 + $sz) =
		pack('SSA*', 69, 4 + $sz, substr($sth->{Statement}, $pos, $sz));
	$bufpos += 4 + $sz;
	substr($reqmsg, $bufpos, 6) = pack('SSAA',
		129, 6,
		($sth->{tdat_sp_print} ? 'Y' : 'N'),
		($sth->{tdat_sp_save} ? 'Y' : 'N')),
	$bufpos += 6
		unless $pos;
	substr($reqmsg, $bufpos, 6) = pack('SSS', 4, 6, $respsz);
	$pos += $sz;
	return ($reqmsg, $pos);
}
sub sqlRequest {
	my ($self, $iobj, $sth, $forCursor, $rowid, $modepcl, $keepresp, $respsz) = @_;
	my $reqlen = 4 + length($_[8]) + 6 +
		((defined($_[9]) && length($_[9])) ? 4 + length($_[9]) : 0) +
		((defined($_[10]) && length($_[10])) ? 4 + length($_[10]) : 0) +
		($forCursor ? 4 + length($rowid) : 0) +
		($sth->{tdat_mload} ? 14 : 0);
	return $iobj->io_set_error('Request length exceeds 64K limit.')
		if ($reqlen > 64256);
	my $reqmsg = $iobj->io_buildtdhdr(5, $reqlen);
	return undef unless $reqmsg;
	my $bufpos = 52;
	my $reqpcl =
		$sth->{tdat_formatted} ? 13 :
		$sth->{tdat_mload} ? 1 :
		69;
	substr($reqmsg, $bufpos, 4 + length($_[8])) =
		pack('SSA*', $reqpcl, 4 + length($_[8]), $_[8]);
	$bufpos += 4 + length($_[8]);
	substr($reqmsg, $bufpos, 4 + length($_[9])) =
		pack('SSa*', 71, length($_[9]) + 4, $_[9]),
	$bufpos += (4 + length($_[9]))
		if defined($_[9]) && ($_[9] ne '');
	substr($reqmsg, $bufpos, 4 + length($_[10])) =
		pack('SSa*', $modepcl, length($_[10]) + 4, $_[10]),
	$bufpos += (4 + length($_[10]))
		if defined($_[10]) && ($_[10] ne '');
	substr($reqmsg, $bufpos, 4 + length($rowid)) =
		pack('SSa*', 120, length($rowid) + 4, $rowid) ,
	$bufpos += (4 + length($rowid))
		if $rowid;
	substr($reqmsg, $bufpos, 6) =
		pack('SSS', (($keepresp) ? 5 : 4), 6,
			($sth->{tdat_mload} ? 4096 : $respsz));
	return $reqmsg;
}
sub finishRequest {
	my ($self, $iobj, $kind, $reqno) = @_;
	my $reqmsg = $iobj->io_buildtdhdr($kind, 4, $reqno);
	return undef unless $reqmsg;
	substr($reqmsg, 52, 4) =
		pack('SS', ($kind == 7) ? 6 : 7, 4);
	return $reqmsg;
}
sub rewindRequest {
	my ($self, $iobj, $reqno, $respsz) = @_;
	my $reqmsg = $iobj->io_buildtdhdr(6, 10, $reqno);
	return undef unless $reqmsg;
	$respsz = 64256 if ($respsz > 64256);
	substr($reqmsg, 52, 10) =
		pack('SS SSS',
			31,
			4,
			5,
			6,
			$respsz);
	return $reqmsg;
}
1;
package DBD::Teradata::APHReqFactory;
use base('DBD::Teradata::ReqFactory');
use strict;
use warnings;
sub new {
	my $class = shift;
	my $self = {
		noprepopts => pack('SSLa10', 85 | 0x8000, 0, 18, 'RS'),
		prepopts => pack('SSLa10', 85 | 0x8000, 0, 18, 'RP'),
		execopts => pack('SSLa10', 85 | 0x8000, 0, 18, 'RE'),
		indicopts => pack('SSLa10', 85 | 0x8000, 0, 18, 'IE'),
		tsrpcl => pack('SSLSC', 128 | 0x8000, 0, 11, 1, 1)
	};
	return bless $self, $class;
}
sub simpleRequest {
	my ($self, $iobj, $respsz) = @_;
	my $reqlen = 8 + length($_[3]) + 10;
	my $reqmsg = $iobj->io_buildtdhdr(5, $reqlen);
	return undef unless $reqmsg;
	substr($reqmsg, 52, $reqlen) =
		pack('SSLA* SSLS',
			1 | 0x8000,
			0,
			8 + length($_[3]),
			$_[3],
			4 | 0x8000,
			0,
			10,
			$respsz);
	return $reqmsg;
}
sub continueReq {
	my ($self, $iobj, $reqno, $keepresp, $respsz) = @_;
	my $reqmsg = $iobj->io_buildtdhdr(6, 10, $reqno);
	return undef unless $reqmsg;
	substr($reqmsg, 52, 10) =
		pack('SSLS', ($keepresp ? 5 : 4) | 0x8000, 0, 10, $respsz);
	return $reqmsg;
}
sub prepareRequest {
	my ($self, $iobj, $rowid, $usingvars, $respsz) = @_;
	my $reqlen = 18 + 8 + length($_[5]) + 10;
	$reqlen += 8 + length($rowid)
		if $rowid;
	my $reqmsg = $iobj->io_buildtdhdr(5, $reqlen);
	return undef unless $reqmsg;
	my $reqpos = 52;
	substr($reqmsg, $reqpos, 18) = $usingvars ? $self->{prepopts} : $self->{noprepopts};
	$reqpos += 18;
	substr($reqmsg, $reqpos, 8+length($_[5])) =
		pack('SSLa*', 1 | 0x8000, 0, 8 + length($_[5]), $_[5]);
	$reqpos += 8 + length($_[5]);
	substr($reqmsg, $reqpos, 8 + length($rowid)) =
		pack('SSLA*', 120 | 0x8000, 0, 8 + length($rowid), $rowid),
	$reqpos += 8 + length($rowid)
		if $rowid;
	substr($reqmsg, $reqpos, 10) =
		pack('SSLS', 4 | 0x8000, 0, 10, $respsz);
	return $reqmsg;
}
sub sqlRequest {
	my ($self, $iobj, $sth, $forCursor, $rowid, $modepcl, $keepresp, $respsz) = @_;
	my $reqlen = 8 + length($_[8]) + 10 +
		((defined($_[9]) && length($_[9])) ? 8 + length($_[9]) : 0) +
		((defined($_[10]) && length($_[10])) ? 8 + length($_[10]) : 0) +
		($forCursor ? 8 + length($rowid) : 0) +
		($sth->{tdat_mload} ? 18 : 0);
	my $reqmsg = $iobj->io_buildtdhdr(5, $reqlen);
	return undef unless $reqmsg;
	my $bufpos = 52;
	my $reqpcl =
		$sth->{tdat_formatted} ? 13 :
		$sth->{tdat_mload} ? 1 :
		69;
	substr($reqmsg, $bufpos, 8 + length($_[8])) =
		pack('SSLA*', $reqpcl | 0x8000, 0, 8 + length($_[8]), $_[8]);
	$bufpos += 8 + length($_[8]);
	substr($reqmsg, $bufpos, 8 + length($_[9])) =
		pack('SSLa*', 71 | 0x8000, 0, length($_[9]) + 8, $_[9]),
	$bufpos += (8 + length($_[9]))
		if defined($_[9]) && ($_[9] ne '');
	substr($reqmsg, $bufpos, 8 + length($_[10])) =
		pack('SSLa*', $modepcl | 0x8000, 0, length($_[10]) + 8, $_[10]),
	$bufpos += (8 + length($_[10]))
		if defined($_[10]) && ($_[10] ne '');
	substr($reqmsg, $bufpos, 8 + length($rowid)) =
		pack('SSLa*', 120 | 0x8000, 0, length($rowid) + 8, $rowid) ,
	$bufpos += (8 + length($rowid))
		if $rowid;
	substr($reqmsg, $bufpos, 10) =
		pack('SSLS', (($keepresp) ? 5 : 4) | 0x8000, 0, 10,
		($sth->{tdat_mload} ? 4096 : $respsz));
	return $reqmsg;
}
sub finishRequest {
	my ($self, $iobj, $kind, $reqno) = @_;
	my $reqmsg = $iobj->io_buildtdhdr($kind, 8, $reqno);
	return undef unless $reqmsg;
	substr($reqmsg, 52, 8) =
		pack('SSL', 0x8000 | (($kind == 7) ? 6 : 7), 0, 8);
	return $reqmsg;
}
sub rewindRequest {
	my ($self, $iobj, $reqno, $respsz) = @_;
	my $reqmsg = $iobj->io_buildtdhdr(6, 18, $reqno);
	return undef unless $reqmsg;
	substr($reqmsg, 52, 18) =
		pack('SSL SSLS',
			31 | 0x8000,
			0,
			8,
			5 | 0x8000,
			0,
			10,
			$respsz);
	return $reqmsg;
}
1;
package DBD::Teradata::BigAPHReqFactory;
use base('DBD::Teradata::APHReqFactory');
use strict;
use warnings;
sub continueReq {
	my ($self, $iobj, $reqno, $keepresp, $respsz) = @_;
	my $reqmsg = $iobj->io_buildtdhdr(6, 12, $reqno);
	return undef unless $reqmsg;
	substr($reqmsg, 52, 12) =
		pack('SSLL', ($keepresp ? 154 : 153) | 0x8000, 0, 12, $respsz);
	return $reqmsg;
}
sub prepareRequest {
	my ($self, $iobj, $rowid, $usingvars, $respsz) = @_;
	my $reqlen = 18 + 8 + length($_[5]) + 12;
	$reqlen += 8 + length($rowid)
		if $rowid;
	my $reqmsg = $iobj->io_buildtdhdr(5, $reqlen);
	return undef unless $reqmsg;
	my $reqpos = 52;
	substr($reqmsg, $reqpos, 18) = ($usingvars) ?
		$self->{prepopts} : $self->{noprepopts};
	$reqpos += 18;
	substr($reqmsg, $reqpos, 8+length($_[5])) =
		pack('SSLa*', 1 | 0x8000, 0, 8 + length($_[5]), $_[5]);
	$reqpos += 8 + length($_[5]);
	substr($reqmsg, $reqpos, 8 + length($rowid)) =
		pack('SSLA*', 120 | 0x8000, 0, 8 + length($rowid), $rowid),
	$reqpos += 8 + length($rowid)
		if $rowid;
	substr($reqmsg, $reqpos, 12) =
		pack('SSLL', 153 | 0x8000, 0, 12, $respsz);
	return $reqmsg;
}
sub sqlRequest {
	my ($self, $iobj, $sth, $forCursor, $rowid, $modepcl, $keepresp, $respsz) = @_;
	my $reqlen = 8 + length($_[8]) + 12 +
		((defined($_[9]) && length($_[9])) ? 8 + length($_[9]) : 0) +
		((defined($_[10]) && length($_[10])) ? 8 + length($_[10]) : 0) +
		($forCursor ? 8 + length($rowid) : 0) +
		($sth->{tdat_mload} ? 18 : 0);
	my $reqmsg = $iobj->io_buildtdhdr(5, $reqlen);
	return undef unless $reqmsg;
	my $bufpos = 52;
	my $reqpcl =
		$sth->{tdat_formatted} ? 13 :
		$sth->{tdat_mload} ? 1 :
		69;
	substr($reqmsg, $bufpos, 8 + length($_[8])) =
		pack('SSLA*', $reqpcl | 0x8000, 0, 8 + length($_[8]), $_[8]);
	$bufpos += 8 + length($_[8]);
	substr($reqmsg, $bufpos, 8 + length($_[9])) =
		pack('SSLa*', 71 | 0x8000, 0, length($_[9]) + 8, $_[9]),
	$bufpos += (8 + length($_[9]))
		if defined($_[9]) && ($_[9] ne '');
	substr($reqmsg, $bufpos, 8 + length($_[10])) =
		pack('SSLa*', $modepcl | 0x8000, 0, length($_[10]) + 8, $_[10]),
	$bufpos += (8 + length($_[10]))
		if defined($_[10]) && ($_[10] ne '');
	substr($reqmsg, $bufpos, 8 + length($rowid)) =
		pack('SSLa*', 120 | 0x8000, 0, length($rowid) + 8, $rowid) ,
	$bufpos += (8 + length($rowid))
		if $rowid;
	substr($reqmsg, $bufpos, 12) =
		pack('SSLL', (($keepresp) ? 154 : 153) | 0x8000, 0, 12,
		($sth->{tdat_mload} ? 4096 : $respsz));
	return $reqmsg;
}
sub rewindRequest {
	my ($self, $iobj, $reqno, $respsz) = @_;
	my $reqmsg = $iobj->io_buildtdhdr(6, 20, $reqno);
	return undef unless $reqmsg;
	substr($reqmsg, 52, 20) =
		pack('SSL SSLL',
			31 | 0x8000,
			0,
			8,
			154 | 0x8000,
			0,
			12,
			$respsz);
	return $reqmsg;
}
1;
package DBD::Teradata::impl;
use IO::Socket;
use Socket;
use DBI qw(:sql_types);
use Time::HiRes qw(time sleep);

use DBD::Teradata 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
);

use strict;
use warnings;
my %stmt_abbrv = (
'INS', 'Insert',
'UPD','Update',
'DEL','Delete',
'CT','Create Table',
'CV','Create View',
'CD','Create Database'
);
my %rawmodes = ( 'RecordMode', 3, 'IndicatorMode', 68);
my $req_template = "\3\1" . ("\0" x 50);
my %hostcache = ();
my $has_cli = 1;
sub new {
	my ($class, $host, $port, $user, $auth, $dbname, $attrs) = @_;
	my $obj = [ ];
    bless $obj, $class;
	$obj->io_init;
	$obj->[9] = $hostchars;
	$obj->[3] = $attrs->{tdat_respsize};
	$obj->[39] = $attrs->{tdat_reqsize};
	return (undef,
		$obj->[18],
		$obj->[17],
		$obj->[24])
		unless $obj->io_connect($host, $port, $user, $auth, $dbname, $attrs);
    return ($obj, 0, '', '');
}
sub _getPclHeader {
	my ($f, $l) = unpack('SS', substr($_[0], $_[1], 4));
	return ($f & 0x8000) ?
		($f & 0x00FF, unpack('L', substr($_[0], $_[1]+4, 4)), 8) :
		($f, $l, 4);
}
sub io_init {
	my $obj = shift;
	$obj->[13] = 0;
	$obj->[2] = 0;
	$obj->[4] = 0;
	$obj->[5] = 0;
	$obj->[20] = undef;
	$obj->[3] = undef;
	$obj->[23] = 0;
	$obj->[15] = undef;
	$obj->[16] = undef;
	$obj->[32] = undef;
	$obj->[14] = 1;
	$obj->[1] = { };
	unless ($inited) {
		$debug = $ENV{TDAT_DBD_DEBUG} || 0;
		if ($debug) {
			eval {
				require DBD::Teradata::Diagnostic;
				import DBD::Teradata::Diagnostic qw(io_hexdump io_hdrdump io_pcldump);
			};
		}
		DBI->trace_msg(
"DBD::Teradata init: platform = $platform, debug = $debug,
charset = $hostchars, ph size = $phdfltsz, response buf size = $maxbufsz\n", 1);
		substr($req_template, 5, 1) = pack('C', $platform);
		substr($req_template, 37, 1) = pack('C', $hostchars);
		$inited = 1;
	}
	srand(time);
	return 1;
}
sub io_get_error {
	return ($_[0]->[18], $_[0]->[17], $_[0]->[24]);
}
sub io_set_error {
	my $obj = shift;
	($obj->[18], $obj->[17], $obj->[24]) =
		($#_ == 2) ? @_ :
		($#_ == 1) ? (@_,
			(($_[0] > 999) ?
				(exists $td_sqlstates{$_[0]} ? $td_sqlstates{$_[0]} : "T$_[0]") : 'S1000')) :
		(-1, $_[0], 'S1000');
	return undef;
}
sub io_buildtdhdr {
	my ($obj, $kind, $len, $reqno) = @_;
	return $obj->io_set_error('Large requests not supported prior to V2R5.0')
		if (($kind == 5) || ($kind == 6)) &&
			($len > 65535) && ($obj->[40] < 5000000);
	my $charset = ($kind == 1) ? 0 : $obj->[9];
	my $hostbyte = ($kind == 9) ? 1 : $platform;
	$obj->[2] = 0 if ($kind == 3);
	$obj->[2]++ if ($kind == 5) || ($kind == 8);
	my $reqmsg;
	if ($_[4]) {
		$obj->io_init_reqbuf($reqno, $len, $kind, $hostbyte, $charset, $_[4]);
	}
	else {
		$len += 52;
		$reqmsg = pack("a$len", '');
		$len -= 52;
		$obj->io_init_reqbuf($reqno, $len, $kind, $hostbyte, $charset, $reqmsg);
	}
	return $reqmsg || 1
		if ($kind == 10) || ($kind == 9);
	if ($obj->[4] == 0xffffffff) {
		$obj->[5]++;
		$obj->[4] = 0;
	}
	else { $obj->[4]++; }
	return $reqmsg || 1;
}
sub io_init_reqbuf {
	my ($obj, $reqno, $len, $kind, $hostbyte, $charset) = @_;
	substr($_[6], 0, 52) = $req_template;
	substr($_[6], 2, 1) = pack('C', $kind);
	if ($len > 65535) {
		substr($_[6], 4, 1) = pack('C', ($len >> 16) & 255);
		substr($_[6], 8, 2) = pack('n', $len & 65535);
	}
	else {
		substr($_[6], 8, 2) = pack('n', $len);
	}
	substr($_[6], 5, 1) = pack('C', $hostbyte);
	substr($_[6], 27, 11) = pack('CL N C C', 0, 1, 0, 0, 0),
	return 1
		if ($kind == 10);
	substr($_[6], 20, 4) = pack('N', $obj->[13]);
	substr($_[6], 27, 11) = pack('CN N C C',
		$obj->[5], $obj->[4],
		((($kind == 6) || ($kind == 7)) ? $reqno : $obj->[2]),
		0, $charset);
	return 1;
}
sub io_clisend {
	my $obj = shift;
	my ($reqid, $err, $errstr) =
		$obj->[15]->cli_send_request(@_, $obj->[3]);
	DBI->trace_msg("Can't send: $!\n", 1),
	$obj->[15]->cli_disconnect,
	return $obj->io_set_error($err, $errstr, '08C01')
		if $err;
	$obj->[23] = $reqid;
	return $_[0];
}
sub io_set_respsz {
	my $max = (($_[0]->[19] == 1) && ($_[0]->[40] >= 6000000)) ?
		2097152 : 64256;
	$_[0]->[3] = $_[1]
		if ($_[1]=~/^\d+$/) && ($_[1] >= 64000) && ($_[1] < $max);
	return $_[0]->[3];
}
sub io_set_reqsz {
	my $max = (($_[0]->[40] >= 6000000) ||
		(($_[0]->[19] == 1) && ($_[0]->[40] >= 5000000))) ?
		2097152 : 64256;
	$_[0]->[39] = $_[1]
		if ($_[1]=~/^\d+$/) && ($_[1] >= 256) && ($_[1] < $max);
	return $_[0]->[39];
}
sub io_update_version {
	my ($obj, $versnum) = @_;
	$obj->[38] =
		($versnum < 5000000) ? DBD::Teradata::ReqFactory->new() :
		($versnum < 6010000) ? DBD::Teradata::APHReqFactory->new() :
							DBD::Teradata::BigAPHReqFactory->new()
		if ($obj->[19] == 1);
	$obj->[40] = $versnum;
	return $obj if ($versnum >= 6000000);
	$obj->[39] = 64256
		if ($obj->[39] > 64256);
	$obj->[3] = 64256
		if ($obj->[3] > 64256);
}
sub io_tdsend {
	my ($obj, $msg, $encrypt, $keepresp) = @_;
	my $n = 0;
	if ($debug) {
		DBI->trace_msg("Sending request\n", 2);
		DBI->trace_msg(io_hdrdump('Request msg header',
			substr($msg, 0, 52)), 1);
		DBI->trace_msg(io_pcldump(
			substr($msg, 52), length($msg) - 52), 1);
	}
	if ($obj->[34] && $encrypt) {
		$msg = $obj->[34]->encrypt_request($msg);
		DBI->trace_msg(io_hdrdump('(Encrypted) Request msg header',
			substr($msg, 0, 52)), 1),
		DBI->trace_msg(io_pcldump(
			substr($msg, 52), length($msg) - 52, 1), 1)
			if $debug;
	}
	my $kind = unpack('C', substr($msg, 2, 1));
	if (($kind != 7) && ($kind != 9) && $obj->[23]) {
		my $rspmsg = '';
		return undef unless $obj->io_getcliresp;
		$obj->[14] = 0;
	}
	return $obj->io_clisend(length($msg), $keepresp, $msg)
		;
}
sub io_quicksend {
	my $obj = shift;
	my ($len, $keepresp) = @_;
	my $n = 0;
	if ($debug) {
		DBI->trace_msg("Sending request\n", 2);
		DBI->trace_msg(io_hdrdump('Request msg header', substr($_[2], 0, 52)), 1);
		DBI->trace_msg(io_pcldump(substr($_[2], 52), $len - 52), 1);
	}
	if ($obj->[23]) {
		return undef unless $obj->io_getcliresp;
		$obj->[14] = 0;
	}
	return $obj->io_clisend(@_)
		;
}
sub io_getcliresp {
	my ($obj, $sth) = @_;
	my $hdr = '';
	my $reqno = $obj->[23];
	my ($err, $errstr) =
		$obj->[15]->cli_get_response(\$hdr, $reqno,
			(defined($sth) && $sth->{tdat_keepresp}), -1);
	DBI->trace_msg($errstr),
	$obj->[15]->cli_disconnect,
	return $obj->io_set_error($err, $errstr, '08S01')
		if $err;
	DBI->trace_msg("<*** CLI Response for Request $reqno ***>\n"),
	DBI->trace_msg(io_pcldump(
		substr($hdr, 52), length($hdr) - 52), 1)
		if $debug;
	$obj->[23] = 0;
	return $obj->io_scan_response(\$hdr, $reqno);
}
sub io_scan_response {
	my ($obj, $hdr, $reqno) = @_;
	my $sth = ($obj->[1]) ?
		$obj->[1]{$reqno} : undef;
	my $islastresp;
	my $isfailed;
	my $pos = 52;
	my $rsplen = length($$hdr);
	while ($pos < $rsplen) {
		my ($f, $l, $pclhdrsz) = _getPclHeader($$hdr, $pos);
		$pos += $l;
		$islastresp = 1,
		last
			if ($f == 12);
		$isfailed = 1
			if ($f == 9);
	}
	if ($sth) {
		my $sthp = $sth->{_p};
		$sthp->[22] = $islastresp ||
			($isfailed && ($obj->[10] ne 'ANSI'));
		$sthp->[24] = $isfailed;
		if ((! $sthp->[17]) ||
			($sthp->[19] >= length($sthp->[17]))) {
			$sthp->[17] = $hdr;
			$sthp->[19] = 52;
		}
		else {
			${$sthp->[17]} .= substr($$hdr, 52);
		}
	}
	my ($f, $l, $pclhdrsz) = _getPclHeader($$hdr, 52);
	if (($f == 9) || ($f == 49)) {
		my ($tderr, $tdelen) =
			unpack('SS', substr($$hdr, 52+$pclhdrsz+4, 4));
		my $tdemsg = substr($$hdr, 52+$pclhdrsz+8, $tdelen);
		DBI->trace_msg("ERROR\: $tdemsg\n", 2);
		$obj->io_set_error($tderr, $tdemsg);
		$islastresp = ($f == 9);
	}
	$obj->[15]->cli_end_request($reqno)
		if ($islastresp || $isfailed) &&
			(! $obj->[31]{tdat_keepresp})
			;
	return $hdr;
}
sub io_ping {
	my $reqmsg = $req_template . "\0\0\0\0";
	substr($reqmsg, 2, 1) = pack('C', 9);
	substr($reqmsg, 9, 1) = "\4";
	substr($reqmsg, 52, 4) = pack('SS', 32, 4);
	return $_[0]->io_tdsend($reqmsg);
}
sub io_tddo {
	my ($obj, $dbreq, $dbdata, $outrecs) = @_;
	$obj->[18] = undef;
	my $reqmsg = $obj->[38]->simpleRequest($obj, $obj->[3], $dbreq);
	return undef unless $reqmsg;
	$obj->io_tdsend($reqmsg) or return undef;
	my $rspmsg = $obj->io_getcliresp;
	return undef
		unless $rspmsg;
	my ($f, $l, $pclhdrsz) = _getPclHeader($$rspmsg, 52);
	my $pos = 52 + $pclhdrsz;
	$obj->[11] = 0
		if ($obj->[10] ne 'ANSI') && ($f == 9);
	return undef if ($f != 8) || ($l < 4);
	my ($stmtno, $rowcnt, $warncode, $fldcount, $activity, $warnlen) =
		unpack('SLSSSS', substr($$rspmsg, $pos, 14));
	$obj->io_set_error($warncode, substr($$rspmsg, $pos + 14, $warnlen))
		if $warnlen;
	$pos += ($l - $pclhdrsz);
	($f, $l, $pclhdrsz) = _getPclHeader($$rspmsg, $pos);
	push(@$outrecs, substr($$rspmsg, $pos+$pclhdrsz, $l-$pclhdrsz)),
	$pos += $l,
	($f, $l, $pclhdrsz) = _getPclHeader($$rspmsg, $pos)
		while (($f == 10) && $outrecs);
	DBI->trace_msg("Session $obj->[13] executed $dbreq\n", 1)
		if $debug;
	return $rowcnt;
}
sub io_tdcontinue {
	my ($obj, $sth, $nowait) = @_;
		my $rspmsg;
		my ($err, $errstr) =
			$obj->[15]->cli_get_response(\$rspmsg,
				$sth->{_p}[12], $sth->{tdat_keepresp}, -1);
		return $obj->io_set_error($err, $errstr)
			if $err;
		return \$rspmsg;
}

sub io_socket {
	my ($obj, $dbsys, $port) = @_;
	my ($inetaddr, $dest, $connfd);
	my $tsys = uc $dbsys;
	$tsys=~s/cop\d+$//i;
	$inetaddr = inet_aton($tsys);

	unless ($hostcache{$tsys}) {
		my $maxcop;
		my $host;
		foreach $host (keys %ENV) {
			$maxcop = $ENV{$host}, last
				if (uc $host eq $tsys);
		}
		$maxcop = 1 unless $maxcop;
		$hostcache{$tsys} = $maxcop;
	}
	my $cop = ($hostcache{$tsys} == 1) ? 1 :
		int(rand($hostcache{$tsys})) + 1;
	$inetaddr = inet_aton($tsys . 'COP' . $cop);

	return $obj->io_set_error(-1, 'Unable to get host address.', '08001')
		unless $inetaddr;
	$dest = sockaddr_in($port, $inetaddr);
	return $obj->io_set_error(-1, 'Unable to get host address.', '08001')
		unless $dest;
	return $obj->io_set_error(-1, "Unable to allocate a socket: $!.", '08001')
		unless socket($connfd, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
	close($connfd),
	return $obj->io_set_error(-1, "Unable to connect: $!", '08001')
		unless connect($connfd, $dest);
	setsockopt($connfd, SOL_SOCKET, SO_KEEPALIVE, pack('l', 1));
	$obj->[15] = $connfd;
	return $connfd;
}

sub io_getconfig {
	my ($obj, $dbsys, $port, $attr) = @_;
	$obj->[18] = -1;
	$obj->[24] = 'S1000';
	$obj->[17] = '';
	my $c;
	my $r = 3;
	$r-- until ($r == 0) || ($c = $obj->io_socket($dbsys, $port));
	return undef unless $c;
	$obj->[4] = int(rand(time()))+1;
	$obj->[5] = 0;
	$obj->[40] = 0;
	my $cfgpos = 52;
	my $cfgreq = $obj->io_buildtdhdr(10, 0);
	if ($debug) {
		DBI->trace_msg("Sending request\n", 2);
		DBI->trace_msg(io_hdrdump('Request msg header', substr($_[2], 0, 52)), 1);
	}
	my $n = send($c, $cfgreq, 0);
	DBI->trace_msg("Can't send: $!\n", 1),
	close($c),
	return $obj->io_set_error(-1, 'System error: unable to send', '08C01')
		unless defined($n);

	DBI->trace_msg("Only sent $n bytes!\n", 1),
	close($c),
	return $obj->io_set_error(-1, 'System error: unable to send', '08C01')
		if ($n != 52);

	DBI->trace_msg("Request sent\n", 2) if $debug;

	my $rspmsg = '';
	my $hdrlen = 0;
	my $rsplen = 8192;
	my $hdr = '';

	DBI->trace_msg("Rcving Header\n", 2) if $debug;

	while ($hdrlen < 52) {
		unless (recv($c, $rspmsg, $rsplen, 0)) {
			DBI->trace_msg(
"System error: can't recv msg header $!;\n rcvd $hdrlen bytes.\n", 2),
			close($c),
			return $obj->io_set_error(-1,
				"System error: can't recv msg header $!; closing connection.", '08S01')
				unless defined($rspmsg) && ($rspmsg ne '');
		}
		$hdr .= $rspmsg;
		$hdrlen += length($rspmsg);
	}
	DBI->trace_msg(io_hdrdump('Response msg header', substr($hdr, 0, 52)), 1) if $debug;
	my ($tdver, $tdclass, $tdkind, $tdenc, $tdchksum, $tdbytevar,
		$tdwordvar, $tdmsglen) = unpack('C6Sn', $hdr);

	DBI->trace_msg("Invalid response message header; closing connection.", 2),
	close($c),
	return $obj->io_set_error(-1, 'Invalid response message header; closing connection.', '08S01')
		if ($tdver !=  3) || ($tdclass !=  2);
	$tdmsglen -= ($hdrlen - 52) if ($hdrlen > 52);
	$hdr .= "\0" x $tdmsglen if ($tdmsglen > 0);
	my $lrspmsg = 0;
	while ($tdmsglen > 0) {
		unless (recv($c, $rspmsg, $tdmsglen, 0)) {

			$hdrlen = length($rspmsg),
			DBI->trace_msg(
		"System error: can't recv msg body$!;\n rcvd $hdrlen bytes.\n", 2),
			close($c),
			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;
	$obj->io_tddo("DATABASE $dbname", '')
		if $dbname;
	return $obj->[13];
}
sub io_disconnect {
	my ($obj) = @_;
	unless ($obj->[31]{_logged_off}) {
			$obj->[15]->cli_disconnect();
		$obj->[15] = undef;
		DBI->trace_msg("Logged off session $obj->[13]\n", 1) if $debug;
	}
	$obj->[1] = undef;
	$obj->[31] = undef;
	$obj->[18] = undef;
	$obj->[17] = undef;
	$obj->[24] = undef;
	return 1;
}
sub io_parse_using {
	my ($req, $typeary, $typelen, $ipackstr, $nameary) = @_;
	$$ipackstr = '';
	my $remnant = ', ' . uc $req;
	while ($remnant=~/^\s*,\s*(\w+)\s+((DOUBLE\s+PRECISION)|CHARACTER|TIMESTAMP|INTERVAL|VARCHAR|VARBYTE|GRAPHIC|DECIMAL|NUMERIC|SMALLINT|BYTEINT|INTEGER|FLOAT|CHAR|BYTE|REAL|DATE|TIME|INT|DEC)(.*)$/i) {
		my $name = uc $1;
		my $vtype = uc $2;
		$remnant = $4;
		$vtype = 'FLOAT' if ($vtype=~/^(DOUBLE\s+PRECISION)|REAL$/i);
		$vtype = 'DEC' if ($vtype=~/^DECIMAL|NUMERIC/i);
		$vtype = 'CHAR' if ($vtype eq 'CHARACTER');
		$vtype = 'INT' if ($vtype eq 'INTEGER');
		push @$nameary, $name;
		my ($prec, $scale);
		unless ($vtype=~/^INTERVAL|DEC|TIME|TIMESTAMP$/i) {
			push(@$typeary, $td_type_str2dbi{$vtype}),
			push(@$typelen, $td_type_str2size{$vtype}),
			$remnant=~s/^[^,]+(,.*)$/$1/,
			next
				unless defined($td_type_str2baseprec{$vtype});
			$prec = $td_type_str2baseprec{$vtype};
			if ($remnant && ($remnant=~/^\s*\(\s*(\d+)\s*\)(.*)$/)) {
				$prec = $1;
				$remnant = $2;
			}
			push @$typeary, $td_type_str2dbi{$vtype};
			push @$typelen, $prec;
			$remnant=~s/^[^,]+(,.*)$/$1/;
			next;
		}
		if (($vtype eq 'TIMESTAMP') || ($vtype eq 'TIME')) {
			$prec = $td_type_str2baseprec{$vtype};
			if ($remnant && ($remnant=~/^(\s*\(\s*(\d+)\s*\))?(\s+WITH\s+TIME\s+ZONE)?(.*)$/)) {
				$prec = $2 if defined($1);
				$vtype .= ' WITH TIME ZONE' if defined($3);
				$remnant = $4;
			}
			push @$typeary, $td_type_str2dbi{$vtype};
			push @$typelen, $td_type_str2size{$vtype} + ($prec ? 1 + $prec : 0);
			$remnant=~s/^[^,]+(,.*)$/$1/;
			next;
		}
		elsif ($vtype eq 'DEC') {
			$prec = $td_type_str2baseprec{DEC};
			$scale = $td_type_str2basescale{DEC};
			if ($remnant && ($remnant=~/^\s*\(\s*(\d+)\s*(,\s*(\d+)\s*)?\)(.*)$/)) {
				$prec = $1;
				$scale = $3 if defined($2);
				$remnant = $4;
			}
			push @$typelen, (($prec * 256) + $scale);
			push @$typeary, $td_type_str2dbi{'DEC'};
			$remnant=~s/^[^,]+(,.*)$/$1/;
			next;
		}
		return undef
			unless $remnant && ($remnant=~/^\s*(YEAR|MONTH|DAY|HOUR|MINUTE|SECOND)(.*)$/);
		my $intvl = $1;
		$remnant = $2;
		$prec = $td_type_str2baseprec{$intvl};
		$scale = 0;
		if ($intvl eq 'SECOND') {
			if ($remnant && ($remnant=~/^\s*\(\s*(\d+)(\s*,\s*(\d+))?\s*\)(.*)$/)) {
				$prec = $1;
				$scale = defined($3) ? $3 : 6;
				$remnant = $4;
			}
			push @$typelen,
			$td_type_str2size{"INTERVAL SECOND"} + $prec + ($scale ? $scale + 1 : 0);
			push @$typeary, $td_type_str2dbi{"INTERVAL SECOND"};
			$remnant=~s/^[^,]+(,.*)$/$1/;
			next;
		}
		push(@$typelen, $td_type_str2size{"INTERVAL $intvl"} + $prec),
		push(@$typeary, $td_type_str2dbi{"INTERVAL $intvl"}),
		$remnant=~s/^[^,]+(,.*)$/$1/,
		next
			unless $remnant &&
				($remnant=~/^(\s*\(\s*(\d+)\s*\))?(\s+TO\s+(MONTH|HOUR|MINUTE|(SECOND(\s*\(\s*(\d+)\s*\))?)))?(.*)$/) &&
				(defined($1) || defined($3));
		$vtype = defined($3) ? defined($5) ? "INTERVAL $intvl TO SECOND" :
			"INTERVAL $intvl TO $4" : "INTERVAL $intvl";
		$prec = $2 if defined($1);
		$scale = defined($5) ? (defined($7) ? $7 : $td_type_str2basescale{SECOND}) : 0;
		push @$typelen, $td_type_str2size{$vtype} + $prec + ($scale ? 1 + $scale : 0);
		push @$typeary, $td_type_str2dbi{$vtype};
		$remnant=~s/^[^,]+(,.*)$/$1/;
	}
	my $prec = 0;
	my $i = 0;
	my $pstr;
	$$ipackstr = '';
	while ($i < scalar(@$typeary)) {
		$prec = ($$typeary[$i] == 3) ?
			$td_decszs[($$typelen[$i] >> 8) & 31] : $$typelen[$i];
		$pstr = $td_type_dbi2pack{$$typeary[$i]};
		$$ipackstr .= " $pstr";
		$$ipackstr .= $prec if (uc $pstr eq 'A') || ($pstr eq 'U');
		$i++;
	}
	return scalar @$typeary;
}
sub io_parse_call {
	my ($obj, $stmt, $parmdesc) = @_;
	return undef unless ($stmt=~/^\s*CALL\s+([^\s\(]+)\s*(\(.+\))?\s*;?$/i);
	my ($spname, $parmList) = (uc $1, $2);
	$parmList=~s/^\((.+)\)$/$1/;
	$parmList=~s/^\s+//;
	$parmList=~s/\s+$//;
	if ($parmList ne '') {
		$parmList=~s/DEC(IMAL)?\s*\(\s*(\d+)\s*,\s*(\d+)\s*\)/DEC($2;$3)/ig;
		my $phCount = ($parmList=~tr/\?//);
		my @parmAry = split(',', $parmList);
		for (my $i = 0; $i <= $#parmAry; $i++) {
			$parmAry[$i]=~s/;/,/g;
			$parmAry[$i]=~s/^\s+//;
			$parmAry[$i]=~s/\s+$//;
			$$parmdesc[$i] = 3, next
				if ($parmAry[$i]=~/(\?|\:\w+)/);
			$$parmdesc[$i] = 4, next
				if (uc $parmAry[$i] ne 'NULL') && ($parmAry[$i]=~/^[_A-Za-z]\w+/);
			$$parmdesc[$i] = 2;
		}
	}
	1;
}
sub io_prepare {
	my ($obj, $dbh, $make_sth, $dbreq, $rowid, $attribs, $compatible, $passthru) = @_;
	$compatible = '999.0' unless defined $compatible;
	my @ptypes = ();
	my @plens = ();
	my $usephs = 0;
	my @usenames = ();
	my @stmtinfo = (undef);
	my $ipackstr = '';
	$obj->[18] = 0;
	$obj->[24] = '00000';
	$obj->[17] = '';
	my $tmpreq = $dbreq;
	$tmpreq=~s/\s+WHERE\s+CURRENT\s+OF\s+[^\s;]+(\s*;)?\s*$/ WHERE CURRENT/ig;
	$tmpreq =~s/'[^']+'/''/g;
	$tmpreq=~s/\-\-.*\r/ /g;
	$tmpreq=~s/\/\*.*?\\*\// /g;
	my $datainfo = '';
	$ipackstr = '';
	$usephs = ($tmpreq =~ tr/\?//);
	return $obj->io_set_error('Placeholders not supported for utility applications.')
		if $usephs && (($obj->[19] != 1) || $obj->[20]);
	my $usingvars = 0;
	$tmpreq = uc $2,
	$usingvars = io_parse_using($1, \@ptypes, \@plens, \$ipackstr, \@usenames)
		if ($tmpreq=~/^USING\s*\((.+)\)\s*((SELECT|EXECUTE|LOCKING|IGNORE|INSERT|UPDATE|DELETE|MERGE|ABORT|EXEC|LOCK|MARK|CALL|INS|UPD|SEL|DEL|DO)\s+(.+))$/i);
	return $obj->io_set_error('Invalid USING clause.')
		if ($usingvars == -1);
	return $obj->io_set_error('Can\'t mix USING clause and placeholders in same statement.')
		if ($usephs > 0) && ($usingvars > 0);
	if ($usephs) {
		@ptypes = ((12) x $usephs);
		@plens = (($phdfltsz) x $usephs);
		$ipackstr = 'S/a* ' x $usephs;
	}
	unless ($compatible lt '2.1') {
		$tmpreq = $9
			while ($tmpreq=~/^LOCK(ING)?(((\s+TABLE|DATABASE|VIEW)?\s+\S+)|ROW|)(\s+(FOR|IN))?\s+\S+(\s+MODE)?(\s+NOWAIT)?\s+(.+)$/i);
		my @s = split(';', $tmpreq);
		my $i = 1;
		my $t;
		foreach $t (@s) {
			last unless ($t=~/^\s*(DATABASE|COLLECT|REPLACE|MODIFY|REVOKE|UPDATE|INSERT|DELETE|CREATE|MERGE|ALTER|GRANT|DROP|GIVE|UPD|INS|DEL|[CRD][TVMP]|SET)\s+(VOLATILE\s+|GLOBAL\s+TEMPORARY\s+)?(MULTISET\s+|SET\s+)?(\S+)(\s+(\S+))?/i);
			my ($keywd, $keytyp, $keyqual) = (uc $1, uc $4, uc $6);
			last
				if (($keywd eq 'REPLACE') || ($keywd eq 'CREATE')) &&
					(($keytyp eq 'MACRO') || ($keytyp eq 'PROCEDURE'));
			$stmtinfo[$i]->{ActivityType} =
				(($keywd eq 'SET') || ($keytyp eq 'JOIN') || ($keytyp eq 'HASH')) ?
					join(' ', ucfirst (lc $keywd), ucfirst(lc $keytyp), ucfirst(lc $keyqual)) :
				(($keywd=~/^CREATE|DROP|RENAME|REPLACE|ALTER|COLLECT|MODIFY$/) ||
					(($keywd eq 'DELETE') && (($keytyp eq 'DATABASE') || ($keytyp eq 'JOURNAL')))) ?
					ucfirst (lc $keywd) . ' ' . ucfirst(lc $keytyp) :
				exists $stmt_abbrv{$keywd} ?
					$stmt_abbrv{$keywd} :
					ucfirst(lc $keywd);
			$stmtinfo[$i]->{ActivityCount} = 0;
			$i++;
		}
		return &$make_sth(
			$dbh,
			{
			%$attribs,
			Statement => $dbreq,
			tdat_stmt_info => \@stmtinfo,
			NUM_OF_FIELDS => 0,
			NUM_OF_PARAMS => (($usingvars > 0) ? $usingvars : $usephs),
			_ptypes => \@ptypes,
			_plens => \@plens,
			_packstr => $ipackstr,
			_usenames => \@usenames,
			_usephs => $usephs
			}
		)
			if ($i > $#s+1);
	}
	@stmtinfo = (undef);
	my @parmdesc = ();
	my ($parmnum, $phnum) = (0,0);
	my $is_a_call = undef;
	if ($tmpreq=~/^\s*CALL\s+/i) {
		return undef
			unless $obj->io_parse_call($tmpreq, \@parmdesc);
		$is_a_call = 1;
	}
	my $reqmsg = $obj->[38]->prepareRequest($obj, $rowid,
		$usingvars, $obj->[3], $dbreq);
	return $obj->io_set_error('System error: can\'t send() PREPARE request.')
		unless $obj->io_quicksend(length($reqmsg), undef, $reqmsg);
	my $rspmsg = $obj->io_getcliresp;
	return undef unless $rspmsg ;
	my $rsplen = length($$rspmsg);
	$$passthru = $$rspmsg
		if defined($passthru);
	my ($f, $l, $tderr, $tdelen);
	my ($stmtno, $rowcnt, $warncode, $fldcount, $activity, $warnlen, $pcl);
	my $nextcol = 0;
	my $curpos = 52;
	my $pclhdrsz = 4;
	my %sthargs = (
		%$attribs,
		Statement => $dbreq,
		tdat_stmt_info => [ undef ],
		NAME => [],
		TYPE => [],
		PRECISION => [],
		SCALE => [],
		NULLABLE => [],
		tdat_TYPESTR => [],
		tdat_TITLE => [],
		tdat_FORMAT => [],
		_unpackstr => [],
		_ptypes => \@ptypes,
		_plens => \@plens,
		_packstr => $ipackstr,
		_usenames => \@usenames,
		_usephs => $usephs,
		_parmdesc => \@parmdesc,
		_parmmap => {},
		_parmnum => \$parmnum,
		_phnum => \$phnum,
	);
	my $stmtinfo = $sthargs{tdat_stmt_info};
	while ($curpos < $rsplen) {
		($f, $l, $pclhdrsz) = _getPclHeader($$rspmsg, $curpos);
		$curpos += $l , next
			if (($f == 11) || ($f == 12));
		if ($f == 8) {
			($stmtno, $rowcnt, $warncode, $fldcount, $activity, $warnlen) =
				unpack('SLSSSS', substr($$rspmsg, $curpos+$pclhdrsz, 14));
			$stmtinfo->[$stmtno]{ActivityType} = ($td_activity_types{$activity}) ?
				$td_activity_types{$activity} : 'Unknown';
			$stmtinfo->[$stmtno]{ActivityCount} = $rowcnt;
			$sthargs{tdat_unpackstr}[$nextcol] = '';
			$stmtinfo->[$stmtno]{Warning} = "Warning $warncode: " .
				substr($rspmsg, 18, $warnlen)
				if $warnlen;
			$curpos += $l;
			next;
		}
		if (($f == 9) || ($f == 49)) {
			($stmtno, $rowcnt, $tderr, $tdelen) =
				unpack('SSSS', substr($$rspmsg, $curpos+$pclhdrsz, 8));
			my $tdemsg = substr($$rspmsg, $curpos+$pclhdrsz+8, $tdelen);
			DBI->trace_msg("ERROR $tderr\: $tdemsg\n", 2);
			$obj->io_set_error($tderr,
				(($f == 9) ? 'Failure' : 'Error') .
					" $tderr\: $tdemsg on Statement $stmtno.");
			$stmtinfo->[$stmtno]{SummaryStarts} =
				$stmtinfo->[$stmtno]{SummaryEnds} =
				$stmtinfo->[$stmtno]{StartAt} =
				$stmtinfo->[$stmtno]{EndsAt} = undef;
			return undef;
		}
		return $obj->io_set_error("Invalid parcel stream: got $f when PREPINFO expected.")
			if ($f != 86);
		$nextcol = $obj->io_proc_prepinfo(
			substr($$rspmsg, $curpos+$pclhdrsz, $l - $pclhdrsz),
			$stmtno, \%sthargs, $activity, $is_a_call, $nextcol);
		$curpos += $l;
	}
	DBI->trace_msg("Session $obj->[13] PREPAREd $dbreq\n", 1)
		if $debug;
	$$passthru = undef
		if defined($passthru);
	$sthargs{NUM_OF_FIELDS} = scalar @{$sthargs{NAME}};
	$sthargs{NUM_OF_PARAMS} = $usingvars || $usephs;
	return &$make_sth($dbh, \%sthargs);
}
sub io_proc_prepinfo {
	my ($obj, $pcl, $stmtno, $sthargs, $activity, $is_a_call, $nextcol) = @_;
	my $curpos = 0;
	my ($sumcnt, $colcnt) = unpack('SS', substr($pcl, 8, 4));
	my $packstr = '';
	my $stmtinfo = $sthargs->{tdat_stmt_info}[$stmtno];
	$stmtinfo->{StartsAt} = $stmtinfo->{StartsAt} = undef,
	return $nextcol
		unless $colcnt || $sumcnt;
	my ($phnum, $parmnum, $parmdesc, $parmmap) =
		($sthargs->{_phnum}, $sthargs->{_parmnum}, $sthargs->{_parmdesc}, $sthargs->{_parmmap});
	my ($datatype, $datalen, $cname, $cfmt, $ctitle);
	$curpos += 12;
	$stmtinfo->{StartsAt} = $nextcol;
	$stmtinfo->{EndsAt} = $nextcol + $colcnt - 1;
	my $nextsum = 0;
	$stmtinfo->{SummaryStarts} = [ 0 ],
	$stmtinfo->{SummaryEnds} = [ 0 ]
		if $sumcnt;
	while (1) {
		for (my $i = 0; $i < $colcnt; $i++, $nextcol++) {
			($datatype, $datalen, $cname, $cfmt, $ctitle) =
				unpack('SS S/a S/a S/a', substr($pcl, $curpos));
			$curpos += (4 +
				2 + length($cname) +
				2 + length($cfmt) +
				2 + length($ctitle));
			if ($activity == 105) {
				$datatype -= 500;
				if ($is_a_call) {
					$$phnum++
						if ($$parmdesc[$$parmnum] & 1);
					$$parmnum++,
					$nextcol--,
					next
						unless ($datatype & 3);
					$$parmdesc[$$parmnum] |= 4;
					$$parmmap{$$phnum} = $nextcol
						if ($$parmdesc[$$parmnum] & 1);
					$$parmnum++;
					$stmtinfo->{EndsAt} = $nextcol;
				}
				$datatype &= 0xfffc;
			}
			$sthargs->{NAME}[$nextcol] = ($cname eq '') ?
				(($ctitle eq '') ? "COLUMN$nextcol" : $ctitle) :
				$cname;
			my $ttype = $sthargs->{TYPE}[$nextcol] =
				$td_type_code2dbi{$datatype & 0xfffe};
			$sthargs->{NULLABLE}[$nextcol] = ($activity == 105) ?
				1 : $datatype & 1;
			$sthargs->{tdat_TITLE}[$nextcol] = $ctitle;
			$cfmt = uc $cfmt;
			$cfmt = '-(' . (length($1) + 1) . ")$2"
				if ($cfmt=~/^(-+)(.*)/);
			$sthargs->{tdat_FORMAT}[$nextcol] = $cfmt;
			my $prec = $sthargs->{PRECISION}[$nextcol] = ($ttype == 3) ?
				(($datalen >> 8) & 31) : $datalen;
			my $scale = $sthargs->{SCALE}[$nextcol] = ($ttype == 3) ?
				($datalen & 255) : 0;
			my $len = ($ttype == 3) ? $td_decszs[$prec] : $datalen;
			$packstr .=
				(($ttype == -2) || ($ttype == 3)) ? "a$len " :
				(($ttype == 1)								? "A$len " :
					($td_type_dbi2pack{$ttype}) . ' ');
			$sthargs->{tdat_FORMAT}[$nextcol] = "6($prec)"
				if ($ttype == -2) || ($ttype == -3);
			my $typestr = $td_type_dbi2str{$ttype};
			$typestr .= '(' . $prec .
				(($ttype == 3) ? ", $scale)" : ')')
				if $td_type_str2baseprec{$typestr};
			$sthargs->{tdat_TYPESTR}[$nextcol] = $typestr;
			DBI->trace_msg(
				($ttype != 3) ?
		"$sthargs->{NAME}[$nextcol]\: $ttype LENGTH $prec\n" :
		"$sthargs->{NAME}[$nextcol]\: DECIMAL($prec, $scale) LENGTH $td_decszs[$len]\n",
					1)
				if $debug;
		}
		my $packidx = $nextsum ? $stmtinfo->{SummaryStarts}[$nextsum - 1] : $stmtinfo->{StartsAt};
		$packstr=~s/\*//g;
		$sthargs->{_unpackstr}[$packidx] = $packstr;
		$packstr = '';
		last unless $sumcnt;
		$colcnt = unpack('S', substr($pcl, $curpos));
		$stmtinfo->{SummaryStarts}[$nextsum] = $nextcol;
		$stmtinfo->{SummaryEnds}[$nextsum] = $nextcol + $colcnt - 1;
		$nextsum++;
		$curpos += 2;
		$sumcnt--;
	}
	return $nextcol;
}
sub io_execute {
	my ($obj, $sth, $datainfo, $indicdata, $rowid) = @_;
	$obj->[18] = 0;
	$obj->[24] = '00000';
	$obj->[17] = '';
	my $stmtinfo = $sth->{tdat_stmt_info};
	my $stmtno = $sth->{tdat_stmtno};
	my $nowait = $sth->{tdat_nowait};
	my $stmt = $sth->{Statement} || '';
	my $keepresp = ($sth->{tdat_keepresp} || ($stmt=~/\s+FOR\s+CURSOR\s*$/i));
	my $rawmode = $sth->{tdat_raw_in};
	my $reqmsg = '';
	my $reqlen = 0;
	my $modepcl = ($rawmode && defined($rawmodes{$rawmode})) ?
		$rawmodes{$rawmode} : 68;
	my $partition = $obj->[19];
	my $reqfac = $obj->[38];
	$stmt=~s/\s+WHERE\s+CURRENT\s+OF\s+([^\s;]+)\s*;?\s*$/ WHERE CURRENT/i;
	my $forCursor = ($stmt=~/\s+WHERE\s+CURRENT$/i) && $rowid;
	if (($partition == 1) ||
		(($partition == 6) && ($stmt ne ';'))) {
		$reqlen = 4 + length($stmt) + 6 +
			((defined($datainfo) && length($datainfo)) ? 4 + length($datainfo) : 0) +
			((defined($indicdata) && length($indicdata)) ? 4 + length($indicdata) : 0) +
			($forCursor ? 4 + length($rowid) : 0) +
			($sth->{tdat_mload} ? 14 : 0);
		if ($reqlen > 65535) {
			$reqlen += 4 + 4 + (length($datainfo) ? 4 : 0) +
				(length($indicdata) ? 4 : 0) + (($forCursor && $rowid) ? 4 : 0);
			$obj->[26] = 1;
		}
		else {
			$obj->[26] = undef;
		}
	}
	if ($sth->{Statement}=~/^\s*(CREATE|REPLACE)\s+PROCEDURE\s+/i) {
		my $pos = 0;
		my $segment = 1;
		my $len = length($sth->{Statement});
		my $sz = 0;
		while ($len) {
			$sz = ($len > 64000) ? 64000 : $len;
			$len -= $sz;
			($reqmsg, $pos) = $reqfac->spRequest($obj, $sz, $pos, $segment, $sth, $obj->[3]);
			$segment++;
			my $treqno = $obj->[2];
			$obj->io_quicksend(length($reqmsg), undef, $reqmsg) or return undef;
			$obj->[1]{$treqno} = $sth;
			$sth->{_p}[12] = $treqno;
			last unless $len;
			return undef unless defined($obj->io_Realize($sth));
		}
		return ($nowait ? -1 : $obj->io_Realize($sth));
	}
	return $obj->io_set_error('Maximum request size exceeded.')
		if ($obj->[40] < 5000000) && ($reqlen > 65535);
	if ($partition == 1) {
		$reqmsg = $reqfac->sqlRequest($obj, $sth, $forCursor, $rowid, $modepcl, $keepresp,
			$obj->[3], $stmt, $datainfo, $indicdata);
	}
	delete $obj->[1]{$_}
		foreach (keys %{$obj->[1]});
	my $treqno = $obj->[2];
	if (($partition == 5) || ($partition == 4)) {
		$obj->io_quicksend($obj->[32], undef, $obj->[16])
			or return undef;
	}
	else {
		$obj->io_tdsend($reqmsg) or return undef;
	}
	$obj->[1]{$treqno} = $sth;
	$sth->{_p}[12] = $treqno;
	return ($nowait) ? -1 : $obj->io_Realize($sth);
}
sub io_fetch {
	my ($obj, $sth, $ary, $retstr) = @_;
	$obj->[18] = 0;
	$obj->[24] = '00000';
	$obj->[17] = '';
	my $sthp = $sth->{_p};
	return 0 unless $sthp->[17];
	my $maxlen = ($ary) ? $sthp->[14] : 1;
	my $stmtno = $sth->{tdat_stmt_num};
	my ($f, $l, $failed) = (0,0,0,0);
	my $rspmsg = $sthp->[17];
	my $pos = $sthp->[19];
	my $rsplen = ($$rspmsg) ? length($$rspmsg) : 0;
	my $partition = $obj->[19];
	my $stmtinfo = $sth->{tdat_stmt_info};
	my $stmthash = ($stmtno) ? $$stmtinfo[$stmtno] : undef;
	my $endstmt = 0;
	my $total_activity = 0;
	my $arycnt = 0;
	if ($pos >= $rsplen) {
		$rspmsg = $obj->io_tdcontinue($sth, 0);
		return 0 unless $$rspmsg;
		$sthp->[17] = $rspmsg;
		$rsplen = length($$rspmsg);
		$obj->io_tdcontinue($sth, 1)
			if (! $sthp->[22]) && $obj->[14];
		$pos = 52;
	}
	my ($pclhdrsz, $rowcnt, $tderr, $fldcount, $activity, $tdelen, $tdemsg);
	($f, $l, $pclhdrsz) = _getPclHeader($$rspmsg, $pos);
	$sth->{tdat_more_results} = 1;
	while (($f != 10) && ($f != 105)) {
		$sthp->[19] = $pos + $l;
		if ($f == 12) {
			$sthp->[17] = undef;
			$sthp->[19] = 0;
			$sth->{tdat_more_results} = 0;
			$obj->io_tddo('COMMIT WORK'),
			$obj->[11] = 0
				if ($obj->[10] eq 'ANSI') &&
					$obj->[11] && $obj->[31]{AutoCommit};
			$sth->{tdat_more_results} = 0,
			delete $obj->[1]{$sthp->[12]},
			$sthp->[12] = 0,
				unless ($obj->[19] == 3) ||
					$sth->{tdat_keepresp};
			return $total_activity;
		}
		elsif (($f == 9) || ($f == 49)) {
			($stmtno, $rowcnt, $tderr, $tdelen) =
				unpack('SSSS', substr($$rspmsg, $pos+$pclhdrsz, 8));
			$tdemsg = substr($$rspmsg, $pos+$pclhdrsz+8, $tdelen);
			DBI->trace_msg("ERROR $tderr\: $tdemsg\n", 2);
			$obj->io_set_error($tderr,
				(($f == 9) ? 'Failure' : 'Error') .
					" $tderr\: $tdemsg on Statement $stmtno.");
			$sth->{tdat_stmt_num} = $stmtno;
			$stmthash = $$stmtinfo[$stmtno];
			$stmthash->{ErrorCode} = $tderr;
			$stmthash->{ErrorMessage} = $tdemsg;
			$obj->[11] = 0
				if ($obj->[10] ne 'ANSI');
			delete $obj->[1]{$sthp->[12]},
			$sthp->[12] = 0,
			$sthp->[17] = undef,
			$sthp->[19] = 0,
			$sth->{tdat_more_results} = 0,
			$sthp->[22] = 1,
			return undef
				if ($obj->[10] ne 'ANSI') ||
					($stmtno == $#{$sth->{tdat_stmt_info}});
		}
		elsif ($f == 8) {
			($stmtno, $rowcnt, $tderr, $fldcount, $activity, $tdelen) =
				unpack('SLSSSS', substr($$rspmsg, $pos+$pclhdrsz, 14));
			$stmtno++ unless $stmtno;
			$stmthash = $$stmtinfo[$stmtno];
			$stmthash->{ActivityType} = ($td_activity_types{$activity}) ?
				$td_activity_types{$activity} : 'Unknown';
			$stmthash->{ActivityCount} = $rowcnt;
			$total_activity += $rowcnt;
			delete $stmthash->{Warning};
			$stmthash->{Warning} =
	"Warning $tderr\: " . substr($$rspmsg, $pos+$pclhdrsz+14, $tdelen)
				if $tdelen;
			$sth->{tdat_stmt_num} = $stmtno;
		}
		elsif ($f == 17) {
			($stmtno, $fldcount, $rowcnt, $activity, $tderr, $tdelen) =
				unpack('SSLSSS', substr($$rspmsg, $pos+$pclhdrsz, 14));
			$stmtno++ unless $stmtno;
			$stmthash = $$stmtinfo[$stmtno];
			$stmthash->{ActivityType} = ($td_activity_types{$activity}) ?
				$td_activity_types{$activity} : 'Unknown';
			$stmthash->{ActivityCount} = $rowcnt;
			$total_activity += $rowcnt;
			delete $stmthash->{Warning};
			$stmthash->{Warning} =
		"Warning $tderr\: " . substr($$rspmsg, $pos+$pclhdrsz+14, $tdelen)
				if $tdelen;
			$sth->{tdat_stmt_num} = $stmtno;
		}
		elsif ($f == 33) {
			$stmthash->{IsSummary} = (unpack('S',
				substr($$rspmsg, $pos+$pclhdrsz)) - 1);
			$stmthash->{SummaryPosition} = [ ],
			$stmthash->{SummaryPosStart} = [ ]
				unless defined($stmthash->{SummaryPosition});
		}
		elsif ($f == 35) {
			delete $stmthash->{IsSummary};
		}
		elsif ($f == 46) {
			my $sumpos = $stmthash->{SummaryPosition};
			my $sumstart = $stmthash->{SummaryPosStart};
			push(@$sumstart, scalar(@$sumpos));
		}
		elsif ($f == 34) {
			my $sumpos = $stmthash->{SummaryPosition};
			push(@$sumpos, (unpack('S', substr($$rspmsg, $pos+$pclhdrsz))));
		}
		elsif ($f == 29) {
			$stmthash->{Prompt} = 1;
			$obj->[6] = 1;
		}
		elsif ($f == 11) {
			delete $stmthash->{SummaryPosStart};
			delete $stmthash->{SummaryPosition};
			$endstmt = 1;
		}
		elsif (($f == 71) && (exists $stmthash->{ActivityType}) &&
			(($stmthash->{ActivityType} eq 'Help') ||
			($stmthash->{ActivityType} eq 'Call') ||
			($stmthash->{ActivityType} eq 'Monitor SQL') ||
			(($stmthash->{ActivityType} eq 'Monitor Session') &&
				($stmtno > 1)))) {
			my $rc = $obj->io_proc_datainfo($sth,
				substr($$rspmsg, $pos+$pclhdrsz, $l - $pclhdrsz),
					$stmtno);
			DBI->trace_msg("ERROR -1: DATAINFO for unexpected statement\n", 2),
			return $obj->io_set_error("Failure -1: DATAINFO for unexpected Statement $stmtno.")
				if ($rc == -1);
			DBI->trace_msg("ERROR -2: DATAINFO does not match defined fields.\n", 2),
			return $obj->io_set_error(-2,
				"Failure -2: DATAINFO does not match defined fields for Statement $stmtno.")
				if ($rc == -2);
		}
		elsif ($f == 121) {
			$sthp->[6] = substr($$rspmsg, $pos+$pclhdrsz,
				$l - $pclhdrsz) . pack('L', $sthp->[12]);
		}
		elsif (($f == 20) ||
			($f == 22) ||
			($f == 24)) {
			$sthp->[25] = 1;
		}
		elsif (($f == 21) ||
			($f == 23) ||
			($f == 25)) {
			$sthp->[25] = undef;
		}
		elsif ($f == 18) {
			push @{$sthp->[7]},
				substr($$rspmsg, $pos+$pclhdrsz, $l - $pclhdrsz)
				unless $sthp->[25];
		}
		elsif ($f == 19) {
			push @{$sthp->[7]}, undef
				unless $sthp->[25];
		}
		elsif ($f == 27) {
			last unless $retstr;
			$sthp->[7] = [ ];
			$arycnt++ if defined($ary);
		}
		elsif ($f == 28) {
			last if $endstmt;
			$$retstr = $sthp->[7],
			$sthp->[19] = $pos + $l,
			$sthp->[7] = undef,
			return 1
				unless defined($ary);
			push (@$ary, $sthp->[7]);
			$f = 32;
			$sthp->[7] = undef;
			$sthp->[19] = $pos + $l,
			$#$ary = $maxlen - 1,
			return $maxlen
				if ($arycnt == $maxlen);
		}
		elsif (($f != 71) &&
			($f != 47) && ($f != 26)) {
			$obj->io_set_error("Received bad parcel $f.");
			delete $obj->[1]{$sthp->[12]};
			$sthp->[12] = 0;
			$sthp->[17] = undef;
			$sthp->[19] = 0;
			$sth->{tdat_more_results} = 0;
			return undef;
		}
		$pos += $l;
		if (($pos >= $rsplen) && ( ! $sthp->[22])) {
			$rspmsg = $obj->io_tdcontinue($sth, 0);
			return 0 unless $rspmsg;
			$sthp->[17] = $rspmsg;
			$rsplen = length($$rspmsg);
			$pos = 52;
			$obj->io_tdcontinue($sth, 1)
				if (! $sthp->[22]) && $obj->[14];
			$pos = 52;
		}
		($f, $l, $pclhdrsz) = _getPclHeader($$rspmsg, $pos);
	}
	$sthp->[19] = $pos,
	return $total_activity
		unless $retstr;
	if ($endstmt) {
		$sthp->[19] = $pos;
		return 0
			unless defined($ary) && $arycnt;
		push (@$ary, $sthp->[7]);
		$sthp->[7] = undef;
		$sthp->[19] = $pos + $l;
		$#$ary = $arycnt - 1;
		return $arycnt;
	}
	if (defined($ary)) {
		$#$ary = $arycnt - 2,
		return $arycnt
			if $sthp->[7];
		my $i = 0;
		while (($i < $maxlen) && ($pos < $rsplen) && ($f == 10)) {
	 		$$ary[$i] = pack('Sa*c', $l-$pclhdrsz,
	 			substr($$rspmsg, $pos+$pclhdrsz, $l - $pclhdrsz), 10),
			$pos += $l;
			($f, $l, $pclhdrsz) = _getPclHeader($$rspmsg, $pos)
				unless ($pos >= $rsplen);
			$i++;
		}
		$sthp->[19] = $pos;
		$#$ary = $i-1;
		return $i;
	}
	$sthp->[19] = $pos + $l,
	return 0
		if $sthp->[7];
	$$retstr = substr($$rspmsg, $pos+$pclhdrsz, $l - $pclhdrsz);
	$sthp->[19] = $pos + $l;
	return 1;
}
sub io_commit {
	while ($_[0]->[11]) {
		return undef
			unless defined($_[0]->io_tddo($_[0]->[7]));
		$_[0]->[11] = 0;
	}
	return 1;
}
sub io_rollback {
	return $_[0]->io_tddo($_[0]->[8]);
}
sub io_err {
	return $_[0]->[18];
}
sub io_errstr {
	return $_[0]->[17];
}
sub io_state {
	return $_[0]->[24];
}
sub io_finish {
	my ($obj, $sth) = @_;
	my $reqno = $sth->{_p}[12];
	my $running = (($reqno) && ($obj->[23] == $reqno));
	return 1 if (! $running) && $sth->{_p}[22] &&
		(! $sth->{tdat_keepresp});
	if ($obj->[15]) {
			$obj->[15]->cli_end_request($reqno);
	}
	delete $obj->[1]{$reqno};
	return 1;
}
sub io_cancel {
	my ($obj, $sth) = @_;
	my $reqno = $sth->{_p}[12];
	my $running = ($reqno && ($obj->[23] == $reqno));
	return 1 if (! $running) && $sth->{_p}[22] &&
		(! $sth->{tdat_keepresp});
		($running) ? $obj->[15]->cli_abort_request($reqno) :
			$obj->[15]->cli_end_request($reqno);
	$obj->io_getcliresp,
	delete $obj->[1]{$reqno}
		unless $sth->{tdat_nowait};
	return 1;
}
sub io_FirstAvailList {
	my ($sesslist, $timeout) = @_;
	my $i = 0;
	my $rmask = '';
	my $wmask = '';
	my $emask = '';
	my ($rout, $wout, $eout);
	my %fdhash = ();
	my @avails = ();
	my @clilist = ();
	my %seshash = ();
	foreach my $obj (@$sesslist) {
		$i++, next unless defined($obj);
		$fdhash{$obj} = $i++,
		vec($rmask, $obj, 1) = 1,
		next
			unless (ref $obj);
		push(@avails, $i++),
		next
			unless $obj->[23];
		push (@clilist, $i++);
	}
	return ($#avails < 0) ? undef : @avails
		if ($rmask eq '') && ($#clilist < 0);
	my $started = time();
	$timeout = undef
		if defined($timeout) && ($timeout < 0);
	my $lcltimeout = ($#clilist >= 0) ? 0 : $timeout;
	if ($rmask ne '') {
		$wmask = 0;
		$emask = $rmask;
		my $n = select($rout=$rmask, undef, $eout=$emask, $lcltimeout);
		return ($#avails < 0) ? undef : @avails
			if ($n <= 0) && ($#clilist < 0);
		foreach (keys(%fdhash)) {
			push(@avails, $fdhash{$_})
				if vec($rout, $_, 1) || vec($eout, $_, 1);
		}
	}
	return (($#avails >= 0) ? @avails : undef)
		unless ($#clilist >= 0);
	my @sesobjs = ();
	my ($obj, $reqid, $keepresp);
	$obj = $sesslist->[$_],
	$reqid = $obj->[23],
	$keepresp = ($obj->[1] && (exists $obj->[1]{$reqid})) ?
		$obj->[1]{$reqid}{tdat_keepresp} : undef,
	push(@sesobjs,
		$_,
		$obj->[15],
		$reqid,
		$keepresp)
		foreach (@clilist);
	my @list = DBD::Teradata::Cli::cli_wait_for_response($timeout, @sesobjs);
	push @avails, @list;
	return ($#avails >= 0) ? @avails : undef;
}
sub io_Realize {
	my ($obj, $sth) = @_;
	my $rspmsg = $obj->io_getcliresp($sth);
	return undef unless $rspmsg;
	$obj->io_tdcontinue($sth, 1)
		if (! $sth->{_p}[22]) && $obj->[14];
	my $rc = $obj->io_fetch($sth, undef, undef);
	$sth->{Active} = undef,
	return undef
		unless defined($rc);
	return $rc;
}
sub io_proc_datainfo {
	my ($obj, $sth, $pcl, $stmtno) = @_;
	my $flds = 2 * unpack('S', $pcl);
	my $descr = "S$flds";
	$flds /= 2;
	my @diflds = unpack($descr, substr($pcl,2));
	my @ftype = ();
	my @ftypestr = ();
	my @fprec = ();
	my @fscale = ();
	my @fnullable = ();
	my @packstrs = ();
	my $prec = 0;
	my $stmtinfo = $sth->{tdat_stmt_info};
	my $names = $sth->{NAME};
	my $stmthash = $$stmtinfo[$stmtno];
	return -1 unless $stmthash;
	my ($i, $j, $t);
	my $starts = $stmthash->{StartsAt};
	for ($i = $starts, $j = 0; $i < ($starts + $flds);
		$i++, $j += 2) {
		$t = $diflds[$j],
		$diflds[$j] = (($t & 0xFF)<<8) + ($t>>8),
		$t = $diflds[$j + 1],
		$diflds[$j + 1] = (($t & 0xFF)<<8) + ($t>>8)
			if ($diflds[$j] > 1300);
		$diflds[$j] -= 500 if ($diflds[$j] > 800);
		$diflds[$j] &= 0xfffd;
		last unless defined($td_type_code2str{($diflds[$j] & 0xfffe)});
		if ($i > $stmthash->{EndsAt}) {
			print "Got $flds valid fields, but expected only ",
				($stmthash->{EndsAt} - $starts + 1),
				" expected.\n";
			return -2;
		}
		$ftype[$i] = $td_type_code2dbi{($diflds[$j] & 0xfffe)};
		$ftypestr[$i] = $td_type_code2str{($diflds[$j] & 0xfffe)};
		$fnullable[$i] = ($diflds[$j] & 1);
		my $len = $diflds[$j+1];
		$fprec[$i] = ($ftype[$i] == 3) ?
			(($len >> 8) & 0xFF) : $len;
		$fscale[$i] = ($ftype[$i] == 3) ? ($len & 0xFF) : 0;
		$prec = ($ftype[$i] == 3) ?
			$td_decszs[(($len >> 8) & 31)] : $len;
		$packstrs[$starts] .=
			(($ftype[$i] == -2) || ($ftype[$i] == 3)) ?
				"a$prec " :
			($ftype[$i] == 1) ? "A$prec " :
				$td_type_dbi2pack{$ftype[$i]} . ' ';
		$ftypestr[$i] .= '(' . $fprec[$i] .
			(($ftype[$i] == 3) ? "$fscale[$i])" : ')')
			if defined($td_type_str2baseprec{$ftypestr[$i]});
	}
	$sth->{TYPE} = \@ftype;
	$sth->{PRECISION} = \@fprec;
	$sth->{SCALE} = \@fscale;
	$sth->{NULLABLE} = \@fnullable;
	$sth->{tdat_TYPESTR} = \@ftypestr;
	$sth->{_p}[10] = \@packstrs;
	return $flds;
}
sub io_rewind {
	my ($obj, $sth) = @_;
	return undef
		unless ($obj->[19] == 1) &&
			$sth->{_p}[26] && $sth->{tdat_keepresp};
	my $reqno = $sth->{_p}[12];
	$obj->[14] = 0;
	return undef if $obj->[23] && (! $obj->io_getcliresp);
	$sth->{_p}[17] = undef;
	$sth->{_p}[19] = undef;
	my $reqmsg = $obj->[38]->rewindRequest($obj, $reqno, $obj->[3])
		or return undef;
	$obj->io_tdsend($reqmsg) or return undef;
	return $sth->{tdat_nowait} ? -1 : $obj->io_Realize($sth);
}
sub io_clone {
	$inited = 0;
	return 1;
}
1;