Blame Oracle.
Or blame me - for a decision I made many many years ago now to switch
from binding strings as type 5 (STRING) to type 1 (VARCHAR2).
Oraperl used to use 5 but that type doesn't support embedded \0 bytes.
Type 1 does support embedded nul bytes but has it's own set of issues.
You can choose your own poison via the $dbh->{ora_ph_type} attribute.
See also http://search.cpan.org/src/PYTHIAN/DBD-Oracle-1.17/t/40ph_type.t
Tim.
On Mon, Mar 06, 2006 at 08:09:39PM +0100, H.Merijn Brand wrote:
> Trailing \r characters are trimmed on varchar2 fields.
>
> HP-UX 11.11
> Oracle 9.2.0
> perl-5.8.5-64all-dor
> DBI-1.50
> DBD::Oracle-1.17
>
> DBD::Oracle states:
> --8<---
> ORA_VARCHAR2
> Strip trailing spaces and allow embedded \0 bytes. This is
> the normal default placeholder type.
> -->8---
>
> No mention of \r
>
> Script:
> --8<--- dd.pl
> #!/pro/bin/perl
>
> use strict;
> use warnings;
>
> use DBI;
>
> my %attr = (
> RaiseError => 1,
> PrintError => 1,
> AutoCommit => 0,
> ChopBlanks => 0,
> ShowErrorStatement => 1,
> FetchHashKeyName => "NAME_lc",
> );
>
> my $up = $ENV{DBUSER} || $ENV{ORACLE_USERID};
> my $dbh = DBI->connect ("DBI:Oracle:", (split m:/: => $up), \%attr) or
> die "connect: $!";
>
> $dbh->do (q;
> create table x_cr (
> k_xx varchar2 (8),
> c_xx numeric (9),
> xx varchar2 (255)
> ););
> $dbh->commit;
>
> foreach my $xx (
> (pack "C", 13),
> (pack "CC", 1, 13),
> (pack "CC", 13, 13),
> (pack "CCC", 1, 13, 0),
> ) {
> my $sth = $dbh->prepare ("insert into x_cr values (?, ?, ?)");
> $sth->execute ("zzz", 13, $xx);
> $dbh->commit;
> }
>
> my $sts = $dbh->prepare ("select * from x_cr");
> my ($k, $c, $x);
> $sts->execute;
> $sts->bind_columns (\($k, $c, $x));
> while ($sts->fetch) {
> for ($k, $c, $x) {
> my $l = length $_;
> print "'$_', ($l)\n";
> my @x = split //, $_, -1;
> print ">> ", (map { sprintf "0x%02x ", ord $x[$_] } 0 .. ($l - 1)),
> "\n";
> }
> print "---\n";
> }
> $sts->finish;
>
> $dbh->commit;
> $dbh->do ("drop table x_cr");
> $dbh->commit;
> $dbh->disconnect;
> -->8---
>
> Output:
> bev r3:/tmp 136 > perl dd.pl
> 'zzz', (3)
> >> 0x7a 0x7a 0x7a
> '13', (2)
> >> 0x31 0x33
> Use of uninitialized value in length at dd.pl line 46.
> Use of uninitialized value in concatenation (.) or string at dd.pl line 47.
> '', (0)
> Use of uninitialized value in split at dd.pl line 48.
> >>
> ---
> 'zzz', (3)
> >> 0x7a 0x7a 0x7a
> '13', (2)
> >> 0x31 0x33
> '', (1)
> >> 0x01
> ---
> 'zzz', (3)
> >> 0x7a 0x7a 0x7a
> '13', (2)
> >> 0x31 0x33
> Use of uninitialized value in length at dd.pl line 46.
> Use of uninitialized value in concatenation (.) or string at dd.pl line 47.
> '', (0)
> Use of uninitialized value in split at dd.pl line 48.
> >>
> ---
> 'zzz', (3)
> >> 0x7a 0x7a 0x7a
> '13', (2)
> >> 0x31 0x33
> ', (3)
> >> 0x01 0x0d 0x00
> ---
>
> A DBI trace shows me for the first (pack "C", 13) insert:
> --8<---
> DBI 1.50-nothread default trace level set to 0x0/9 (pid 18857)
> >> execute DISPATCH (DBI::st=HASH(0x80000001002dc208) rc1/1 @4 g0
> ima1041 pid#18857) at dd.pl line 37
> ') -> execute for DBD::Oracle::st
> (DBI::st=HASH(0x80000001002dc208)~0x80000001002db970 'zzz' 13 '
> bind :p1 <== 'zzz' (type 0)
> rebinding :p1 (not-utf8, ftype 1, csid 0, csform 0, inout 0)
> bind :p1 <== 'zzz' (size 3/4/0, ptype 4, otype 1)
> bind :p1 <== 'zzz' (size 3/3, otype 1, indp 0, at_exec 1)
>
> OCIBindByName(8000000100336140,800000010034c5c8,800000010032d5a8,":p1",3,80000001003c3d20,3,1,800000010034c5e2,0,800000010034c5e0,0,0,2)=SUCCESS
>
> OCIBindDynamic(8000000100335b38,800000010032d5a8,800000010034c590,800003fffef2a2a0,800000010034c590,800003fffef2a610)=SUCCESS
>
> OCIAttrGet(8000000100335b38,OCI_HTYPE_BIND,800000010034c5ac,0,31,800000010032d5a8)=SUCCESS
> bind :p1 <== 'zzz' (in, not-utf8, csid 1->0->1, ftype 1, csform 0->0,
> maxlen 3, maxdata_size 0)
>
> OCIAttrSet(8000000100335b38,OCI_HTYPE_BIND,800003fffeff2c0a,0,31,800000010032d5a8)=SUCCESS
> bind :p2 <== 13 (type 0)
> rebinding :p2 (not-utf8, ftype 1, csid 0, csform 0, inout 0)
> bind :p2 <== 13 (size 2/3/0, ptype 5, otype 1)
> bind :p2 <== '13' (size 2/2, otype 1, indp 0, at_exec 1)
>
> OCIBindByName(8000000100336140,80000001003c2670,800000010032d5a8,":p2",3,80000001003c41a8,2,1,80000001003c268a,0,80000001003c2688,0,0,2)=SUCCESS
>
> OCIBindDynamic(8000000100335a80,800000010032d5a8,80000001003c2638,800003fffef2a2a0,80000001003c2638,800003fffef2a610)=SUCCESS
>
> OCIAttrGet(8000000100335a80,OCI_HTYPE_BIND,80000001003c2654,0,31,800000010032d5a8)=SUCCESS
> bind :p2 <== 13 (in, not-utf8, csid 1->0->1, ftype 1, csform 0->0,
> maxlen 2, maxdata_size 0)
>
> OCIAttrSet(8000000100335a80,OCI_HTYPE_BIND,800003fffeff2c0a,0,31,800000010032d5a8)=SUCCESS
> ' (type 0)d :p3 <== '
> rebinding :p3 (not-utf8, ftype 1, csid 0, csform 0, inout 0)
> ' (size 1/2/0, ptype 4, otype 1)
> ' (size 1/1, otype 1, indp 0, at_exec 1)
>
> OCIBindByName(8000000100336140,80000001003c2b10,800000010032d5a8,":p3",3,80000001003c41e8,1,1,80000001003c2b2a,0,80000001003c2b28,0,0,2)=SUCCESS
>
> OCIBindDynamic(80000001003359c8,800000010032d5a8,80000001003c2ad8,800003fffef2a2a0,80000001003c2ad8,800003fffef2a610)=SUCCESS
>
> OCIAttrGet(80000001003359c8,OCI_HTYPE_BIND,80000001003c2af4,0,31,800000010032d5a8)=SUCCESS
> ' (in, not-utf8, csid 1->0->1, ftype 1, csform 0->0, maxlen 1, maxdata_size 0)
>
> OCIAttrSet(80000001003359c8,OCI_HTYPE_BIND,800003fffeff2c0a,0,31,800000010032d5a8)=SUCCESS
> dbd_st_execute INSERT (out0, lob0)...
> in ':p1' [0,0]: len 3, ind 0
> in ':p2' [0,0]: len 2, ind 0
> in ':p3' [0,0]: len 1, ind 0
>
> OCIStmtExecute(800000010032d4d8,8000000100336140,800000010032d5a8,1,0,0,0,0)=SUCCESS
>
> OCIAttrGet(8000000100336140,OCI_HTYPE_STMT,800003fffeff2980,0,9,800000010032d5a8)=SUCCESS
>
> OCIAttrGet(8000000100336140,OCI_HTYPE_STMT,800003fffeff29c8,0,10,800000010032d5a8)=SUCCESS
> dbd_st_execute INSERT returned (SUCCESS, rpc1, fn3, out0)
> <- execute= 1 at dd.pl line 37
> -->8---
>
> A clear length of 1 for :p3, and a success.
>
> A trace on the login gives me
> charsetid=1 ncharsetid=1 (csid: utf8=871 al32utf8=873)
>
> --
> H.Merijn Brand Amsterdam Perl Mongers (http://amsterdam.pm.org/)
> using & porting perl 5.6.2, 5.8.x, 5.9.x on HP-UX 10.20, 11.00, 11.11,
> & 11.23, SuSE 10.0, AIX 4.3 & 5.2, and Cygwin. http://qa.perl.org
> http://mirrors.develooper.com/hpux/ http://www.test-smoke.org
> http://www.goldmark.org/jeff/stupid-disclaimers/
