File Coverage

blib/lib/DBD/Oracle.pm
Criterion Covered Total %
statement 42 301 14.0
branch 7 170 4.1
condition 3 103 2.9
subroutine 8 31 25.8
pod 0 1 0.0
total 60 606 9.9


line stmt bran cond sub pod time code
1             # Oracle.pm
2             #
3             # Copyright (c) 1994-2005 Tim Bunce, Ireland
4             #
5             # See COPYRIGHT section in the documentation below
6              
7             require 5.003;
8              
9             $DBD::Oracle::VERSION = '1.19';
10              
11             my $ORACLE_ENV = ($^O eq 'VMS') ? 'ORA_ROOT' : 'ORACLE_HOME';
12              
13             {
14                 package DBD::Oracle;
15              
16 20     20   575     use DBI ();
  20         491  
  20         207  
17 20     20   305     use DynaLoader ();
  20         182  
  20         223  
18 20     20   337     use Exporter ();
  20         186  
  20         366  
19                 @ISA = qw(DynaLoader Exporter);
20                 %EXPORT_TAGS = (
21             ora_types => [ qw(
22             ORA_VARCHAR2 ORA_STRING ORA_NUMBER ORA_LONG ORA_ROWID ORA_DATE
23             ORA_RAW ORA_LONGRAW ORA_CHAR ORA_CHARZ ORA_MLSLABEL ORA_NTY
24             ORA_CLOB ORA_BLOB ORA_RSET
25             ) ],
26                     ora_session_modes => [ qw( ORA_SYSDBA ORA_SYSOPER ) ],
27                 );
28                 @EXPORT_OK = qw(ORA_OCI SQLCS_IMPLICIT SQLCS_NCHAR ora_env_var ora_cygwin_set_env);
29             #unshift @EXPORT_OK, 'ora_cygwin_set_env' if $^O eq 'cygwin';
30                 Exporter::export_ok_tags(qw(ora_types ora_session_modes));
31              
32                 my $Revision = substr(q$Revision: 1.103 $, 10);
33              
34                 require_version DBI 1.28;
35              
36                 bootstrap DBD::Oracle $VERSION;
37              
38                 $drh = undef; # holds driver handle once initialised
39              
40                 sub CLONE {
41 0     0   0         $drh = undef ;
42                 }
43                           
44                 sub driver{
45 19 50   19 0 331 return $drh if $drh;
46 19         209 my($class, $attr) = @_;
47 19         1301 my $oci = DBD::Oracle::ORA_OCI();
48              
49 19         202 $class .= "::dr";
50              
51             # not a 'my' since we use it above to prevent multiple drivers
52              
53 19         649 $drh = DBI::_new_drh($class, {
54             'Name' => 'Oracle',
55             'Version' => $VERSION,
56             'Err'    => \my $err,
57             'Errstr' => \my $errstr,
58             'Attribution' => "DBD::Oracle $VERSION using OCI$oci by Tim Bunce",
59             });
60 19         3123 DBD::Oracle::dr::init_oci($drh) ;
61 19         2584 $drh->STORE('ShowErrorStatement', 1);
62              
63 19 50       617 if ($DBI::VERSION >= 1.37) {
64 19         461 DBD::Oracle::db->install_method("ora_lob_read");
65 19         1950 DBD::Oracle::db->install_method("ora_lob_write");
66 19         1448 DBD::Oracle::db->install_method("ora_lob_append");
67 19         1417 DBD::Oracle::db->install_method("ora_lob_trim");
68 19         1592 DBD::Oracle::db->install_method("ora_lob_length");
69 19         1493 DBD::Oracle::db->install_method("ora_nls_parameters");
70 19         1346 DBD::Oracle::db->install_method("ora_can_unicode");
71             }
72              
73 19         1184 $drh;
74                 }
75              
76              
77                 END {
78             # Used to silence 'Bad free() ...' warnings caused by bugs in Oracle's code
79             # being detected by Perl's malloc.
80             $ENV{PERL_BADFREE} = 0;
81             #undef $Win32::TieRegistry::Registry if $Win32::TieRegistry::Registry;
82                 }
83              
84                 sub AUTOLOAD {
85 0     0   0      (my $constname = $AUTOLOAD) =~ s/.*:://;
86 0         0      my $val = constant($constname);
87 0     0   0      *$AUTOLOAD = sub { $val };
  0         0  
88 0         0      goto &$AUTOLOAD;
89                 }
90              
91             }
92              
93              
94             {   package DBD::Oracle::dr; # ====== DRIVER ======
95 20     20   570     use strict;
  20         189  
  20         339  
96              
97                 my %dbnames = (); # holds list of known databases (oratab + tnsnames)
98              
99                 sub load_dbnames {
100 0     0   0 my ($drh) = @_;
101 0         0 my $debug = $drh->debug;
102 0         0 my $oracle_home = DBD::Oracle::ora_env_var($ORACLE_ENV);
103 0         0 local *FH;
104 0         0 my $d;
105              
106 0 0 0     0 if (($^O eq 'MSWin32') or ($^O =~ /cygwin/i)) {
107             # XXX experimental, will probably change
108 0 0       0 $drh->trace_msg("Trying to fetch ORACLE_HOME and ORACLE_SID from the registry.\n")
109             if $debug;
110 0         0 my $sid = DBD::Oracle::ora_env_var("ORACLE_SID");
111 0 0 0     0 $dbnames{$sid} = $oracle_home if $sid and $oracle_home;
112 0 0 0     0 $drh->trace_msg("Found $sid \@ $oracle_home.\n") if $debug && $sid;
113             }
114              
115             # get list of 'local' database SIDs from oratab
116 0         0 foreach $d (qw(/etc /var/opt/oracle), DBD::Oracle::ora_env_var("TNS_ADMIN")) {
117 0 0       0 next unless defined $d;
118 0 0       0 next unless open(FH, "<$d/oratab");
119 0 0       0 $drh->trace_msg("Loading $d/oratab\n") if $debug;
120 0         0 my $ot;
121 0         0 while (defined($ot = <FH>)) {
122 0 0       0 next unless $ot =~ m/^\s*(\w+)\s*:\s*(.*?)\s*:/;
123 0         0 $dbnames{$1} = $2; # store ORACLE_HOME value
124 0 0       0 $drh->trace_msg("Found $1 \@ $2.\n") if $debug;
125             }
126 0         0 close FH;
127 0         0 last;
128             }
129              
130             # get list of 'remote' database connection identifiers
131 0         0 my @tns_admin;
132 0 0       0 push @tns_admin, (
133             "$oracle_home/network/admin", # OCI 7 and 8.1
134             "$oracle_home/net80/admin", # OCI 8.0
135             ) if $oracle_home;
136 0         0 push @tns_admin, "/var/opt/oracle";
137 0         0 foreach $d ( DBD::Oracle::ora_env_var("TNS_ADMIN"), ".", @tns_admin ) {
138 0 0 0     0 next unless $d && open(FH, "<$d/tnsnames.ora");
139 0 0       0 $drh->trace_msg("Loading $d/tnsnames.ora\n") if $debug;
140 0         0 local *_;
141 0         0 while (<FH>) {
142 0 0       0 next unless m/^\s*([-\w\.]+)\s*=/;
143 0         0 my $name = $1;
144 0 0       0 $drh->trace_msg("Found $name. ".($dbnames{$name} ? "(oratab entry overridden)" : "")."\n")
    0          
145             if $debug;
146 0         0 $dbnames{$name} = 0; # exists but false (to distinguish from oratab)
147             }
148 0         0 close FH;
149 0         0 last;
150             }
151              
152 0         0 $dbnames{0} = 1; # mark as loaded (even if empty)
153                 }
154              
155                 sub data_sources {
156 0     0   0 my $drh = shift;
157 0 0       0 load_dbnames($drh) unless %dbnames;
158 0         0 my @names = sort keys %dbnames;
159 0 0       0 my @sources = map { $_ ? ("dbi:Oracle:$_") : () } @names;
  0         0  
160 0         0 return @sources;
161                 }
162              
163              
164                 sub connect {
165 18     18   474 my ($drh, $dbname, $user, $auth, $attr)= @_;
166              
167 18 50       299 if ($dbname =~ /;/) {
168 0         0 my ($n,$v);
169 0         0 $dbname =~ s/^\s+//;
170 0         0 $dbname =~ s/\s+$//;
171 0         0 my @dbname = map {
172 0         0 ($n,$v) = split /\s*=\s*/, $_, -1;
173 0 0 0     0 Carp::carp("DSN component '$_' is not in 'name=value' format")
174             unless defined $v && defined $n;
175 0         0                 (uc($n), $v)
176             } split /\s*;\s*/, $dbname;
177 0         0 my %dbname = ( PROTOCOL => 'tcp', @dbname );
178              
179             # extract main attributes for connect_data portion
180 0         0 my @connect_data_attr = qw(SID INSTANCE_NAME SERVER SERVICE_NAME);
181 0         0 my %connect_data = map { ($_ => delete $dbname{$_}) }
  0         0  
182 0         0 grep { exists $dbname{$_} } @connect_data_attr;
183 0         0 my $connect_data = join "", map { "($_=$connect_data{$_})" } keys %connect_data;
  0         0  
184              
185 0 0 0     0 return $drh->DBI::set_err(-1,
186             "Can't connect using this syntax without specifying a HOST and one of @connect_data_attr")
187             unless $dbname{HOST} and %connect_data;
188              
189 0         0 my @addrs = map { "($_=$dbname{$_})" } keys %dbname;
  0         0  
190 0         0 my $addrs = join "", @addrs;
191 0 0       0 if ($dbname{PORT}) {
192 0         0 $addrs = "(ADDRESS=$addrs)";
193             }
194             else {
195 0         0 $addrs = "(ADDRESS_LIST=(ADDRESS=$addrs(PORT=1526))"
196             . "(ADDRESS=$addrs(PORT=1521)))";
197             }
198 0         0 $dbname = "(DESCRIPTION=$addrs(CONNECT_DATA=$connect_data))";
199 0         0 $drh->trace_msg("connect using '$dbname'");
200             }
201              
202             # If the application is asking for specific database
203             # then we may have to mung the dbname
204              
205 18 50 33     966 $dbname = $1 if !$dbname && $user && $user =~ s/\@(.*)//s;
      33        
206              
207 18 50 33     402 $drh->trace_msg("$ORACLE_ENV environment variable not set\n")
208             if !$ENV{$ORACLE_ENV} and $^O ne "MSWin32";
209              
210             # create a 'blank' dbh
211              
212 18 50       351 $user = '' if not defined $user;
213 18         277         (my $user_only = $user) =~ s:/.*::;
214 18         399 my ($dbh, $dbh_inner) = DBI::_new_dbh($drh, {
215             'Name' => $dbname,
216             # these two are just for backwards compatibility
217             'USER' => uc $user_only, 'CURRENT_USER' => uc $user_only,
218             });
219              
220             # Call Oracle OCI logon func in Oracle.xs file
221             # and populate internal handle data.
222 18 50       1332775 DBD::Oracle::db::_login($dbh, $dbname, $user, $auth, $attr)
223             or return undef;
224              
225 0 0 0       if ($attr && $attr->{ora_module_name}) {
226 0           eval {
227 0           $dbh->do(q{BEGIN DBMS_APPLICATION_INFO.SET_MODULE(:1,NULL); END;},
228             undef, $attr->{ora_module_name});
229             };
230             }
231 0 0         unless (length $user_only) {
232 0           $user_only = $dbh->selectrow_array(q{
233             SELECT SYS_CONTEXT('userenv','session_user') FROM DUAL
234             });
235 0           $dbh_inner->{Username} = $user_only;
236             # these two are just for backwards compatibility
237 0           $dbh_inner->{USER} = $dbh_inner->{CURRENT_USER} = uc $user_only;
238             }
239              
240 0           $dbh;
241                 }
242              
243             }
244              
245              
246             {   package DBD::Oracle::db; # ====== DATABASE ======
247 20     20   637     use strict;
  20         196  
  20         404  
248 20     20   15541     use DBI qw(:sql_types);
  20         242  
  20         2000  
249              
250                 sub prepare {
251 0     0     my($dbh, $statement, @attribs)= @_;
252              
253             # create a 'blank' sth
254              
255 0           my $sth = DBI::_new_sth($dbh, {
256             'Statement' => $statement,
257             });
258              
259             # Call Oracle OCI parse func in Oracle.xs file.
260             # and populate internal handle data.
261              
262 0 0         DBD::Oracle::st::_prepare($sth, $statement, @attribs)
263             or return undef;
264              
265 0           $sth;
266                 }
267              
268              
269                 sub ping {
270 0     0     my($dbh) = @_;
271 0           my $ok = 0;
272 0           eval {
273 0           local $SIG{__DIE__};
274 0           local $SIG{__WARN__};
275             # we know that Oracle 7 prepare does a describe so this will
276             # actually talk to the server and is this a valid and cheap test.
277 0           my $sth = $dbh->prepare("select SYSDATE from DUAL /* ping */");
278             # But Oracle 8+ doesn't talk to server unless we describe the query
279 0   0       $ok = $sth && $sth->FETCH('NUM_OF_FIELDS');
280             };
281 0 0         return ($@) ? 0 : $ok;
282                 }
283              
284              
285                 sub get_info {
286 0     0     my($dbh, $info_type) = @_;
287 0           require DBD::Oracle::GetInfo;
288 0           my $v = $DBD::Oracle::GetInfo::info{int($info_type)};
289 0 0         $v = $v->($dbh) if ref $v eq 'CODE';
290 0           return $v;
291                 }
292              
293              
294                 sub table_info {
295 0     0     my($dbh, $CatVal, $SchVal, $TblVal, $TypVal) = @_;
296             # XXX add knowledge of temp tables, etc
297             # SQL/CLI (ISO/IEC JTC 1/SC 32 N 0595), 6.63 Tables
298 0 0         if (ref $CatVal eq 'HASH') {
299 0           ($CatVal, $SchVal, $TblVal, $TypVal) =
300             @$CatVal{'TABLE_CAT','TABLE_SCHEM','TABLE_NAME','TABLE_TYPE'};
301             }
302 0           my @Where = ();
303 0           my $Sql;
304 0 0 0       if ( defined $CatVal && $CatVal eq '%' && (!defined $SchVal || $SchVal eq '') && (!defined $TblVal || $TblVal eq '')) { # Rule 19a
    0 0        
    0 0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
305 0           $Sql = <<'SQL';
306             SELECT NULL TABLE_CAT
307             , NULL TABLE_SCHEM
308             , NULL TABLE_NAME
309             , NULL TABLE_TYPE
310             , NULL REMARKS
311             FROM DUAL
312             SQL
313             }
314             elsif ( defined $SchVal && $SchVal eq '%' && (!defined $CatVal || $CatVal eq '') && (!defined $TblVal || $TblVal eq '')) { # Rule 19b
315 0           $Sql = <<'SQL';
316             SELECT NULL TABLE_CAT
317             , s TABLE_SCHEM
318             , NULL TABLE_NAME
319             , NULL TABLE_TYPE
320             , NULL REMARKS
321             FROM
322             (
323             SELECT USERNAME s FROM ALL_USERS
324             UNION
325             SELECT 'PUBLIC' s FROM DUAL
326             )
327             ORDER BY TABLE_SCHEM
328             SQL
329             }
330             elsif ( defined $TypVal && $TypVal eq '%' && (!defined $CatVal || $CatVal eq '') && (!defined $SchVal || $SchVal eq '') && (!defined $TblVal || $TblVal eq '')) { # Rule 19c
331 0           $Sql = <<'SQL';
332             SELECT NULL TABLE_CAT
333             , NULL TABLE_SCHEM
334             , NULL TABLE_NAME
335             , t.tt TABLE_TYPE
336             , NULL REMARKS
337             FROM
338             (
339             SELECT 'TABLE' tt FROM DUAL
340             UNION
341             SELECT 'VIEW' tt FROM DUAL
342             UNION
343             SELECT 'SYNONYM' tt FROM DUAL
344             UNION
345             SELECT 'SEQUENCE' tt FROM DUAL
346             ) t
347             ORDER BY TABLE_TYPE
348             SQL
349             }
350             else {
351 0           $Sql = <<'SQL';
352             SELECT *
353             FROM
354             (
355             SELECT /*+ RULE*/
356             NULL TABLE_CAT
357             , t.OWNER TABLE_SCHEM
358             , t.TABLE_NAME TABLE_NAME
359             , decode(t.OWNER
360             , 'SYS' , 'SYSTEM '
361             , 'SYSTEM' , 'SYSTEM '
362             , '' ) || t.TABLE_TYPE TABLE_TYPE
363             , c.COMMENTS REMARKS
364             FROM ALL_TAB_COMMENTS c
365             , ALL_CATALOG t
366             WHERE c.OWNER (+) = t.OWNER
367             AND c.TABLE_NAME (+) = t.TABLE_NAME
368             AND c.TABLE_TYPE (+) = t.TABLE_TYPE
369             )
370             SQL
371 0 0         if ( defined $SchVal ) {
372 0           push @Where, "TABLE_SCHEM LIKE '$SchVal' ESCAPE '\\'";
373             }
374 0 0         if ( defined $TblVal ) {
375 0           push @Where, "TABLE_NAME LIKE '$TblVal' ESCAPE '\\'";
376             }
377 0 0         if ( defined $TypVal ) {
378 0           my $table_type_list;
379 0           $TypVal =~ s/^\s+//;
380 0           $TypVal =~ s/\s+$//;
381 0           my @ttype_list = split (/\s*,\s*/, $TypVal);
382 0           foreach my $table_type (@ttype_list) {
383 0 0         if ($table_type !~ /^'.*'$/) {
384 0           $table_type = "'" . $table_type . "'";
385             }
386 0           $table_type_list = join(", ", @ttype_list);
387             }
388 0           push @Where, "TABLE_TYPE IN ($table_type_list)";
389             }
390 0 0         $Sql .= ' WHERE ' . join("\n AND ", @Where ) . "\n" if @Where;
391 0           $Sql .= " ORDER BY TABLE_TYPE, TABLE_SCHEM, TABLE_NAME\n";
392             }
393 0 0         my $sth = $dbh->prepare($Sql) or return undef;
394 0 0         $sth->execute or return undef;
395 0           $sth;
396             }
397              
398              
399                 sub primary_key_info {
400 0     0             my($dbh, $catalog, $schema, $table) = @_;
401 0 0                 if (ref $catalog eq 'HASH') {
402 0                       ($schema, $table) = @$catalog{'TABLE_SCHEM','TABLE_NAME'};
403 0                       $catalog = undef;
404                     }
405 0           my $Sql = <<'SQL';
406             SELECT *
407             FROM
408             (
409             SELECT /*+ RULE*/
410             NULL TABLE_CAT
411             , c.OWNER TABLE_SCHEM
412             , c.TABLE_NAME TABLE_NAME
413             , c.COLUMN_NAME COLUMN_NAME
414             , c.POSITION KEY_SEQ
415             , c.CONSTRAINT_NAME PK_NAME
416             FROM ALL_CONSTRAINTS p
417             , ALL_CONS_COLUMNS c
418             WHERE p.OWNER = c.OWNER
419             AND p.TABLE_NAME = c.TABLE_NAME
420             AND p.CONSTRAINT_NAME = c.CONSTRAINT_NAME
421             AND p.CONSTRAINT_TYPE = 'P'
422             )
423             WHERE TABLE_SCHEM = ?
424             AND TABLE_NAME = ?
425             ORDER BY TABLE_SCHEM, TABLE_NAME, KEY_SEQ
426             SQL
427             #warn "@_\n$Sql ($schema, $table)";
428 0 0         my $sth = $dbh->prepare($Sql) or return undef;
429 0 0         $sth->execute($schema, $table) or return undef;
430 0           $sth;
431             }
432              
433                 sub foreign_key_info {
434 0     0     my $dbh = shift;
435 0 0         my $attr = ( ref $_[0] eq 'HASH') ? $_[0] : {
436             'UK_TABLE_SCHEM' => $_[1],'UK_TABLE_NAME ' => $_[2]
437             ,'FK_TABLE_SCHEM' => $_[4],'FK_TABLE_NAME ' => $_[5] };
438 0           my $Sql = <<'SQL'; # XXX: DEFERABILITY
439             SELECT *
440             FROM
441             (
442             SELECT /*+ RULE*/
443             to_char( NULL ) UK_TABLE_CAT
444             , uk.OWNER UK_TABLE_SCHEM
445             , uk.TABLE_NAME UK_TABLE_NAME
446             , uc.COLUMN_NAME UK_COLUMN_NAME
447             , to_char( NULL ) FK_TABLE_CAT
448             , fk.OWNER FK_TABLE_SCHEM
449             , fk.TABLE_NAME FK_TABLE_NAME
450             , fc.COLUMN_NAME FK_COLUMN_NAME
451             , uc.POSITION ORDINAL_POSITION
452             , 3 UPDATE_RULE
453             , decode( fk.DELETE_RULE, 'CASCADE', 0, 'RESTRICT', 1, 'SET NULL', 2, 'NO ACTION', 3, 'SET DEFAULT', 4 )
454             DELETE_RULE
455             , fk.CONSTRAINT_NAME FK_NAME
456             , uk.CONSTRAINT_NAME UK_NAME
457             , to_char( NULL ) DEFERABILITY
458             , decode( uk.CONSTRAINT_TYPE, 'P', 'PRIMARY', 'U', 'UNIQUE')
459             UNIQUE_OR_PRIMARY
460             FROM ALL_CONSTRAINTS uk
461             , ALL_CONS_COLUMNS uc
462             , ALL_CONSTRAINTS fk
463             , ALL_CONS_COLUMNS fc
464             WHERE uk.OWNER = uc.OWNER
465             AND uk.CONSTRAINT_NAME = uc.CONSTRAINT_NAME
466             AND fk.OWNER = fc.OWNER
467             AND fk.CONSTRAINT_NAME = fc.CONSTRAINT_NAME
468             AND uk.CONSTRAINT_TYPE IN ('P','U')
469             AND fk.CONSTRAINT_TYPE = 'R'
470             AND uk.CONSTRAINT_NAME = fk.R_CONSTRAINT_NAME
471             AND uk.OWNER = fk.R_OWNER
472             AND uc.POSITION = fc.POSITION
473             )
474             WHERE 1 = 1
475             SQL
476 0           my @BindVals = ();
477 0           while ( my ( $k, $v ) = each %$attr ) {
478 0 0         if ( $v ) {
479 0           $Sql .= " AND $k = ?\n";
480 0           push @BindVals, $v;
481             }
482             }
483 0           $Sql .= " ORDER BY UK_TABLE_SCHEM, UK_TABLE_NAME, FK_TABLE_SCHEM, FK_TABLE_NAME, ORDINAL_POSITION\n";
484 0 0         my $sth = $dbh->prepare( $Sql ) or return undef;
485 0 0         $sth->execute( @BindVals ) or return undef;
486 0           $sth;
487                 }
488              
489              
490                 sub column_info {
491 0     0     my $dbh = shift;
492 0 0         my $attr = ( ref $_[0] eq 'HASH') ? $_[0] : {
493             'TABLE_SCHEM' => $_[1],'TABLE_NAME' => $_[2],'COLUMN_NAME' => $_[3] };
494 0           my($typecase,$typecaseend) = ('','');
495 0 0         if (ora_server_version($dbh)->[0] >= 8) {
496 0           $typecase = <<'SQL';
497             CASE WHEN tc.DATA_TYPE LIKE 'TIMESTAMP% WITH% TIME ZONE' THEN 95
498             WHEN tc.DATA_TYPE LIKE 'TIMESTAMP%' THEN 93
499             WHEN tc.DATA_TYPE LIKE 'INTERVAL DAY% TO SECOND%' THEN 110
500             WHEN tc.DATA_TYPE LIKE 'INTERVAL YEAR% TO MONTH' THEN 107
501             ELSE
502             SQL
503 0           $typecaseend = 'END';
504             }
505 0           my $Sql = <<"SQL";
506             SELECT *
507             FROM
508             (
509             SELECT /*+ RULE*/
510             to_char( NULL ) TABLE_CAT
511             , tc.OWNER TABLE_SCHEM
512             , tc.TABLE_NAME TABLE_NAME
513             , tc.COLUMN_NAME COLUMN_NAME
514             , $typecase decode( tc.DATA_TYPE
515             , 'MLSLABEL' , -9106
516             , 'ROWID' , -9104
517             , 'UROWID' , -9104
518             , 'BFILE' , -4 -- 31?
519             , 'LONG RAW' , -4
520             , 'RAW' , -3
521             , 'LONG' , -1
522             , 'UNDEFINED', 0
523             , 'CHAR' , 1
524             , 'NCHAR' , 1
525             , 'NUMBER' , decode( tc.DATA_SCALE, NULL, 8, 3 )
526             , 'FLOAT' , 8
527             , 'VARCHAR2' , 12
528             , 'NVARCHAR2', 12
529             , 'BLOB' , 30
530             , 'CLOB' , 40
531             , 'NCLOB' , 40
532             , 'DATE' , 93
533             , NULL
534             ) $typecaseend DATA_TYPE -- ...
535             , tc.DATA_TYPE TYPE_NAME -- std.?
536             , decode( tc.DATA_TYPE
537             , 'LONG RAW' , 2147483647
538             , 'LONG' , 2147483647
539             , 'CLOB' , 2147483647
540             , 'NCLOB' , 2147483647
541             , 'BLOB' , 2147483647
542             , 'BFILE' , 2147483647
543             , 'NUMBER' , decode( tc.DATA_SCALE
544             , NULL, 126
545             , nvl( tc.DATA_PRECISION, 38 )
546             )
547             , 'FLOAT' , tc.DATA_PRECISION
548             , 'DATE' , 19
549             , tc.DATA_LENGTH
550             ) COLUMN_SIZE
551             , decode( tc.DATA_TYPE
552             , 'LONG RAW' , 2147483647
553             , 'LONG' , 2147483647
554             , 'CLOB' , 2147483647
555             , 'NCLOB' , 2147483647
556             , 'BLOB' , 2147483647
557             , 'BFILE' , 2147483647
558             , 'NUMBER' , nvl( tc.DATA_PRECISION, 38 ) + 2
559             , 'FLOAT' , 8 -- ?
560             , 'DATE' , 16
561             , tc.DATA_LENGTH
562             ) BUFFER_LENGTH
563             , decode( tc.DATA_TYPE
564             , 'DATE' , 0
565             , tc.DATA_SCALE
566             ) DECIMAL_DIGITS -- ...
567             , decode( tc.DATA_TYPE
568             , 'FLOAT' , 2
569             , 'NUMBER' , decode( tc.DATA_SCALE, NULL, 2, 10 )
570             , NULL
571             ) NUM_PREC_RADIX
572             , decode( tc.NULLABLE
573             , 'Y' , 1
574             , 'N' , 0
575             , NULL
576             ) NULLABLE
577             , cc.COMMENTS REMARKS
578             , tc.DATA_DEFAULT COLUMN_DEF -- Column is LONG!
579             , decode( tc.DATA_TYPE
580             , 'MLSLABEL' , -9106
581             , 'ROWID' , -9104
582             , 'UROWID' , -9104
583             , 'BFILE' , -4 -- 31?
584             , 'LONG RAW' , -4
585             , 'RAW' , -3
586             , 'LONG' , -1
587             , 'UNDEFINED', 0
588             , 'CHAR' , 1
589             , 'NCHAR' , 1
590             , 'NUMBER' , decode( tc.DATA_SCALE, NULL, 8, 3 )
591             , 'FLOAT' , 8
592             , 'VARCHAR2' , 12
593             , 'NVARCHAR2', 12
594             , 'BLOB' , 30
595             , 'CLOB' , 40
596             , 'NCLOB' , 40
597             , 'DATE' , 9 -- not 93!
598             , NULL
599             ) SQL_DATA_TYPE -- ...
600             , decode( tc.DATA_TYPE
601             , 'DATE' , 3
602             , NULL
603             ) SQL_DATETIME_SUB -- ...
604             , to_number( NULL ) CHAR_OCTET_LENGTH -- TODO
605             , tc.COLUMN_ID ORDINAL_POSITION
606             , decode( tc.NULLABLE
607             , 'Y' , 'YES'
608             , 'N' , 'NO'
609             , NULL
610             ) IS_NULLABLE
611             FROM ALL_TAB_COLUMNS tc
612             , ALL_COL_COMMENTS cc
613             WHERE tc.OWNER = cc.OWNER
614             AND tc.TABLE_NAME = cc.TABLE_NAME
615             AND tc.COLUMN_NAME = cc.COLUMN_NAME
616             )
617             WHERE 1 = 1
618             SQL
619 0           my @BindVals = ();
620 0           while ( my ( $k, $v ) = each %$attr ) {
621 0 0         if ( $v ) {
622 0           $Sql .= " AND $k LIKE ? ESCAPE '\\'\n";
623 0           push @BindVals, $v;
624             }
625             }
626 0           $Sql .= " ORDER BY TABLE_SCHEM, TABLE_NAME, ORDINAL_POSITION\n";
627 0 0         my $sth = $dbh->prepare( $Sql ) or return undef;
628 0 0         $sth->execute( @BindVals ) or return undef;
629 0           $sth;
630                 }
631              
632                 sub type_info_all {
633 0     0     my ($dbh) = @_;
634 0 0                 my $version = ( ora_server_version($dbh)->[0] < DBD::Oracle::ORA_OCI() )
635                                 ? ora_server_version($dbh)->[0] : DBD::Oracle::ORA_OCI();
636 0 0                 my $vc2len = ( $version < 8 ) ? "2000" : "4000";
637              
638 0           my $type_info_all = [
639             {
640             TYPE_NAME          => 0,
641             DATA_TYPE          => 1,
642             COLUMN_SIZE        => 2,
643             LITERAL_PREFIX     => 3,
644             LITERAL_SUFFIX     => 4,
645             CREATE_PARAMS      => 5,
646             NULLABLE           => 6,
647             CASE_SENSITIVE     => 7,
648             SEARCHABLE         => 8,
649             UNSIGNED_ATTRIBUTE => 9,
650             FIXED_PREC_SCALE   => 10,
651             AUTO_UNIQUE_VALUE  => 11,
652             LOCAL_TYPE_NAME    => 12,
653             MINIMUM_SCALE      => 13,
654             MAXIMUM_SCALE      => 14,
655             SQL_DATA_TYPE      => 15,
656             SQL_DATETIME_SUB   => 16,
657             NUM_PREC_RADIX     => 17,
658             INTERVAL_PRECISION => 18,
659             },
660             [ "LONG RAW", SQL_LONGVARBINARY, 2147483647,"'", "'",
661             undef,            1,0,0,undef,0,undef,
662             "LONG RAW",        undef,undef,SQL_LONGVARBINARY,undef,undef,undef, ],
663             [ "RAW", SQL_VARBINARY, 2000, "'", "'",
664             "max length",     1,0,3,undef,0,undef,
665             "RAW",             undef,undef,SQL_VARBINARY, undef,undef,undef, ],
666             [ "LONG", SQL_LONGVARCHAR, 2147483647,"'", "'",
667             undef,            1,1,0,undef,0,undef,
668             "LONG",            undef,undef,SQL_LONGVARCHAR, undef,undef,undef, ],
669             [ "CHAR", SQL_CHAR, 2000, "'", "'",
670             "max length",     1,1,3,undef,0,0,
671             "CHAR",            undef,undef,SQL_CHAR, undef,undef,undef, ],
672             [ "DECIMAL", SQL_DECIMAL, 38, undef,undef,
673             "precision,scale",1,0,3,0,    0,0,
674             "DECIMAL",         0, 38, SQL_DECIMAL, undef,10, undef, ],
675             [ "DOUBLE PRECISION",SQL_DOUBLE, 15, undef,undef,
676             undef, 1,0,3,0, 0,0,
677             "DOUBLE PRECISION",undef,undef,SQL_DOUBLE,       undef,10, undef, ],
678             [ "DATE", SQL_TYPE_TIMESTAMP,19, "'", "'",
679             undef,            1,0,3,undef,0,0,
680             "DATE",            0, 0, SQL_DATE, 3, undef,undef, ],
681             [ "VARCHAR2", SQL_VARCHAR, $vc2len, "'", "'",
682             "max length",     1,1,3,undef,0,0,
683             "VARCHAR2",        undef,undef,SQL_VARCHAR, undef,undef,undef, ],
684             ];
685 0 0         push @$type_info_all,
686             [ "BLOB", SQL_LONGVARBINARY, 2147483647,"'", "'",
687             undef,            1,1,0,undef,0,undef,
688             "BLOB",            undef,undef,SQL_LONGVARBINARY,undef,undef,undef, ],
689             [ "BFILE", SQL_LONGVARBINARY, 2147483647,"'", "'",
690             undef,            1,1,0,undef,0,undef,
691             "BFILE",           undef,undef,SQL_LONGVARBINARY,undef,undef,undef, ],
692             [ "CLOB", SQL_LONGVARCHAR, 2147483647,"'", "'",
693             undef,            1,1,0,undef,0,undef,
694             "CLOB",            undef,undef,SQL_LONGVARCHAR, undef,undef,undef, ],
695             if $version >= 8;
696 0           return $type_info_all;
697                 }
698              
699                 sub plsql_errstr {
700             # original version thanks to Bob Menteer
701 0 0   0     my $sth = shift->prepare_cached(q{
702             SELECT name, type, line, position, text
703             FROM user_errors ORDER BY name, type, sequence
704             }) or return undef;
705 0 0         $sth->execute or return undef;
706 0           my ( @msg, $oname, $otype, $name, $type, $line, $pos, $text );
707 0           $oname = $otype = 0;
708 0           while ( ( $name, $type, $line, $pos, $text ) = $sth->fetchrow_array ) {
709 0 0 0       if ( $oname ne $name || $otype ne $type ) {
710 0           push @msg, "Errors for $type $name:";
711 0           $oname = $name;
712 0           $otype = $type;
713             }
714 0           push @msg, "$line.$pos: $text";
715             }
716 0           return join( "\n", @msg );
717                 }
718              
719             #
720             # note, dbms_output must be enabled prior to usage
721             #
722                 sub dbms_output_enable {
723 0     0     my ($dbh, $buffersize) = @_;
724 0   0       $buffersize ||= 20000; # use oracle 7.x default
725 0           $dbh->do("begin dbms_output.enable(:1); end;", undef, $buffersize);
726                 }
727              
728                 sub dbms_output_get {
729 0     0     my $dbh = shift;
730 0 0         my $sth = $dbh->prepare_cached("begin dbms_output.get_line(:l, :s); end;")
731             or return;
732 0           my ($line, $status, @lines);
733             # line can be greater that 255 (e.g. 7 byte date is expanded on output)
734 0           $sth->bind_param_inout(':l', \$line, 400, { ora_type => 1 });
735 0           $sth->bind_param_inout(':s', \$status, 20, { ora_type => 1 });
736 0 0         if (!wantarray) {
737 0 0         $sth->execute or return undef;
738 0 0         return $line if $status eq '0';
739 0           return undef;
740             }
741 0   0       push @lines, $line while($sth->execute && $status eq '0');
742 0           return @lines;
743                 }
744              
745                 sub dbms_output_put {
746 0     0     my $dbh = shift;
747 0 0         my $sth = $dbh->prepare_cached("begin dbms_output.put_line(:1); end;")
748             or return;
749 0           my $line;
750 0           foreach $line (@_) {
751 0 0         $sth->execute($line) or return;
752             }
753 0           return 1;
754                 }
755              
756              
757                 sub dbms_msgpipe_get {
758 0     0     my $dbh = shift;
759 0 0         my $sth = $dbh->prepare_cached(q{
760             begin dbms_msgpipe.get_request(:returnpipe, :proc, :param); end;
761             }) or return;
762 0           my $msg = ['','',''];
763 0           $sth->bind_param_inout(":returnpipe", \$msg->[0], 30);
764 0           $sth->bind_param_inout(":proc",       \$msg->[1], 30);
765 0           $sth->bind_param_inout(":param",      \$msg->[2], 4000);
766 0 0         $sth->execute or return undef;
767 0           return $msg;
768                 }
769              
770                 sub dbms_msgpipe_ack {
771 0     0     my $dbh = shift;
772 0           my $msg = shift;
773 0 0         my $sth = $dbh->prepare_cached(q{
774             begin dbms_msgpipe.acknowledge(:returnpipe, :errormsg, :param); end;
775             }) or return;
776 0           $sth->bind_param_inout(":returnpipe", \$msg->[0], 30);
777 0           $sth->bind_param_inout(":proc",       \$msg->[1], 30);
778 0           $sth->bind_param_inout(":param",      \$msg->[2], 4000);
779 0 0         $sth->execute or return undef;
780 0           return 1;
781                 }
782              
783                 sub ora_server_version {
784 0     0     my $dbh = shift;
785 0 0         return $dbh->{ora_server_version} if defined $dbh->{ora_server_version};
786 0           $dbh->{ora_server_version} =
787             [ split /\./, $dbh->selectrow_array(<<'SQL', undef, 'Oracle%', 'Personal Oracle%') .''];
788             SELECT version
789             FROM product_component_version
790             WHERE product LIKE ? or product LIKE ?
791             SQL
792                 }
793              
794                 sub ora_nls_parameters {
795 0     0     my $dbh = shift;
796 0           my $refresh = shift;
797              
798 0 0 0       if ($refresh || !$dbh->{ora_nls_parameters}) {
799 0 0                     my $nls_parameters = $dbh->selectall_arrayref(q{
800             SELECT parameter, value FROM v$nls_parameters
801             }) or return;
802 0           $dbh->{ora_nls_parameters} = { map { $_->[0] => $_->[1] } @$nls_parameters };
  0            
803             }
804              
805             # return copy of params to protect against accidental editing
806 0           my %nls = %{$dbh->{ora_nls_parameters}};
  0            
807 0           return \%nls;
808                 }
809              
810                 sub ora_can_unicode {
811 0     0     my $dbh = shift;
812 0           my $refresh = shift;
813             # 0 = No Unicode support.
814             # 1 = National character set is Unicode-based.
815             # 2 = Database character set is Unicode-based.
816             # 3 = Both character sets are Unicode-based.
817              
818 0 0 0       return $dbh->{ora_can_unicode}
819             if defined $dbh->{ora_can_unicode} && !$refresh;
820              
821 0           my $nls = $dbh->ora_nls_parameters($refresh);
822              
823 0           $dbh->{ora_can_unicode}  = 0;
824 0 0         $dbh->{ora_can_unicode} += 1 if $nls->{NLS_NCHAR_CHARACTERSET} =~ /UTF/;
825 0 0         $dbh->{ora_can_unicode} += 2 if $nls->{NLS_CHARACTERSET} =~ /UTF/;
826              
827 0           return $dbh->{ora_can_unicode};
828                 }
829              
830             }   # end of package DBD::Oracle::db
831              
832              
833             {   package DBD::Oracle::st; # ====== STATEMENT ======
834              
835                 sub execute_for_fetch {
836 0     0            my ($sth, $fetch_tuple_sub, $tuple_status) = @_;
837 0                  my $row_count = 0;
838 0                  my $tuple_count=0;
839 0                  my $tuple_batch_status;
840 0                  my $dbh = $sth->{Database};
841 0   0              my $batch_size =($dbh->{'ora_array_chunk_size'}||= 1000);
842                     
843 0 0                if(defined($tuple_status)) {
844 0                      @$tuple_status = ();
845 0                      $tuple_batch_status = [ ];
846                    }
847                    
848 0                  while (1) {
849 0                      my @tuple_batch;
850                        for (my $i = 0; $i < $batch_size; $i++) {
851 0 0                         push @tuple_batch, [ @{$fetch_tuple_sub->() || last} ];
  0            
852 0                      }
853 0 0                    last unless @tuple_batch;
854 0                      my $res = ora_execute_array($sth,
855                                                        \@tuple_batch,
856                                                        scalar(@tuple_batch),
857                                                        $tuple_batch_status);
858 0 0 0                  if(defined($res) && defined($row_count)) {
859 0                           $row_count += $res;
860                        } else {
861 0                           $row_count = undef;
862                        }
863 0                      $tuple_count+=@$tuple_batch_status;
864 0 0                    push @$tuple_status, @$tuple_batch_status
865                        if defined($tuple_status);
866                    }
867 0 0                if (!wantarray) {
868 0 0         return undef if !defined $row_count;
869 0               return $tuple_count;
870                    }
871 0 0                return (defined $row_count ? $tuple_count : undef, $row_count);
872                 }
873              
874             }
875              
876             1;
877              
878             __END__
879            
880             =head1 NAME
881            
882             DBD::Oracle - Oracle database driver for the DBI module
883            
884             =head1 SYNOPSIS
885            
886             use DBI;
887            
888             $dbh = DBI->connect("dbi:Oracle:$dbname", $user, $passwd);
889            
890             $dbh = DBI->connect("dbi:Oracle:host=$host;sid=$sid", $user, $passwd);
891            
892             # See the DBI module documentation for full details
893            
894             # for some advanced uses you may need Oracle type values:
895             use DBD::Oracle qw(:ora_types);
896            
897            
898             =head1 DESCRIPTION
899            
900             DBD::Oracle is a Perl module which works with the DBI module to provide
901             access to Oracle databases.
902            
903             =head1 CONNECTING TO ORACLE
904            
905             This is a topic which often causes problems. Mainly due to Oracle's many
906             and sometimes complex ways of specifying and connecting to databases.
907             (James Taylor and Lane Sharman have contributed much of the text in
908             this section.)
909            
910             =head2 Connecting without environment variables or tnsname.ora file
911            
912             If you use the C<host=$host;sid=$sid> style syntax, for example:
913            
914             $dbh = DBI->connect("dbi:Oracle:host=myhost.com;sid=ORCL", $user, $passwd);
915            
916             then DBD::Oracle will construct a full connection descriptor string
917             for you and Oracle will not need to consult the tnsname.ora file.
918            
919             If a C<port> number is not specified then the descriptor will try both
920             1526 and 1521 in that order (e.g., new then old). You can check which
921             port(s) are in use by typing "$ORACLE_HOME/bin/lsnrctl stat" on the server.
922            
923            
924             =head2 Oracle Environment Variables
925            
926             Oracle typically uses two environment variables to specify default
927             connections: ORACLE_SID and TWO_TASK.
928            
929             ORACLE_SID is really unnecessary to set since TWO_TASK provides the
930             same functionality in addition to allowing remote connections.
931            
932             % setenv TWO_TASK T:hostname:ORACLE_SID # for csh shell
933             $ TWO_TASK=T:hostname:ORACLE_SID export TWO_TASK # for sh shell
934            
935             % sqlplus username/password
936            
937             Note that if you have *both* local and remote databases, and you
938             have ORACLE_SID *and* TWO_TASK set, and you don't specify a fully
939             qualified connect string on the command line, TWO_TASK takes precedence
940             over ORACLE_SID (i.e. you get connected to remote system).
941            
942             TWO_TASK=P:sid
943            
944             will use the pipe driver for local connections using SQL*Net v1.
945            
946             TWO_TASK=T:machine:sid
947            
948             will use TCP/IP (or D for DECNET, etc.) for remote SQL*Net v1 connection.
949            
950             TWO_TASK=dbname
951            
952             will use the info stored in the SQL*Net v2 F<tnsnames.ora>
953             configuration file for local or remote connections.
954            
955             The ORACLE_HOME environment variable should be set correctly.
956             In general, the value used should match the version of Oracle that
957             was used to build DBD::Oracle. If using dynamic linking then
958             ORACLE_HOME should match the version of Oracle that will be used
959             to load in the Oracle client libraries (via LD_LIBRARY_PATH, ldconfig,
960             or similar on Unix).
961            
962             ORACLE_HOME can be left unset if you aren't using any of Oracle's
963             executables, but it is I<not> recommended and error messages may not display.
964             It should be set to the ORACLE_HOME directory of the version of Oracle
965             that DBD::Oracle was compiled with.
966            
967             Discouraging the use of ORACLE_SID makes it easier on the users to see
968             what is going on. (It's unfortunate that TWO_TASK couldn't be renamed,
969             since it makes no sense to the end user, and doesn't have the ORACLE prefix).
970            
971             =head2 Connection Examples Using DBD::Oracle
972            
973             First, how to connect to a local database I<without> using a Listener:
974            
975             $dbh = DBI->connect('dbi:Oracle:SID','scott', 'tiger');
976            
977             you can also leave the SID empty:
978            
979             $dbh = DBI->connect('dbi:Oracle:','scott', 'tiger');
980            
981             in which case Oracle client code will use the ORACLE_SID environment
982             variable (if TWO_TASK env var isn't defined).
983            
984             Below are various ways of connecting to an oracle database using
985             SQL*Net 1.x and SQL*Net 2.x. "Machine" is the computer the database is
986             running on, "SID" is the SID of the database, "DB" is the SQL*Net 2.x
987             connection descriptor for the database.
988            
989             B<Note:> Some of these formats may not work with Oracle 8+.
990            
991             BEGIN {
992             $ENV{ORACLE_HOME} = '/home/oracle/product/7.x.x';
993             $ENV{TWO_TASK} = 'DB';
994             }
995             $dbh = DBI->connect('dbi:Oracle:','scott', 'tiger');
996             # - or -
997             $dbh = DBI->connect('dbi:Oracle:','scott/tiger');
998            
999             Refer to your Oracle documentation for valid values of TWO_TASK.
1000            
1001             Here are some variations (not setting TWO_TASK) in order of preference:
1002            
1003             $dbh = DBI->connect('dbi:Oracle:DB','username','password')
1004            
1005             $dbh = DBI->connect('dbi:Oracle:DB','username/password','')
1006            
1007             $dbh = DBI->connect('dbi:Oracle:','username@DB','password')
1008            
1009             $dbh = DBI->connect('dbi:Oracle:host=foobar;sid=ORCL;port=1521', 'scott/tiger', '')
1010            
1011             $dbh = DBI->connect('dbi:Oracle:', q{scott/tiger@(DESCRIPTION=
1012             (ADDRESS=(PROTOCOL=TCP)(HOST= foobar)(PORT=1521))
1013             (CONNECT_DATA=(SID=ORCL)))}, "")
1014            
1015             If you are having problems with login taking a long time (>10 secs say)
1016             then you might have tripped up on an Oracle bug. You can try using one
1017             of the ...@DB variants as a workaround. E.g.,
1018            
1019             $dbh = DBI->connect('','username/password@DB','');
1020            
1021             On the other hand, that may cause you to trip up on another Oracle bug
1022             that causes alternating connection attempts to fail! (In reality only
1023             a small proportion of people experience these problems.)
1024            
1025            
1026             To connect to a local database with a user which has been set-up to
1027             authenticate via the OS ("ALTER USER username IDENTIFIED EXTERNALLY"):
1028            
1029             $dbh = DBI->connect('dbi:Oracle:','/','');
1030            
1031             Note the lack of a connection name (use the ORACLE_SID environment
1032             variable). If an explicit SID is used you'll probably get an ORA-01004 error.
1033            
1034             That only works for local databases. (Authentication to remote Oracle
1035             databases using your unix login name without a password and is possible
1036             but it's not secure and not recommended so not documented here. If you
1037             can't find the information elsewhere then you probably shouldn't be
1038             trying to do it.)
1039            
1040            
1041             =head2 Optimizing Oracle's listener
1042            
1043             [By Lane Sharman <lane@bienlogic.com>] I spent a LOT of time optimizing
1044             listener.ora and I am including it here for anyone to benefit from. My
1045             connections over tnslistener on the same humble Netra 1 take an average
1046             of 10-20 milli seconds according to tnsping. If anyone knows how to
1047             make it better, please let me know!
1048            
1049             LISTENER =
1050             (ADDRESS_LIST =
1051             (ADDRESS =
1052             (PROTOCOL = TCP)
1053             (Host = aa.bbb.cc.d)
1054             (Port = 1521)
1055             (QUEUESIZE=10)
1056             )
1057             )
1058            
1059             STARTUP_WAIT_TIME_LISTENER = 0
1060             CONNECT_TIMEOUT_LISTENER = 10
1061             TRACE_LEVEL_LISTENER = OFF
1062             SID_LIST_LISTENER =
1063             (SID_LIST =
1064             (SID_DESC =
1065             (SID_NAME = xxxx)
1066             (ORACLE_HOME = /xxx/local/oracle7-3)
1067             (PRESPAWN_MAX = 40)
1068             (PRESPAWN_LIST=
1069             (PRESPAWN_DESC=(PROTOCOL=tcp) (POOL_SIZE=40) (TIMEOUT=120))
1070             )
1071             )
1072             )
1073            
1074             1) When the application is co-located on the host AND there is no need for
1075             outside SQLNet connectivity, stop the listener. You do not need it. Get
1076             your application/cgi/whatever working using pipes and shared memory. I am
1077             convinced that this is one of the connection bugs (sockets over the same
1078             machine). Note the $ENV{ORAPIPES} env var. The essential code to do
1079             this at the end of this section.
1080            
1081             2) Be careful in how you implement the multi-threaded server. Currently I
1082             am not using it in the initxxxx.ora file but will be doing some more testing.
1083            
1084             3) Be sure to create user rollback segments and use them; do not use the
1085             system rollback segments; however, you must also create a small rollback
1086             space for the system as well.
1087            
1088             5) Use large tuning settings and get lots of RAM. Check out all the
1089             parameters you can set in v$parameters because there are quite a few not
1090             documented you may to set in your initxxx.ora file.
1091            
1092             6) Use svrmgrl to control oracle from the command line. Write lots of small
1093             SQL scripts to get at V$ info.
1094            
1095             use DBI;
1096             # Environmental variables used by Oracle
1097             $ENV{ORACLE_SID} = "xxx";
1098             $ENV{ORACLE_HOME} = "/opt/oracle7";
1099             $ENV{EPC_DISABLED} = "TRUE";
1100             $ENV{ORAPIPES} = "V2";
1101             my $dbname = "xxx";
1102             my $dbuser = "xxx";
1103             my $dbpass = "xxx";
1104             my $dbh = DBI->connect("dbi:Oracle:$dbname", $dbuser, $dbpass)
1105             || die "Unable to connect to $dbname: $DBI::errstr\n";
1106            
1107             =head2 Oracle utilities
1108            
1109             If you are still having problems connecting then the Oracle adapters
1110             utility may offer some help. Run these two commands:
1111            
1112             $ORACLE_HOME/bin/adapters
1113             $ORACLE_HOME/bin/adapters $ORACLE_HOME/bin/sqlplus
1114            
1115             and check the output. The "Protocol Adapters" section should be the
1116             same. It should include at least "IPC Protocol Adapter" and "TCP/IP
1117             Protocol Adapter".
1118            
1119             If it generates any errors which look relevant then please talk to your
1120             Oracle technical support (and not the dbi-users mailing list). Thanks.
1121             Thanks to Mark Dedlow for this information.
1122            
1123            
1124             =head2 Constants
1125            
1126             =item :ora_session_modes
1127            
1128             ORA_SYSDBA ORA_SYSOPER
1129            
1130             =item :ora_types
1131            
1132             ORA_VARCHAR2 ORA_STRING ORA_NUMBER ORA_LONG ORA_ROWID ORA_DATE
1133             ORA_RAW ORA_LONGRAW ORA_CHAR ORA_CHARZ ORA_MLSLABEL ORA_NTY
1134             ORA_CLOB ORA_BLOB ORA_RSET
1135            
1136             =item SQLCS_IMPLICIT
1137            
1138             =item SQLCS_NCHAR
1139            
1140             SQLCS_IMPLICIT and SQLCS_NCHAR are I<character set form> values.
1141             See notes about Unicode elsewhere in this document.
1142            
1143             =item ORA_OCI
1144            
1145             Oracle doesn't provide a formal API for determining the exact version
1146             number of the OCI client library used, so DBD::Oracle has to go digging
1147             (and sometimes has to more or less guess). The ORA_OCI constant
1148             holds the result of that process.
1149            
1150             In string context ORA_OCI returns the full "A.B.C.D" version string.
1151            
1152             In numeric context ORA_OCI returns the major.minor version number
1153             (8.1, 9.2, 10.0 etc). But note that version numbers are not actually
1154             floating point and so if Oracle ever makes a release that has a two
1155             digit minor version, such as C<9.10> it will have a lower numeric
1156             value than the preceding C<9.9> release. So use with care.
1157            
1158             The contents and format of ORA_OCI are subject to change (it may,
1159             for example, become a I<version object> in later releases).
1160             I recommend that you avoid checking for exact values.
1161            
1162            
1163             =head2 Connect Attributes
1164            
1165             =over 4
1166            
1167             =item ora_session_mode
1168            
1169             The ora_session_mode attribute can be used to connect with SYSDBA
1170             authorization and SYSOPER authorization.
1171             The ORA_SYSDBA and ORA_SYSOPER constants can be imported using
1172            
1173             use DBD::Oracle qw(:ora_session_modes);
1174            
1175             This is one case where setting ORACLE_SID may be useful since
1176             connecting as SYSDBA or SYSOPER via SQL*Net is frequently disabled
1177             for security reasons.
1178            
1179             Example:
1180            
1181             $dsn = "dbi:Oracle:"; # no dbname here
1182             $ENV{ORACLE_SID} = "orcl"; # set ORACLE_SID as needed
1183             delete $ENV{TWO_TASK}; # make sure TWO_TASK isn't set
1184            
1185             $dbh = DBI->connect($dsn, "", "", { ora_session_mode => ORA_SYSDBA });
1186            
1187             It has been reported that this only works if $dsn does not contain a SID
1188             so that Oracle then uses the value of the ORACLE_SID (not TWO_TASK)
1189             environment variable to connect to a local instance. Also the username
1190             and password should be empty, and the user executing the script needs
1191             to be part of the dba group or osdba group.
1192            
1193             =item ora_oratab_orahome
1194            
1195             Passing a true value for the ora_oratab_orahome attribute will make
1196             DBD::Oracle change $ENV{ORACLE_HOME} to make the Oracle home directory
1197             specified in the C</etc/oratab> file I<if> the database to connect to
1198             is specified as a SID that exists in the oratab file, and DBD::Oracle was
1199             built to use the Oracle 7 OCI API (not Oracle 8+).
1200            
1201             =item ora_module_name
1202            
1203             After connecting to the database the value of this attribute is passed
1204             to the SET_MODULE() function in the C<DBMS_APPLICATION_INFO> PL/SQL
1205             package. This can be used to identify the application to the DBA for
1206             monitoring and performance tuning purposes. For example:
1207            
1208             DBI->connect($dsn, $user, $passwd, { ora_module_name => $0 });
1209            
1210             =item ora_dbh_share
1211            
1212             Needs at least Perl 5.8.0 compiled with ithreads. Allows to share database
1213             connections between threads. The first connect will make the connection,
1214             all following calls to connect with the same ora_dbh_share attribute
1215             will use the same database connection. The value must be a reference
1216             to a already shared scalar which is initialized to an empty string.
1217            
1218             our $orashr : shared = '' ;
1219            
1220             $dbh = DBI->connect ($dsn, $user, $passwd, {ora_dbh_share => \$orashr}) ;
1221            
1222             =item ora_use_proc_connection
1223            
1224             This attribute allows to create a DBI handle for an existing SQLLIB
1225             database connection. This can be used to share database connections
1226             between Oracle ProC code and DBI running in an embedded Perl interpreter.
1227             The SQLLIB connection id is appended after the "dbi:Oracle:" initial
1228             argument to DBI::connect.
1229            
1230             For example, if in ProC a connection is made like
1231            
1232             EXEC SQL CONNECT 'user/pass@db' AT 'CONID';
1233            
1234             the connection may be used from DBI after running something like
1235            
1236             my $dbh = DBI->connect("dbi:Oracle:CONID", "", "",
1237             { ora_use_proc_connection => 1 });
1238            
1239             To disconnect, first call $dbh->disconnect(), then disconnect in ProC.
1240            
1241             This attribute requires DBD::Oracle to be built with the -ProC
1242             option to Makefile.PL. It is not available with OCI_V7. Not tested
1243             with Perl ithreads or with the ora_dbh_share connect attribute.
1244            
1245             =item ora_envhp
1246            
1247             The first time a connection is made a new OCI 'environment' is
1248             created by DBD::Oracle and stored in the driver handle.
1249             Subsequent connects reuse (share) that same OCI environment
1250             by default.
1251            
1252             The ora_envhp attribute can be used to disable the reuse of the OCI
1253             environment from a previous connect. If the value is C<0> then
1254             a new OCI environment is allocated and used for this connection.
1255            
1256             The OCI environment is what holds information about the client side
1257             context, such as the local NLS environment. So by altering %ENV and
1258             setting ora_envhp to 0 you can create connections with different
1259             NLS settings. This is most useful for testing.
1260            
1261             =back
1262            
1263             =head2 Database Handle Attributes
1264            
1265             =over 4
1266            
1267             =item C<ora_ph_type>
1268            
1269             The default placeholder data type for the database session.
1270             The C<TYPE> or L</ora_type> attributes to L<DBI/bind_param> and
1271             L<DBI/bind_param_inout> override the data type for individual placeholders.
1272             The most frequent reason for using this attribute is to permit trailing spaces
1273             in values passed by placeholders.
1274            
1275             Constants for the values allowed for this attribute can be imported using
1276            
1277             use DBD::Oracle qw(:ora_types);
1278            
1279             Only the following values are permitted for this attribute.
1280            
1281             =over 4
1282            
1283             =item ORA_VARCHAR2
1284            
1285             Oracle clients using OCI 8 will strip trailing spaces and allow embedded \0 bytes.
1286             Oracle clients using OCI 9.2 do not strip trailing spaces and allow embedded \0 bytes.
1287             This is the normal default placeholder type.
1288            
1289             =item ORA_STRING
1290            
1291             Don't strip trailing spaces and end the string at the first \0.
1292            
1293             =item ORA_CHAR
1294            
1295             Don't strip trailing spaces and allow embedded \0.
1296             Force 'blank-padded comparison semantics'.
1297            
1298             For example:
1299            
1300             use DBD::Oracle qw(:ora_types);
1301            
1302             $sql="select username from all_users where username = ?";
1303             #username is a char(8)
1304            
1305             $sth=$dbh->prepare($sql)";
1306            
1307             $sth->bind_param(1,'bloggs',{ ora_type => ORA_CHAR});
1308            
1309             Will pad bloggs out to 8 chracters and return the username.
1310            
1311             =back
1312            
1313             =item ora_parse_error_offset
1314            
1315             If the previous error was from a failed C<prepare> due to a syntax error,
1316             this attribute gives the offset into the C<Statement> attribute where the
1317             error was found.
1318            
1319             =back
1320            
1321             =over 4
1322            
1323             =item ora_array_chunk_size
1324            
1325             Because of OCI limitations, DBD::Oracle needs to buffer up rows of
1326             bind values in its C<execute_for_fetch> implementation. This attribute
1327             sets the number of rows to buffer at a time (default value is 1000).
1328            
1329             The C<execute_for_fetch> function will collect (at most) this many
1330             rows in an array, send them of to the DB for execution, then go back
1331             to collect the next chunk of rows and so on. This attribute can be
1332             used to limit or extend the number of rows processed at a time.
1333            
1334             Note that this attribute also applies to C<execute_array>, since that
1335             method is implemented using C<execute_for_fetch>.
1336            
1337             =back
1338            
1339             =head2 Prepare Attributes
1340            
1341             These attributes may be used in the C<\%attr> parameter of the
1342             L<DBI/prepare> database handle method.
1343            
1344             =over 4
1345            
1346             =item ora_placeholders
1347            
1348             Set to false to disable processing of placeholders. Used mainly for loading a
1349             PL/SQL package that has been I<wrapped> with Oracle's C<wrap> utility.
1350            
1351             =item ora_parse_lang
1352            
1353             Tells the connected database how to interpret the SQL statement.
1354             If 1 (default), the native SQL version for the database is used.
1355             Other recognized values are 0 (old V6, treated as V7 in OCI8),
1356             2 (old V7), 7 (V7), and 8 (V8).
1357             All other values have the same effect as 1.
1358            
1359             =item ora_auto_lob
1360            
1361             If true (the default), fetching retrieves the contents of the CLOB or
1362             BLOB column in most circumstances. If false, fetching retrieves the
1363             Oracle "LOB Locator" of the CLOB or BLOB value.
1364            
1365             See L</Handling LOBs> for more details.
1366             See also the LOB tests in 05dbi.t of Oracle::OCI for examples
1367             of how to use LOB Locators.
1368            
1369             =item ora_check_sql
1370            
1371             If 1 (default), force SELECT statements to be described in prepare().
1372             If 0, allow SELECT statements to defer describe until execute().
1373            
1374             See L</Prepare postponed till execute> for more information.
1375            
1376             =back
1377            
1378             =head2 Placeholder Binding Attributes
1379            
1380             These attributes may be used in the C<\%attr> parameter of the
1381             L<DBI/bind_param> or L<DBI/bind_param_inout> statement handle methods.
1382            
1383             =over 4
1384            
1385             =item ora_type
1386            
1387             Specify the placeholder's data type using an Oracle data type.
1388             A fatal error is raised if C<ora_type> and the DBI C<TYPE> attribute
1389             are used for the same placeholder.
1390             Some of these types are not supported by the current version of
1391             DBD::Oracle and will cause a fatal error if used.
1392             Constants for the Oracle datatypes may be imported using
1393            
1394             use DBD::Oracle qw(:ora_types);
1395            
1396             Potentially useful values when DBD::Oracle was built using OCI 7 and later:
1397            
1398             ORA_VARCHAR2, ORA_STRING, ORA_LONG, ORA_RAW, ORA_LONGRAW,
1399             ORA_CHAR, ORA_MLSLABEL, ORA_RSET
1400            
1401             Additional values when DBD::Oracle was built using OCI 8 and later:
1402            
1403             ORA_CLOB, ORA_BLOB, ORA_NTY
1404            
1405             See L</Binding Cursors> for the correct way to use ORA_RSET.
1406            
1407             See L</Handling LOBs> for how to use ORA_CLOB and ORA_BLOB.
1408            
1409             See L</Other Data Types> for more information.
1410            
1411             See also L<DBI/Placeholders and Bind Values>.
1412            
1413             =item ora_csform
1414            
1415             Specify the OCI_ATTR_CHARSET_FORM for the bind value. Valid values
1416             are SQLCS_IMPLICIT (1) and SQLCS_NCHAR (2). Both those constants can
1417             be imported from the DBD::Oracle module. Rarely needed.
1418            
1419             =item ora_csid
1420            
1421             Specify the I<integer> OCI_ATTR_CHARSET_ID for the bind value.
1422             Character set names can't be used currently.
1423            
1424             =item ora_maxdata_size
1425            
1426             Specify the integer OCI_ATTR_MAXDATA_SIZE for the bind value.
1427             May be needed if a character set conversion from client to server
1428             causes the data to use more space and so fail with a truncation error.
1429            
1430             =back
1431            
1432             =head2 Trailing Spaces
1433            
1434             Please note that only the Oracle OCI 8 strips trailing spaces from VARCHAR placeholder
1435             values and uses Nonpadded Comparison Semantics with the result.
1436             This causes trouble if the spaces are needed for
1437             comparison with a CHAR value or to prevent the value from
1438             becoming '' which Oracle treats as NULL.
1439             Look for Blank-padded Comparison Semantics and Nonpadded
1440             Comparison Semantics in Oracle's SQL Reference or Server
1441             SQL Reference for more details.
1442            
1443             To preserve trailing spaces in placeholder values for Oracle clients that use OCI 8,
1444             either change the default placeholder type with L</ora_ph_type> or the placeholder
1445             type for a particular call to L<DBI/bind> or L<DBI/bind_param_inout>
1446             with L</ora_type> or C<TYPE>.
1447             Using L<ORA_CHAR> with L<ora_type> or C<SQL_CHAR> with C<TYPE>
1448             allows the placeholder to be used with Padded Comparison Semantics
1449             if the value it is being compared to is a CHAR, NCHAR, or literal.
1450            
1451             Please remember that using spaces as a value or at the end of
1452             a value makes visually distinguishing values with different
1453             numbers of spaces difficult and should be avoided.
1454            
1455             Oracle Clients that use OCI 9.2 do not strip trailing spaces.
1456            
1457             =head2 Padded Char Fields
1458            
1459             Oracle Clients after OCI 9.2 will automatically pad CHAR placeholder values to the size of the CHAR.
1460             As the default placeholder type value in DBD::Oracle is ORA_VARCHAR2 to access this behavior you will
1461             have to change the default placeholder type with L</ora_ph_type> or placeholder
1462             type for a particular call with L<DBI/bind> or L<DBI/bind_param_inout>
1463             with L</ORA_CHAR> or C<ORA_CHARZ>.
1464            
1465             =head1 Metadata
1466            
1467             =head2 C<get_info()>
1468            
1469             DBD::Oracle supports C<get_info()>, but (currently) only a few info types.
1470            
1471             =head2 C<table_info()>
1472            
1473             DBD::Oracle supports attributes for C<table_info()>.
1474            
1475             In Oracle, the concept of I<user> and I<schema> is (currently) the
1476             same. Because database objects are owned by an user, the owner names
1477             in the data dictionary views correspond to schema names.
1478             Oracle does not support catalogs so TABLE_CAT is ignored as
1479             selection criterion.
1480            
1481             Search patterns are supported for TABLE_SCHEM and TABLE_NAME.
1482            
1483             TABLE_TYPE may contain a comma-separated list of table types.
1484             The following table types are supported:
1485            
1486             TABLE
1487             VIEW
1488             SYNONYM
1489             SEQUENCE
1490            
1491             The result set is ordered by TABLE_TYPE, TABLE_SCHEM, TABLE_NAME.
1492            
1493             The special enumerations of catalogs, schemas and table types are
1494             supported. However, TABLE_CAT is always NULL.
1495            
1496             An identifier is passed I<as is>, i.e. as the user provides or
1497             Oracle returns it.
1498             C<table_info()> performs a case-sensitive search. So, a selection
1499             criterion should respect upper and lower case.
1500             Normally, an identifier is case-insensitive. Oracle stores and
1501             returns it in upper case. Sometimes, database objects are created
1502             with quoted identifiers (for reserved words, mixed case, special
1503             characters, ...). Such an identifier is case-sensitive (if not all
1504             upper case). Oracle stores and returns it as given.
1505             C<table_info()> has no special quote handling, neither adds nor
1506             removes quotes.
1507            
1508             =head2 C<primary_key_info()>
1509            
1510             Oracle does not support catalogs so TABLE_CAT is ignored as
1511             selection criterion.
1512             The TABLE_CAT field of a fetched row is always NULL (undef).
1513             See L</table_info()> for more detailed information.
1514            
1515             If the primary key constraint was created without an identifier,
1516             PK_NAME contains a system generated name with the form SYS_Cn.
1517            
1518             The result set is ordered by TABLE_SCHEM, TABLE_NAME, KEY_SEQ.
1519            
1520             An identifier is passed I<as is>, i.e. as the user provides or
1521             Oracle returns it.
1522             See L</table_info()> for more detailed information.
1523            
1524             =head2 C<foreign_key_info()></