DBD-Oracle-1.74/0000775000175000017500000000000012326332111012553 5ustar yanickyanickDBD-Oracle-1.74/lib/0000775000175000017500000000000012326332111013321 5ustar yanickyanickDBD-Oracle-1.74/lib/DBD/0000775000175000017500000000000012326332111013712 5ustar yanickyanickDBD-Oracle-1.74/lib/DBD/Oracle.pm0000644000175000017500000062065212326332111015466 0ustar yanickyanick# Oracle.pm # # Copyright (c) 1994-2005 Tim Bunce, Ireland # Copyright (c) 2006-2008 John Scoles (The Pythian Group), Canada # # See COPYRIGHT section in the documentation below require 5.006; my $ORACLE_ENV = ($^O eq 'VMS') ? 'ORA_ROOT' : 'ORACLE_HOME'; { package DBD::Oracle; $DBD::Oracle::VERSION = '1.74'; BEGIN { $DBD::Oracle::AUTHORITY = 'cpan:PYTHIAN'; } # ABSTRACT: Oracle database driver for the DBI module use DBI (); use DynaLoader (); use Exporter (); use DBD::Oracle::Object(); # for dev version $DBD::Oracle::VERSION ||= '1.00'; @ISA = qw(DynaLoader Exporter); %EXPORT_TAGS = ( ora_types => [ qw( ORA_VARCHAR2 ORA_STRING ORA_NUMBER ORA_LONG ORA_ROWID ORA_DATE ORA_RAW ORA_LONGRAW ORA_CHAR ORA_CHARZ ORA_MLSLABEL ORA_XMLTYPE ORA_CLOB ORA_BLOB ORA_RSET ORA_VARCHAR2_TABLE ORA_NUMBER_TABLE SQLT_INT SQLT_FLT ORA_OCI SQLT_CHR SQLT_BIN ) ], ora_session_modes => [ qw( ORA_SYSDBA ORA_SYSOPER ORA_SYSASM ORA_SYSBACKUP ORA_SYSDG ORA_SYSKM) ], ora_fetch_orient => [ qw( OCI_FETCH_NEXT OCI_FETCH_CURRENT OCI_FETCH_FIRST OCI_FETCH_LAST OCI_FETCH_PRIOR OCI_FETCH_ABSOLUTE OCI_FETCH_RELATIVE)], ora_exe_modes => [ qw( OCI_STMT_SCROLLABLE_READONLY)], ora_fail_over => [ qw( OCI_FO_END OCI_FO_ABORT OCI_FO_REAUTH OCI_FO_BEGIN OCI_FO_ERROR OCI_FO_NONE OCI_FO_SESSION OCI_FO_SELECT OCI_FO_TXNAL OCI_FO_RETRY)], ); @EXPORT_OK = qw(OCI_FETCH_NEXT OCI_FETCH_CURRENT OCI_FETCH_FIRST OCI_FETCH_LAST OCI_FETCH_PRIOR OCI_FETCH_ABSOLUTE OCI_FETCH_RELATIVE ORA_OCI SQLCS_IMPLICIT SQLCS_NCHAR ora_env_var ora_cygwin_set_env ); #unshift @EXPORT_OK, 'ora_cygwin_set_env' if $^O eq 'cygwin'; Exporter::export_ok_tags(qw(ora_types ora_session_modes ora_fetch_orient ora_exe_modes ora_fail_over)); my $Revision = substr(q$Revision: 1.103 $, 10); require_version DBI 1.51; DBD::Oracle->bootstrap($DBD::Oracle::VERSION); $drh = undef; # holds driver handle once initialized sub CLONE { $drh = undef ; } sub driver{ return $drh if $drh; my($class, $attr) = @_; my $oci = DBD::Oracle::ORA_OCI(); $class .= "::dr"; # not a 'my' since we use it above to prevent multiple drivers $drh = DBI::_new_drh($class, { 'Name' => 'Oracle', 'Version' => $VERSION, 'Err' => \my $err, 'Errstr' => \my $errstr, 'Attribution' => "DBD::Oracle $VERSION using OCI$oci by Tim Bunce", }); DBD::Oracle::dr::init_oci($drh) ; $drh->STORE('ShowErrorStatement', 1); DBD::Oracle::db->install_method($_) for qw/ ora_lob_read ora_lob_write ora_lob_append ora_lob_trim ora_lob_length ora_lob_chunk_size ora_lob_is_init ora_nls_parameters ora_can_unicode ora_can_taf ora_db_startup ora_db_shutdown /; DBD::Oracle::st->install_method($_) for qw/ ora_fetch_scroll ora_scroll_position ora_ping ora_stmt_type_name ora_stmt_type /; $drh; } END { # Used to silence 'Bad free() ...' warnings caused by bugs in Oracle's code # being detected by Perl's malloc. $ENV{PERL_BADFREE} = 0; #undef $Win32::TieRegistry::Registry if $Win32::TieRegistry::Registry; } sub AUTOLOAD { (my $constname = $AUTOLOAD) =~ s/.*:://; my $val = constant($constname); *$AUTOLOAD = sub { $val }; goto &$AUTOLOAD; } } { package # hide from PAUSE DBD::Oracle::dr; # ====== DRIVER ====== use strict; my %dbnames = (); # holds list of known databases (oratab + tnsnames) sub load_dbnames { my ($drh) = @_; my $debug = $drh->debug; my $oracle_home = DBD::Oracle::ora_env_var($ORACLE_ENV); local *FH; my $d; if (($^O eq 'MSWin32') or ($^O =~ /cygwin/i)) { # XXX experimental, will probably change $drh->trace_msg("Trying to fetch ORACLE_HOME and ORACLE_SID from the registry.\n") if $debug; my $sid = DBD::Oracle::ora_env_var("ORACLE_SID"); $dbnames{$sid} = $oracle_home if $sid and $oracle_home; $drh->trace_msg("Found $sid \@ $oracle_home.\n") if $debug && $sid; } # get list of 'local' database SIDs from oratab foreach $d (qw(/etc /var/opt/oracle), DBD::Oracle::ora_env_var("TNS_ADMIN")) { next unless defined $d; next unless open(FH, "<$d/oratab"); $drh->trace_msg("Loading $d/oratab\n") if $debug; my $ot; while (defined($ot = )) { next unless $ot =~ m/^\s*(\w+)\s*:\s*(.*?)\s*:/; $dbnames{$1} = $2; # store ORACLE_HOME value $drh->trace_msg("Found $1 \@ $2.\n") if $debug; } close FH; last; } # get list of 'remote' database connection identifiers my @tns_admin = ( DBD::Oracle::ora_env_var("TNS_ADMIN"), '.' ); push @tns_admin, map { join '/', $oracle_home, $_ } 'network/admin', # OCI 7 and 8.1 'net80/admin', # OCI 8.0 if $oracle_home; push @tns_admin, '/var/opt/oracle', '/etc'; TNS_ADMIN: foreach $d ( grep { $_ and -d $_ } @tns_admin ) { open FH, '<', "$d/tnsnames.ora" or next TNS_ADMIN; $drh->trace_msg("Loading $d/tnsnames.ora\n") if $debug; local *_; while () { next unless m/^\s*([-\w\.]+)\s*=/; my $name = $1; $drh->trace_msg("Found $name. ".($dbnames{$name} ? "(oratab entry overridden)" : "")."\n") if $debug; $dbnames{$name} = 0; # exists but false (to distinguish from oratab) } close FH; last; } $dbnames{0} = 1; # mark as loaded (even if empty) } sub data_sources { my $drh = shift; load_dbnames($drh) unless %dbnames; my @names = sort keys %dbnames; my @sources = map { $_ ? ("dbi:Oracle:$_") : () } @names; return @sources; } sub connect { my ($drh, $dbname, $user, $auth, $attr)= @_; # Make 'sid=whatever' an alias for 'whatever'. # see RT91775 $dbname =~ s/^sid=([^;]+)$/$1/; if ($dbname =~ /;/) { my ($n,$v); $dbname =~ s/^\s+//; $dbname =~ s/\s+$//; my @dbname = map { ($n,$v) = split /\s*=\s*/, $_, -1; Carp::carp("DSN component '$_' is not in 'name=value' format") unless defined $v && defined $n; (uc($n), $v) } split /\s*;\s*/, $dbname; my %dbname = ( PROTOCOL => 'tcp', @dbname ); if ((exists $dbname{SERVER}) and ($dbname{SERVER} eq "POOLED")) { $attr->{ora_drcp}=1; } # extract main attributes for connect_data portion my @connect_data_attr = qw(SID INSTANCE_NAME SERVER SERVICE_NAME ); my %connect_data = map { ($_ => delete $dbname{$_}) } grep { exists $dbname{$_} } @connect_data_attr; my $connect_data = join "", map { "($_=$connect_data{$_})" } keys %connect_data; return $drh->DBI::set_err(-1, "Can't connect using this syntax without specifying a HOST and one of @connect_data_attr") unless $dbname{HOST} and %connect_data; my @addrs = map { "($_=$dbname{$_})" } keys %dbname; my $addrs = join "", @addrs; if ($dbname{PORT}) { $addrs = "(ADDRESS=$addrs)"; } else { $addrs = "(ADDRESS_LIST=(ADDRESS=$addrs(PORT=1526))" . "(ADDRESS=$addrs(PORT=1521)))"; } $dbname = "(DESCRIPTION=$addrs(CONNECT_DATA=$connect_data))"; $drh->trace_msg("connect using '$dbname'"); } # If the application is asking for specific database # then we may have to mung the dbname $dbname = $1 if !$dbname && $user && $user =~ s/\@(.*)//s; $drh->trace_msg("$ORACLE_ENV environment variable not set\n") if !$ENV{$ORACLE_ENV} and $^O ne "MSWin32"; # create a 'blank' dbh $user = '' if not defined $user; (my $user_only = $user) =~ s:/.*::; if (substr($dbname,-7,7) eq ':POOLED'){ $dbname=substr($dbname,0,-7); $attr->{ora_drcp} = 1; } elsif ($ENV{ORA_DRCP}){ $attr->{ora_drcp} = 1; } my ($dbh, $dbh_inner) = DBI::_new_dbh($drh, { 'Name' => $dbname, 'dbi_imp_data' => $attr->{dbi_imp_data}, # these two are just for backwards compatibility 'USER' => uc $user_only, 'CURRENT_USER' => uc $user_only, }); # Call Oracle OCI logon func in Oracle.xs file # and populate internal handle data. if (exists $ENV{ORA_DRCP_CLASS}) { $attr->{ora_drcp_class} = $ENV{ORA_DRCP_CLASS} } if($attr->{ora_drcp_class}){ # if using ora_drcp_class it cannot contain more than 1024 bytes # and cannot contain a * if (index($attr->{ora_drcp_class},'*') !=-1){ Carp::croak("ora_drcp_class cannot contain a '*'!"); } if (length($attr->{ora_drcp_class}) > 1024){ Carp::croak("ora_drcp_class must be less than 1024 characters!"); } } if (exists $ENV{ORA_DRCP_MIN}) { $attr->{ora_drcp_min} = $ENV{ORA_DRCP_MIN} } if (exists $ENV{ORA_DRCP_MAX}) { $attr->{ora_drcp_max} = $ENV{ORA_DRCP_MAX} } if (exists $ENV{ORA_DRCP_INCR}) { $attr->{ora_drcp_incr} = $ENV{ORA_DRCP_INCR} } { local @SIG{ @{ $attr->{ora_connect_with_default_signals} } } if $attr->{ora_connect_with_default_signals}; DBD::Oracle::db::_login($dbh, $dbname, $user, $auth, $attr) or return undef; } unless (length $user_only) { $user_only = $dbh->selectrow_array(q{ SELECT SYS_CONTEXT('userenv','session_user') FROM DUAL })||''; $dbh_inner->{Username} = $user_only; # these two are just for backwards compatibility $dbh_inner->{USER} = $dbh_inner->{CURRENT_USER} = uc $user_only; } if ($ENV{ORA_DBD_NCS_BUFFER}){ $dbh->{'ora_ncs_buff_mtpl'}= $ENV{ORA_DBD_NCS_BUFFER}; } $dbh; } sub private_attribute_info { return { ora_home_key=>undef}; } } { package # hide from PAUSE DBD::Oracle::db; # ====== DATABASE ====== use strict; use DBI qw(:sql_types); sub prepare { my($dbh, $statement, @attribs)= @_; # create a 'blank' sth my $sth = DBI::_new_sth($dbh, { 'Statement' => $statement, }); # Call Oracle OCI parse func in Oracle.xs file. # and populate internal handle data. DBD::Oracle::st::_prepare($sth, $statement, @attribs) or return undef; $sth; } #Ah! I see you have the machine that goes PING!! #Yes!! We leased it from the company that made it #then the cost came out of the operating budget #not the capital ... sub ping { my($dbh) = @_; local $@; my $ok = 0; eval { local $SIG{__DIE__}; local $SIG{__WARN__}; $ok=ora_ping($dbh); }; return ($@) ? 0 : $ok; } sub get_info { my($dbh, $info_type) = @_; require DBD::Oracle::GetInfo; my $v = $DBD::Oracle::GetInfo::info{int($info_type)}; $v = $v->($dbh) if ref $v eq 'CODE'; return $v; } sub private_attribute_info { #this should only be for ones that have setters and getters return { ora_max_nested_cursors => undef, ora_array_chunk_size => undef, ora_ph_type => undef, ora_ph_csform => undef, ora_parse_error_offset => undef, ora_dbh_share => undef, ora_envhp => undef, ora_svchp => undef, ora_errhp => undef, ora_init_mode => undef, ora_charset => undef, ora_ncharset => undef, ora_session_mode => undef, ora_verbose => undef, ora_oci_success_warn => undef, ora_objects => undef, ora_ncs_buff_mtpl => undef, ora_drcp => undef, ora_drcp_class => undef, ora_drcp_min => undef, ora_drcp_max => undef, ora_drcp_incr => undef, ora_oratab_orahome => undef, ora_module_name => undef, ora_driver_name => undef, ora_client_info => undef, ora_client_identifier => undef, ora_action => undef, ora_taf_function => undef, }; } sub table_info { my($dbh, $CatVal, $SchVal, $TblVal, $TypVal) = @_; # XXX add knowledge of temp tables, etc # SQL/CLI (ISO/IEC JTC 1/SC 32 N 0595), 6.63 Tables if (ref $CatVal eq 'HASH') { ($CatVal, $SchVal, $TblVal, $TypVal) = @$CatVal{'TABLE_CAT','TABLE_SCHEM','TABLE_NAME','TABLE_TYPE'}; } my @Where = (); my $SQL; if ( defined $CatVal && $CatVal eq '%' && (!defined $SchVal || $SchVal eq '') && (!defined $TblVal || $TblVal eq '')) { # Rule 19a $SQL = <<'SQL'; SELECT NULL TABLE_CAT , NULL TABLE_SCHEM , NULL TABLE_NAME , NULL TABLE_TYPE , NULL REMARKS FROM DUAL SQL } elsif ( defined $SchVal && $SchVal eq '%' && (!defined $CatVal || $CatVal eq '') && (!defined $TblVal || $TblVal eq '')) { # Rule 19b $SQL = <<'SQL'; SELECT NULL TABLE_CAT , s TABLE_SCHEM , NULL TABLE_NAME , NULL TABLE_TYPE , NULL REMARKS FROM ( SELECT USERNAME s FROM ALL_USERS UNION SELECT 'PUBLIC' s FROM DUAL ) ORDER BY TABLE_SCHEM SQL } elsif ( defined $TypVal && $TypVal eq '%' && (!defined $CatVal || $CatVal eq '') && (!defined $SchVal || $SchVal eq '') && (!defined $TblVal || $TblVal eq '')) { # Rule 19c $SQL = <<'SQL'; SELECT NULL TABLE_CAT , NULL TABLE_SCHEM , NULL TABLE_NAME , t.tt TABLE_TYPE , NULL REMARKS FROM ( SELECT 'TABLE' tt FROM DUAL UNION SELECT 'VIEW' tt FROM DUAL UNION SELECT 'SYNONYM' tt FROM DUAL UNION SELECT 'SEQUENCE' tt FROM DUAL ) t ORDER BY TABLE_TYPE SQL } else { $SQL = <<'SQL'; SELECT * FROM ( SELECT /*+ CHOOSE */ NULL TABLE_CAT , t.OWNER TABLE_SCHEM , t.TABLE_NAME TABLE_NAME , decode(t.OWNER , 'SYS' , 'SYSTEM ' , 'SYSTEM' , 'SYSTEM ' , '' ) || t.TABLE_TYPE TABLE_TYPE , c.COMMENTS REMARKS FROM ALL_TAB_COMMENTS c , ALL_CATALOG t WHERE c.OWNER (+) = t.OWNER AND c.TABLE_NAME (+) = t.TABLE_NAME AND c.TABLE_TYPE (+) = t.TABLE_TYPE ) SQL if ( defined $SchVal ) { push @Where, "TABLE_SCHEM LIKE '$SchVal' ESCAPE '\\'"; } if ( defined $TblVal ) { push @Where, "TABLE_NAME LIKE '$TblVal' ESCAPE '\\'"; } if ( defined $TypVal ) { my $table_type_list; $TypVal =~ s/^\s+//; $TypVal =~ s/\s+$//; my @ttype_list = split (/\s*,\s*/, $TypVal); foreach my $table_type (@ttype_list) { if ($table_type !~ /^'.*'$/) { $table_type = "'" . $table_type . "'"; } $table_type_list = join(", ", @ttype_list); } push @Where, "TABLE_TYPE IN ($table_type_list)"; } $SQL .= ' WHERE ' . join("\n AND ", @Where ) . "\n" if @Where; $SQL .= " ORDER BY TABLE_TYPE, TABLE_SCHEM, TABLE_NAME\n"; } my $sth = $dbh->prepare($SQL) or return undef; $sth->execute or return undef; $sth; } sub primary_key_info { my($dbh, $catalog, $schema, $table) = @_; if (ref $catalog eq 'HASH') { ($schema, $table) = @$catalog{'TABLE_SCHEM','TABLE_NAME'}; $catalog = undef; } my $SQL = <<'SQL'; SELECT * FROM ( SELECT /*+ CHOOSE */ NULL TABLE_CAT , c.OWNER TABLE_SCHEM , c.TABLE_NAME TABLE_NAME , c.COLUMN_NAME COLUMN_NAME , c.POSITION KEY_SEQ , c.CONSTRAINT_NAME PK_NAME FROM ALL_CONSTRAINTS p , ALL_CONS_COLUMNS c WHERE p.OWNER = c.OWNER AND p.TABLE_NAME = c.TABLE_NAME AND p.CONSTRAINT_NAME = c.CONSTRAINT_NAME AND p.CONSTRAINT_TYPE = 'P' ) WHERE TABLE_SCHEM = ? AND TABLE_NAME = ? ORDER BY TABLE_SCHEM, TABLE_NAME, KEY_SEQ SQL #warn "@_\n$Sql ($schema, $table)"; my $sth = $dbh->prepare($SQL) or return undef; $sth->execute($schema, $table) or return undef; $sth; } sub foreign_key_info { my $dbh = shift; my $attr = ( ref $_[0] eq 'HASH') ? $_[0] : { 'UK_TABLE_SCHEM' => $_[1],'UK_TABLE_NAME ' => $_[2] ,'FK_TABLE_SCHEM' => $_[4],'FK_TABLE_NAME ' => $_[5] }; my $SQL = <<'SQL'; # XXX: DEFERABILITY SELECT * FROM ( SELECT /*+ CHOOSE */ to_char( NULL ) UK_TABLE_CAT , uk.OWNER UK_TABLE_SCHEM , uk.TABLE_NAME UK_TABLE_NAME , uc.COLUMN_NAME UK_COLUMN_NAME , to_char( NULL ) FK_TABLE_CAT , fk.OWNER FK_TABLE_SCHEM , fk.TABLE_NAME FK_TABLE_NAME , fc.COLUMN_NAME FK_COLUMN_NAME , uc.POSITION ORDINAL_POSITION , 3 UPDATE_RULE , decode( fk.DELETE_RULE, 'CASCADE', 0, 'RESTRICT', 1, 'SET NULL', 2, 'NO ACTION', 3, 'SET DEFAULT', 4 ) DELETE_RULE , fk.CONSTRAINT_NAME FK_NAME , uk.CONSTRAINT_NAME UK_NAME , to_char( NULL ) DEFERABILITY , decode( uk.CONSTRAINT_TYPE, 'P', 'PRIMARY', 'U', 'UNIQUE') UNIQUE_OR_PRIMARY FROM ALL_CONSTRAINTS uk , ALL_CONS_COLUMNS uc , ALL_CONSTRAINTS fk , ALL_CONS_COLUMNS fc WHERE uk.OWNER = uc.OWNER AND uk.CONSTRAINT_NAME = uc.CONSTRAINT_NAME AND fk.OWNER = fc.OWNER AND fk.CONSTRAINT_NAME = fc.CONSTRAINT_NAME AND uk.CONSTRAINT_TYPE IN ('P','U') AND fk.CONSTRAINT_TYPE = 'R' AND uk.CONSTRAINT_NAME = fk.R_CONSTRAINT_NAME AND uk.OWNER = fk.R_OWNER AND uc.POSITION = fc.POSITION ) WHERE 1 = 1 SQL my @BindVals = (); while ( my ( $k, $v ) = each %$attr ) { if ( $v ) { $SQL .= " AND $k = ?\n"; push @BindVals, $v; } } $SQL .= " ORDER BY UK_TABLE_SCHEM, UK_TABLE_NAME, FK_TABLE_SCHEM, FK_TABLE_NAME, ORDINAL_POSITION\n"; my $sth = $dbh->prepare( $SQL ) or return undef; $sth->execute( @BindVals ) or return undef; $sth; } sub column_info { my $dbh = shift; my $attr = ( ref $_[0] eq 'HASH') ? $_[0] : { 'TABLE_SCHEM' => $_[1],'TABLE_NAME' => $_[2],'COLUMN_NAME' => $_[3] }; my $ora_server_version = ora_server_version($dbh); my($typecase,$typecaseend, $choose) = ('','','/*+ CHOOSE */'); if ($ora_server_version->[0] >= 8) { $typecase = <<'SQL'; CASE WHEN tc.DATA_TYPE LIKE 'TIMESTAMP% WITH% TIME ZONE' THEN 95 WHEN tc.DATA_TYPE LIKE 'TIMESTAMP%' THEN 93 WHEN tc.DATA_TYPE LIKE 'INTERVAL DAY% TO SECOND%' THEN 110 WHEN tc.DATA_TYPE LIKE 'INTERVAL YEAR% TO MONTH' THEN 107 ELSE SQL $typecaseend = 'END'; } elsif ($ora_server_version->[0] >= 11) { # rt91217 CHOOSE hint deprecated $choose = ''; } my $char_length = $ora_server_version->[0] < 9 ? 'DATA_LENGTH':'CHAR_LENGTH'; my $SQL = <<"SQL"; SELECT * FROM ( SELECT $choose to_char( NULL ) TABLE_CAT , tc.OWNER TABLE_SCHEM , tc.TABLE_NAME TABLE_NAME , tc.COLUMN_NAME COLUMN_NAME , $typecase decode( tc.DATA_TYPE , 'MLSLABEL' , -9106 , 'ROWID' , -9104 , 'UROWID' , -9104 , 'BFILE' , -4 -- 31? , 'LONG RAW' , -4 , 'RAW' , -3 , 'LONG' , -1 , 'UNDEFINED', 0 , 'CHAR' , 1 , 'NCHAR' , 1 , 'NUMBER' , decode( tc.DATA_SCALE, NULL, 8, 3 ) , 'FLOAT' , 8 , 'VARCHAR2' , 12 , 'NVARCHAR2', 12 , 'BLOB' , 30 , 'CLOB' , 40 , 'NCLOB' , 40 , 'DATE' , 93 , NULL ) $typecaseend DATA_TYPE -- ... , tc.DATA_TYPE TYPE_NAME -- std.? , decode( tc.DATA_TYPE , 'LONG RAW' , 2147483647 , 'LONG' , 2147483647 , 'CLOB' , 2147483647 , 'NCLOB' , 2147483647 , 'BLOB' , 2147483647 , 'BFILE' , 2147483647 , 'NUMBER' , decode( tc.DATA_SCALE , NULL, 126 , nvl( tc.DATA_PRECISION, 38 ) ) , 'FLOAT' , tc.DATA_PRECISION , 'DATE' , 19 , 'VARCHAR2' , tc.$char_length , 'CHAR' , tc.$char_length , 'NVARCHAR2', tc.$char_length , 'NCHAR' , tc.$char_length , tc.DATA_LENGTH ) COLUMN_SIZE , decode( tc.DATA_TYPE , 'LONG RAW' , 2147483647 , 'LONG' , 2147483647 , 'CLOB' , 2147483647 , 'NCLOB' , 2147483647 , 'BLOB' , 2147483647 , 'BFILE' , 2147483647 , 'NUMBER' , nvl( tc.DATA_PRECISION, 38 ) + 2 , 'FLOAT' , 8 -- ? , 'DATE' , 16 , tc.DATA_LENGTH ) BUFFER_LENGTH , decode( tc.DATA_TYPE , 'DATE' , 0 , tc.DATA_SCALE ) DECIMAL_DIGITS -- ... , decode( tc.DATA_TYPE , 'FLOAT' , 2 , 'NUMBER' , decode( tc.DATA_SCALE, NULL, 2, 10 ) , NULL ) NUM_PREC_RADIX , decode( tc.NULLABLE , 'Y' , 1 , 'N' , 0 , NULL ) NULLABLE , cc.COMMENTS REMARKS , tc.DATA_DEFAULT COLUMN_DEF -- Column is LONG! , decode( tc.DATA_TYPE , 'MLSLABEL' , -9106 , 'ROWID' , -9104 , 'UROWID' , -9104 , 'BFILE' , -4 -- 31? , 'LONG RAW' , -4 , 'RAW' , -3 , 'LONG' , -1 , 'UNDEFINED', 0 , 'CHAR' , 1 , 'NCHAR' , 1 , 'NUMBER' , decode( tc.DATA_SCALE, NULL, 8, 3 ) , 'FLOAT' , 8 , 'VARCHAR2' , 12 , 'NVARCHAR2', 12 , 'BLOB' , 30 , 'CLOB' , 40 , 'NCLOB' , 40 , 'DATE' , 9 -- not 93! , NULL ) SQL_DATA_TYPE -- ... , decode( tc.DATA_TYPE , 'DATE' , 3 , NULL ) SQL_DATETIME_SUB -- ... , to_number( NULL ) CHAR_OCTET_LENGTH -- TODO , tc.COLUMN_ID ORDINAL_POSITION , decode( tc.NULLABLE , 'Y' , 'YES' , 'N' , 'NO' , NULL ) IS_NULLABLE FROM ALL_TAB_COLUMNS tc , ALL_COL_COMMENTS cc WHERE tc.OWNER = cc.OWNER AND tc.TABLE_NAME = cc.TABLE_NAME AND tc.COLUMN_NAME = cc.COLUMN_NAME ) WHERE 1 = 1 SQL my @BindVals = (); while ( my ( $k, $v ) = each %$attr ) { if ( $v ) { $SQL .= " AND $k LIKE ? ESCAPE '\\'\n"; push @BindVals, $v; } } $SQL .= " ORDER BY TABLE_SCHEM, TABLE_NAME, ORDINAL_POSITION\n"; # Since DATA_DEFAULT is a LONG, DEFAULT values longer than 80 chars will # throw an ORA-24345 by default; so we check if LongReadLen is set at # the default value, and if so, set it to something less likely to fail # in common usage. # # We do not set LongTruncOk however as that would make COLUMN_DEF # incorrect, in those (extreme!) cases it would be better if the user # sets LongReadLen herself. my $long_read_len = $dbh->FETCH('LongReadLen'); my ($sth, $exc); { local $@; eval { $dbh->STORE(LongReadLen => 1024*1024) if $long_read_len == 80; $sth = $dbh->prepare( $SQL ); }; $exc = $@; } if ($exc) { $dbh->STORE(LongReadLen => 80) if $long_read_len == 80; die $exc; } $dbh->STORE(LongReadLen => 80) if $long_read_len == 80; return undef if not $sth; $sth->execute( @BindVals ) or return undef; $sth; } sub statistics_info { my($dbh, $catalog, $schema, $table, $unique_only, $quick) = @_; if (ref $catalog eq 'HASH') { ($schema, $table) = @$catalog{'TABLE_SCHEM','TABLE_NAME'}; $catalog = undef; } my $choose = '/*+ CHOOSE */'; my $ora_server_version = ora_server_version($dbh); if ($ora_server_version->[0] >= 11) { # rt91217 CHOOSE hint deprecated $choose = ''; } my $SQL = <<"SQL"; SELECT * FROM ( SELECT $choose NULL TABLE_CAT , t.OWNER TABLE_SCHEM , t.TABLE_NAME TABLE_NAME , to_number( NULL ) NON_UNIQUE , NULL INDEX_QUALIFIER , NULL INDEX_NAME ,'table' TYPE , to_number( NULL ) ORDINAL_POSITION , NULL COLUMN_NAME , NULL ASC_OR_DESC , t.NUM_ROWS CARDINALITY , t.BLOCKS PAGES , NULL FILTER_CONDITION FROM ALL_TABLES t UNION SELECT NULL TABLE_CAT , t.OWNER TABLE_SCHEM , t.TABLE_NAME TABLE_NAME , decode( t.UNIQUENESS,'UNIQUE', 0, 1 ) NON_UNIQUE , c.INDEX_OWNER INDEX_QUALIFIER , c.INDEX_NAME INDEX_NAME , decode( t.INDEX_TYPE,'NORMAL','btree','CLUSTER','clustered','other') TYPE , c.COLUMN_POSITION ORDINAL_POSITION , c.COLUMN_NAME COLUMN_NAME , decode( c.DESCEND,'ASC','A','DESC','D') ASC_OR_DESC , t.DISTINCT_KEYS CARDINALITY , t.LEAF_BLOCKS PAGES , NULL FILTER_CONDITION FROM ALL_INDEXES t , ALL_IND_COLUMNS c WHERE t.OWNER = c.INDEX_OWNER AND t.INDEX_NAME = c.INDEX_NAME AND t.TABLE_OWNER = c.TABLE_OWNER AND t.TABLE_NAME = c.TABLE_NAME AND t.UNIQUENESS LIKE :3 ) WHERE TABLE_SCHEM = :1 AND TABLE_NAME = :2 ORDER BY NON_UNIQUE, TYPE, INDEX_QUALIFIER, INDEX_NAME, ORDINAL_POSITION SQL my $sth = $dbh->prepare($SQL) or return undef; $sth->execute($schema, $table, $unique_only ?'UNIQUE':'%') or return undef; $sth; } sub type_info_all { my ($dbh) = @_; my $version = ( ora_server_version($dbh)->[0] < DBD::Oracle::ORA_OCI() ) ? ora_server_version($dbh)->[0] : DBD::Oracle::ORA_OCI(); my $vc2len = ( $version < 8 ) ? "2000" : "4000"; my $type_info_all = [ { TYPE_NAME => 0, DATA_TYPE => 1, COLUMN_SIZE => 2, LITERAL_PREFIX => 3, LITERAL_SUFFIX => 4, CREATE_PARAMS => 5, NULLABLE => 6, CASE_SENSITIVE => 7, SEARCHABLE => 8, UNSIGNED_ATTRIBUTE => 9, FIXED_PREC_SCALE => 10, AUTO_UNIQUE_VALUE => 11, LOCAL_TYPE_NAME => 12, MINIMUM_SCALE => 13, MAXIMUM_SCALE => 14, SQL_DATA_TYPE => 15, SQL_DATETIME_SUB => 16, NUM_PREC_RADIX => 17, INTERVAL_PRECISION => 18, }, [ "LONG RAW", SQL_LONGVARBINARY, 2147483647,"'", "'", undef, 1,0,0,undef,0,undef, "LONG RAW", undef,undef,SQL_LONGVARBINARY,undef,undef,undef, ], [ "RAW", SQL_VARBINARY, 2000, "'", "'", "max length", 1,0,3,undef,0,undef, "RAW", undef,undef,SQL_VARBINARY, undef,undef,undef, ], [ "LONG", SQL_LONGVARCHAR, 2147483647,"'", "'", undef, 1,1,0,undef,0,undef, "LONG", undef,undef,SQL_LONGVARCHAR, undef,undef,undef, ], [ "CHAR", SQL_CHAR, 2000, "'", "'", "max length", 1,1,3,undef,0,0, "CHAR", undef,undef,SQL_CHAR, undef,undef,undef, ], [ "DECIMAL", SQL_DECIMAL, 38, undef,undef, "precision,scale",1,0,3,0, 0,0, "DECIMAL", 0, 38, SQL_DECIMAL, undef,10, undef, ], [ "DOUBLE PRECISION",SQL_DOUBLE, 15, undef,undef, undef, 1,0,3,0, 0,0, "DOUBLE PRECISION",undef,undef,SQL_DOUBLE, undef,10, undef, ], [ "DATE", SQL_TYPE_TIMESTAMP,19, "'", "'", undef, 1,0,3,undef,0,0, "DATE", 0, 0, SQL_DATE, 3, undef,undef, ], [ "VARCHAR2", SQL_VARCHAR, $vc2len, "'", "'", "max length", 1,1,3,undef,0,0, "VARCHAR2", undef,undef,SQL_VARCHAR, undef,undef,undef, ], [ "BLOB", SQL_BLOB, 2147483647,"'", "'", undef, 1,1,0,undef,0,undef, "BLOB", undef,undef,SQL_LONGVARBINARY,undef,undef,undef, ], [ "BFILE", -9114, 2147483647,"'", "'", undef, 1,1,0,undef,0,undef, "BFILE", undef,undef,SQL_LONGVARBINARY,undef,undef,undef, ], [ "CLOB", SQL_CLOB, 2147483647,"'", "'", undef, 1,1,0,undef,0,undef, "CLOB", undef,undef,SQL_LONGVARCHAR, undef,undef,undef, ], ["TIMESTAMP WITH TIME ZONE", # type name SQL_TYPE_TIMESTAMP_WITH_TIMEZONE, # data type 40, # column size "TIMESTAMP'", # literal prefix "'", # literal suffix "precision", # create params 1, # nullable 0, # case sensitive 3, # searchable undef, # unsigned attribute 0, # fixed prec scale 0, # auto unique value undef, # local type name 0, # minimum scale 6, # maximum scale SQL_TIMESTAMP, # sql data type 5, # sql datetime sub undef, # num prec radix undef, # interval precision ], [ "INTERVAL DAY TO SECOND", # type name SQL_INTERVAL_DAY_TO_SECOND, # data type 22, # column size '+00 11:12:10.222222200' "INTERVAL'", # literal prefix "'", # literal suffix "precision", # create params 1, # nullable 0, # case sensitive 3, # searchable undef, # unsigned attribute 0, # fixed prec scale 0, # auto unique value undef, # local type name 0, # minimum scale 9, # maximum scale SQL_INTERVAL, # sql data type 10, # sql datetime sub undef, # num prec radix undef, # interval precision ], [ "INTERVAL YEAR TO MONTH", # type name SQL_INTERVAL_YEAR_TO_MONTH, # data type 13, # column size '+012345678-01' "INTERVAL'", # literal prefix "'", # literal suffix "precision", # create params 1, # nullable 0, # case sensitive 3, # searchable undef, # unsigned attribute 0, # fixed prec scale 0, # auto unique value undef, # local type name 0, # minimum scale 9, # maximum scale SQL_INTERVAL, # sql data type 7, # sql datetime sub undef, # num prec radix undef, # interval precision ] ]; return $type_info_all; } sub plsql_errstr { # original version thanks to Bob Menteer my $sth = shift->prepare_cached(q{ SELECT name, type, line, position, text FROM user_errors ORDER BY name, type, sequence }) or return undef; $sth->execute or return undef; my ( @msg, $oname, $otype, $name, $type, $line, $pos, $text ); $oname = $otype = 0; while ( ( $name, $type, $line, $pos, $text ) = $sth->fetchrow_array ) { if ( $oname ne $name || $otype ne $type ) { push @msg, "Errors for $type $name:"; $oname = $name; $otype = $type; } push @msg, "$line.$pos: $text"; } return join( "\n", @msg ); } # # note, dbms_output must be enabled prior to usage # sub dbms_output_enable { my ($dbh, $buffersize) = @_; $buffersize ||= 20000; # use oracle 7.x default $dbh->do("begin dbms_output.enable(:1); end;", undef, $buffersize); } sub dbms_output_get { my $dbh = shift; my $sth = $dbh->prepare_cached("begin dbms_output.get_line(:l, :s); end;") or return; my ($line, $status, @lines); my $version = join ".", @{ ora_server_version($dbh) }[0..1]; my $len = 32767; if ($version < 10.2){ $len = 400; } # line can be greater that 255 (e.g. 7 byte date is expanded on output) $sth->bind_param_inout(':l', \$line, $len, { ora_type => 1 }); $sth->bind_param_inout(':s', \$status, 20, { ora_type => 1 }); if (!wantarray) { $sth->execute or return undef; return $line if $status eq '0'; return undef; } push @lines, $line while($sth->execute && $status eq '0'); return @lines; } sub dbms_output_put { my $dbh = shift; my $sth = $dbh->prepare_cached("begin dbms_output.put_line(:1); end;") or return; my $line; foreach $line (@_) { $sth->execute($line) or return; } return 1; } sub dbms_msgpipe_get { my $dbh = shift; my $sth = $dbh->prepare_cached(q{ begin dbms_msgpipe.get_request(:returnpipe, :proc, :param); end; }) or return; my $msg = ['','','']; $sth->bind_param_inout(":returnpipe", \$msg->[0], 30); $sth->bind_param_inout(":proc", \$msg->[1], 30); $sth->bind_param_inout(":param", \$msg->[2], 4000); $sth->execute or return undef; return $msg; } sub dbms_msgpipe_ack { my $dbh = shift; my $msg = shift; my $sth = $dbh->prepare_cached(q{ begin dbms_msgpipe.acknowledge(:returnpipe, :errormsg, :param); end;}) or return; $sth->bind_param_inout(":returnpipe", \$msg->[0], 30); $sth->bind_param_inout(":proc", \$msg->[1], 30); $sth->bind_param_inout(":param", \$msg->[2], 4000); $sth->execute or return undef; return 1; } sub ora_server_version { my $dbh = shift; return $dbh->{ora_server_version} if defined $dbh->{ora_server_version}; my $banner = $dbh->selectrow_array(<<'SQL', undef, 'Oracle%', 'Personal Oracle%'); SELECT banner FROM v$version WHERE banner LIKE ? OR banner LIKE ? SQL if (defined $banner) { my @version = $banner =~ /(?:^|\s)(\d+)\.(\d+)\.(\d+)\.(\d+)\.(\d+)(?:\s|$)/; $dbh->{ora_server_version} = \@version if @version; } } sub ora_nls_parameters { my $dbh = shift; my $refresh = shift; if ($refresh || !$dbh->{ora_nls_parameters}) { my $nls_parameters = $dbh->selectall_arrayref(q{ SELECT parameter, value FROM v$nls_parameters }) or return; $dbh->{ora_nls_parameters} = { map { $_->[0] => $_->[1] } @$nls_parameters }; } # return copy of params to protect against accidental editing my %nls = %{$dbh->{ora_nls_parameters}}; return \%nls; } sub ora_can_unicode { my $dbh = shift; my $refresh = shift; # 0 = No Unicode support. # 1 = National character set is Unicode-based. # 2 = Database character set is Unicode-based. # 3 = Both character sets are Unicode-based. return $dbh->{ora_can_unicode} if defined $dbh->{ora_can_unicode} && !$refresh; my $nls = $dbh->ora_nls_parameters($refresh); $dbh->{ora_can_unicode} = 0; $dbh->{ora_can_unicode} += 1 if $nls->{NLS_NCHAR_CHARACTERSET} =~ /UTF/; $dbh->{ora_can_unicode} += 2 if $nls->{NLS_CHARACTERSET} =~ /UTF/; return $dbh->{ora_can_unicode}; } } # end of package DBD::Oracle::db { package # hide from PAUSE DBD::Oracle::st; # ====== STATEMENT ====== sub bind_param_inout_array { my $sth = shift; my ($p_id, $value_array,$maxlen, $attr) = @_; return $sth->set_err($DBI::stderr, "Value for parameter $p_id must be an arrayref, not a ".ref($value_array)) if defined $value_array and ref $value_array and ref $value_array ne 'ARRAY'; return $sth->set_err($DBI::stderr, "Can't use named placeholder '$p_id' for non-driver supported bind_param_inout_array") unless DBI::looks_like_number($p_id); # because we rely on execute(@ary) here return $sth->set_err($DBI::stderr, "Placeholder '$p_id' is out of range") if $p_id <= 0; # can't easily/reliably test for too big # get/create arrayref to hold params my $hash_of_arrays = $sth->{ParamArrays} ||= { }; $$hash_of_arrays{$p_id} = $value_array; return ora_bind_param_inout_array($sth, $p_id, $value_array,$maxlen, $attr); 1; } sub execute_for_fetch { my ($sth, $fetch_tuple_sub, $tuple_status) = @_; my $row_count = 0; my $err_total = 0; my $tuple_count="0E0"; my $tuple_batch_status; my $dbh = $sth->{Database}; my $batch_size =($dbh->{'ora_array_chunk_size'}||= 1000); if(defined($tuple_status)) { @$tuple_status = (); $tuple_batch_status = [ ]; } my $finished; while (1) { my @tuple_batch; for (my $i = 0; $i < $batch_size; $i++) { $finished = $fetch_tuple_sub->(); push @tuple_batch, [@{$finished || last}]; } last unless @tuple_batch; my $err_count = 0; my $res = ora_execute_array($sth, \@tuple_batch, scalar(@tuple_batch), $tuple_batch_status, $err_count ); if(defined($res)) { #no error $row_count += $res; } else { $row_count = undef; } $err_total += $err_count; $tuple_count+=@tuple_batch; push @$tuple_status, @$tuple_batch_status if defined($tuple_status); last if !$finished; } #error check here return $sth->set_err($DBI::stderr, "executing $tuple_count generated $err_total errors") if $err_total; return wantarray ? ($tuple_count, defined $row_count ? $row_count : undef) : $tuple_count; } sub private_attribute_info { return { map { $_ => undef } qw/ ora_lengths ora_types ora_rowid ora_est_row_width ora_type ora_fail_over / }; } } 1; __END__ =pod =encoding UTF-8 =head1 NAME DBD::Oracle - Oracle database driver for the DBI module =head1 VERSION version 1.74 =head1 SYNOPSIS use DBI; $dbh = DBI->connect("dbi:Oracle:$dbname", $user, $passwd); $dbh = DBI->connect("dbi:Oracle:host=$host;sid=$sid", $user, $passwd); # See the DBI module documentation for full details # for some advanced uses you may need Oracle type values: use DBD::Oracle qw(:ora_types); =head1 DESCRIPTION DBD::Oracle is a Perl module which works with the DBI module to provide access to Oracle databases. This documentation describes driver specific behaviour and restrictions. It is not supposed to be used as the only reference for the user. In any case consult the L documentation first! =head1 CONSTANTS =over 4 =item :ora_session_modes ORA_SYSDBA ORA_SYSOPER ORA_SYSASM ORA_SYSBACKUP ORA_SYSDG ORA_SYSKM =item :ora_types ORA_VARCHAR2 ORA_STRING ORA_NUMBER ORA_LONG ORA_ROWID ORA_DATE ORA_RAW ORA_LONGRAW ORA_CHAR ORA_CHARZ ORA_MLSLABEL ORA_XMLTYPE ORA_CLOB ORA_BLOB ORA_RSET ORA_VARCHAR2_TABLE ORA_NUMBER_TABLE SQLT_INT SQLT_FLT ORA_OCI SQLT_CHR SQLT_BIN =item SQLCS_IMPLICIT =item SQLCS_NCHAR SQLCS_IMPLICIT and SQLCS_NCHAR are I values. See notes about Unicode elsewhere in this document. =item SQLT_INT =item SQLT_FLT These types are used only internally, and may be specified as internal bind type for ORA_NUMBER_TABLE. See notes about ORA_NUMBER_TABLE elsewhere in this document =item ORA_OCI Oracle doesn't provide a formal API for determining the exact version number of the OCI client library used, so DBD::Oracle has to go digging (and sometimes has to more or less guess). The ORA_OCI constant holds the result of that process. In string context ORA_OCI returns the full "A.B.C.D" version string. In numeric context ORA_OCI returns the major.minor version number (8.1, 9.2, 10.0 etc). But note that version numbers are not actually floating point and so if Oracle ever makes a release that has a two digit minor version, such as C<9.10> it will have a lower numeric value than the preceding C<9.9> release. So use with care. The contents and format of ORA_OCI are subject to change (it may, for example, become a I in later releases). I recommend that you avoid checking for exact values. =item :ora_fetch_orient OCI_FETCH_CURRENT OCI_FETCH_NEXT OCI_FETCH_FIRST OCI_FETCH_LAST OCI_FETCH_PRIOR OCI_FETCH_ABSOLUTE OCI_FETCH_RELATIVE These constants are used to set the orientation of a fetch on a scrollable cursor. =item :ora_exe_modes OCI_STMT_SCROLLABLE_READONLY =item :ora_fail_over OCI_FO_END OCI_FO_ABORT OCI_FO_REAUTH OCI_FO_BEGIN OCI_FO_ERROR OCI_FO_NONE OCI_FO_SESSION OCI_FO_SELECT OCI_FO_TXNAL OCI_FO_RETRY =back =head1 DBI CLASS METHODS =head2 B This method creates a database handle by connecting to a database, and is the DBI equivalent of the "new" method. To open a connection to an Oracle database you need to specify a database connection string (URL), username and password. The connection string is always of the form: "dbi:Oracle:" There are several ways to identify a database: =over =item 1 If the database is local, specifying the SID or service name will be enough. =item 2 If the database is defined in a TNSNAMES.ORA file, you can use the service name given in the file =item 3 To connect without TNSNAMES.ORA file, you can use an EZCONNECT url, of the form: //host[:port][/service_name] =back If port name is not specified, 1521 is the default. If service name is not specified, the hostname will be used as a service name. The following examples show several ways a connection can be created: $dbh = DBI->connect('dbi:Oracle:DB','username','password'); $dbh = DBI->connect('dbi:Oracle:DB','username/password',''); $dbh = DBI->connect('dbi:Oracle:','username@DB','password'); $dbh = DBI->connect('dbi:Oracle:host=foobar;sid=DB;port=1521', 'scott/tiger', ''); $dbh = DBI->connect("dbi:Oracle://myhost:1522/ORCL",'username', 'password'); =head3 OS authentication To connect to a local database with a user which has been set up to authenticate via the OS ("ALTER USER username IDENTIFIED EXTERNALLY"): $dbh = DBI->connect('dbi:Oracle:','/',''); Note the lack of a connection name (use the ORACLE_SID environment variable). If an explicit SID is used you will probably get an ORA-01004 error. That only works for local databases. (Authentication to remote Oracle databases using your Unix login name without a password is possible but it is not secure and not recommended so not documented here. =head3 Oracle Environment Variables To use DBD::ORACLE to connect to an Oracle database, ORACLE_HOME environment variable should be set correctly. In general, the value used should match the version of Oracle that was used to build DBD::Oracle. If using dynamic linking then ORACLE_HOME should match the version of Oracle that will be used to load in the Oracle client libraries (via LD_LIBRARY_PATH, ldconfig, or similar on Unix). Oracle can use two environment variables to specify default connections: ORACLE_SID and TWO_TASK. To use them, specify either a local SID or service name, or a service name that is specified in the TNSNAMES.ORA file. Note that if you have *both* local and remote databases, and you have ORACLE_SID *and* TWO_TASK set, and you don't specify a fully qualified connect string on the command line, TWO_TASK takes precedence over ORACLE_SID (i.e. you get connected to remote system). It is highly recommended not to rely on environment variables and to always explicitly specify the SID in the connection string. This can prevent serious mistakes such as dropping a schema in the wrong database, and generally makes debugging and troubleshooting easier. Also remember that depending on the operating system you are using the differing "ORACLE" environment variables may be case sensitive, so if you are not connecting as you should double check the case of both the variable and its value. =head3 Timezones If the query is run through SQL*Net (mostly queries that are executed on remote servers), Oracle will return the time zone based on the setting of the UNIX environment variable "TZ" for the user who started the listener. If the query is run locally, Oracle will return the time zone based on the "TZ" environment variable setting of the user running the query. With local queries, you can change the time zone for a particular user by simply changing the setting of "TZ". To check the current setting, issue the UNIX "date" command. =head3 Oracle DRCP DBD::Oracle supports DRCP (Database Resident Connection Pool) so if you have an 11.2 database and DRCP is enabled you can direct all of your connections to it by adding ':POOLED' to the SID or setting a connection attribute of ora_drcp, or set the SERVER=POOLED when using a TNSENTRY style connection or even by setting an environment variable ORA_DRCP. All of which are demonstrated below; $dbh = DBI->connect('dbi:Oracle:DB:POOLED','username','password') $dbh = DBI->connect('dbi:Oracle:','username@DB:POOLED','password') $dbh = DBI->connect('dbi:Oracle:DB','username','password',{ora_drcp=>1}) $dbh = DBI->connect('dbi:Oracle:DB','username','password',{ora_drcp=>1, ora_drcp_class=>'my_app', ora_drcp_min =>10}) $dbh = DBI->connect('dbi:Oracle:host=foobar;sid=ORCL;port=1521;SERVER=POOLED', 'scott/tiger', '') $dbh = DBI->connect('dbi:Oracle:', q{scott/tiger@(DESCRIPTION= (ADDRESS=(PROTOCOL=TCP)(HOST= foobar)(PORT=1521)) (CONNECT_DATA=(SID=ORCL)(SERVER=POOLED)))}, "") if the ORA_DRCP environment variable is set then just this $dbh = DBI->connect('dbi:Oracle:DB','username','password') You can find a white paper on setting up DRCP and its advantages at L. Please note that DRCP support in DBD::Oracle is relatively new so the mechanics or its implementation are subject to change. =head3 TAF (Transparent Application Failover) Transparent Application Failover (TAF) is the feature in OCI that allows for clients to automatically reconnect to an instance in the event of a failure of the instance. The reconnect happens automatically from within the OCI (Oracle Call Interface) library. DBD::Oracle now supports a callback function that will fire when a TAF event takes place. You may use the callback to inform the user a failover is taking place or to setup the session again once the failover has succeeded. You will have to set up TAF on your instance before you can use this callback. You can test your instance to see if you can use TAF callback with $dbh->ora_can_taf(); If you try to set up a callback without it being enabled DBD::Oracle will croak. NOTE: Currently, you must enable TAF during DBI's connect. However once enabled you can change the TAF settings. It is outside the scope of this document to go through all of the possible TAF situations you might want to set up but here is a simple example: The TNS entry for the instance has had the following added to the CONNECT_DATA section (FAILOVER_MODE= (TYPE=select) (METHOD=basic) (RETRIES=10) (DELAY=10)) You will also have to create your own perl function that will be called from the client. You can name it anything you want and it will always be passed two parameters, the failover event value and the failover type. You can also set a sleep value in case of failover error and the OCI client will sleep for the specified seconds before it attempts another event. use DBD::Oracle(qw(:ora_fail_over)); #import the ora fail over constants #set up TAF on the connection # NOTE since DBD::Oracle uses call_pv you may need to pass a full # name space as the function e.g., 'main::handle_taf' # NOTE from 1.49_00 ora_taf_function can accept a code ref as well # as a sub name as it now uses call_sv my $dbh = DBI->connect('dbi:Oracle:XE', 'hr', 'hr', {ora_taf_function => 'main::handle_taf'}); #create the perl TAF event function sub handle_taf { # NOTE from 1.49_00 the $dbh handle was passed to your callback my ($fo_event,$fo_type, $dbh) = @_; if ($fo_event == OCI_FO_BEGIN){ print " Instance Unavailable Please stand by!! \n"; printf(" Your TAF type is %s \n", (($fo_type==OCI_FO_NONE) ? "NONE" :($fo_type==OCI_FO_SESSION) ? "SESSION" :($fo_type==OCI_FO_SELECT) ? "SELECT" : "UNKNOWN!")); } elsif ($fo_event == OCI_FO_ABORT){ print " Failover aborted. Failover will not take place.\n"; } elsif ($fo_event == OCI_FO_END){ printf(" Failover ended ...Resuming your %s\n",(($fo_type==OCI_FO_NONE) ? "NONE" :($fo_type==OCI_FO_SESSION) ? "SESSION" :($fo_type==OCI_FO_SELECT) ? "SELECT" : "UNKNOWN!")); } elsif ($fo_event == OCI_FO_REAUTH){ print " Failed over user. Resuming services\n"; } elsif ($fo_event == OCI_FO_ERROR){ print " Failover error ...\n"; sleep 5; # sleep before having another go return OCI_FO_RETRY; } else { printf(" Bad Failover Event: %d.\n", $fo_event); } return 0; } The TAF types are as follows OCI_FO_SESSION indicates the user has requested only session failover. OCI_FO_SELECT indicates the user has requested select failover. OCI_FO_NONE indicates the user has not requested a failover type. OCI_FO_TXNAL indicates the user has requested a transaction failover. The TAF events are as follows OCI_FO_BEGIN indicates that failover has detected a lost connection and failover is starting. OCI_FO_END indicates successful completion of failover. OCI_FO_ABORT indicates that failover was unsuccessful, and there is no option of retrying. OCI_FO_ERROR also indicates that failover was unsuccessful, but it gives the application the opportunity to handle the error and retry failover. OCI_FO_REAUTH indicates that you have multiple authentication handles and failover has occurred after the original authentication. It indicates that a user handle has been re-authenticated. To find out which, the application checks the OCI_ATTR_SESSION attribute of the service context handle (which is the first parameter). =head3 Connect Attributes =head4 ora_ncs_buff_mtpl You can customize the size of the buffer when selecting LOBs with the built-in AUTO Lob. The default value is 4 which is probably excessive for most situations but is needed for backward compatibility. If you not converting between a NCS on the DB and the Client then you might want to set this to 1 to reduce memory usage. This value can also be specified with the C environment variable in which case it sets the value at the connect stage. =head4 ora_drcp For Oracle 11.2 or greater. Set to I<1> to enable DRCP. Can also be set via the C environment variable. =head4 ora_drcp_class If you are using DRCP, you can set a CONNECTION_CLASS for your pools as well. As sessions from a DRCP cannot be shared by users, you can use this setting to identify the same user across different applications. OCI will ensure that sessions belonging to a 'class' are not shared outside the class'. The values for ora_drcp_class cannot contain a '*' and must be less than 1024 characters. This value can be also be specified with the C environment variable. =head4 ora_drcp_min This optional value specifies the minimum number of sessions that are initially opened. New sessions are only opened after this value has been reached. The default value is 4 and any value above 0 is valid. Generally, it should be set to the number of concurrent statements the application is planning or expecting to run. This value can also be specified with the C environment variable. =head4 ora_drcp_max This optional value specifies the maximum number of sessions that can be open at one time. Once reached no more sessions can be opened until one becomes free. The default value is 40 and any value above 1 is valid. You should not set this value lower than ora_drcp_min as that will just waste resources. This value can also be specified with the C environment variable. =head4 ora_drcp_incr This optional value specifies the next increment for sessions to be started if the current number of sessions are less than ora_drcp_max. The default value is 2 and any value above 0 is valid as long as the value of ora_drcp_min + ora_drcp_incr is not greater than ora_drcp_max. This value can also be specified with the C environment variable. =head4 ora_taf This attribute was removed in 1.49_00 as it was redundant. To enable TAF simply set L. =head4 ora_taf_function If your Oracle instance has been configured to use TAF events you can enable the TAF callback by setting this option. The name of the Perl subroutine (or a code ref from 1.49_00) that will be called from OCI when a TAF event occurs. You must supply a perl function to use the callback and it will always receive at least two parameters; the failover event value and the failover type. From 1.49_00 the dbh is passed as the third argument. Below is an example of a TAF function sub taf_event{ # NOTE from 1.49_00 the $dbh handle is passed to the callback my ($event, $type, $dbh) = @_; print "My TAF event=$event\n"; print "My TAF type=$type\n"; return; } Note if passing a sub name you will probably have to use the full name space when setting the TAF function e.g., 'main::my_taf_function' and not just 'my_taf_function'. =head4 ora_taf_sleep This attribute was removed in 1.49_00 as it was redundant. If you want to sleep between retries simple add a sleep to your callback sub. =head4 ora_session_mode The ora_session_mode attribute can be used to connect with SYSDBA, SYSOPER, ORA_SYSASM, ORA_SYSBACKUP, ORA_SYSKM and ORA_SYSDG authorization. The ORA_SYSDBA, ORA_SYSOPER, ORA_SYSASM, ORA_SYSBACKUP, ORA_SYSKM and ORA_SYSDG constants can be imported using use DBD::Oracle qw(:ora_session_modes); This is one case where setting ORACLE_SID may be useful since connecting as SYSDBA or SYSOPER via SQL*Net is frequently disabled for security reasons. Example: $dsn = "dbi:Oracle:"; # no dbname here $ENV{ORACLE_SID} = "orcl"; # set ORACLE_SID as needed delete $ENV{TWO_TASK}; # make sure TWO_TASK isn't set $dbh = DBI->connect($dsn, "", "", { ora_session_mode => ORA_SYSDBA }); It has been reported that this only works if C<$dsn> does not contain a SID so that Oracle then uses the value of ORACLE_SID (not TWO_TASK) environment variable to connect to a local instance. Also the username and password should be empty, and the user executing the script needs to be part of the dba group or osdba group. =head4 ora_oratab_orahome Passing a true value for the ora_oratab_orahome attribute will make DBD::Oracle change C<$ENV{ORACLE_HOME}> to make the Oracle home directory that specified in the C file I the database to connect to is specified as a SID that exists in the oratab file, and DBD::Oracle was built to use the Oracle 7 OCI API (not Oracle 8+). =head4 ora_module_name After connecting to the database the value of this attribute is passed to the SET_MODULE() function in the C PL/SQL package. This can be used to identify the application to the DBA for monitoring and performance tuning purposes. For example: my $dbh = DBI->connect($dsn, $user, $passwd, { ora_module_name => $0 }); $dbh->{ora_module_name} = $y; The maximum size is 48 bytes. NOTE: You will need an Oracle client 10.1 or later to use this. =head4 ora_driver_name For 11g and later you can now set the name of the driver layer using OCI. Perl, Perl5, ApachePerl so on. Names starting with "ORA" are reserved. You can enter up to 8 characters. If none is enter then this will default to DBDOxxxx where xxxx is the current version number. This value can be retrieved on the server side using V$SESSION_CONNECT_INFO or GV$SESSION_CONNECT_INFO my $dbh = DBI->connect($dsn, $user, $passwd, { ora_driver_name => 'ModPerl_1' }); $dbh->{ora_driver_name} = $q; =head4 ora_client_info Allows you to add any value (up to 64 bytes) to your session and it can be retrieved on the server side from the Ca view. my $dbh = DBI->connect($dsn, $user, $passwd, { ora_client_info => 'Remote2' }); $dbh->{ora_client_info} = "Remote2"; NOTE: You will need an Oracle client 10.1 or later to use this. =head4 ora_client_identifier Allows you to specify the user identifier in the session handle. Most useful for web applications as it can pass in the session user name which might be different to the connection user name. Can be up to 64 bytes long but do not to include the password for security reasons and the first character of the identifier should not be ':'. This value can be retrieved on the server side using C view. my $dbh = DBI->connect($dsn, $user, $passwd, { ora_client_identifier => $some_web_user }); $dbh->{ora_client_identifier} = $local_user; =head4 ora_action Allows you to specify any string up to 32 bytes which may be retrieved on the server side using C view. my $dbh = DBI->connect($dsn, $user, $passwd, { ora_action => "Login"}); $dbh->{ora_action} = "New Long Query 22"; NOTE: You will need an Oracle client 10.1 or later to use this. =head4 ora_dbh_share Requires at least Perl 5.8.0 compiled with ithreads. Allows you to share database connections between threads. The first connect will make the connection, all following calls to connect with the same ora_dbh_share attribute will use the same database connection. The value must be a reference to a already shared scalar which is initialized to an empty string. our $orashr : shared = '' ; $dbh = DBI->connect ($dsn, $user, $passwd, {ora_dbh_share => \$orashr}) ; =head4 ora_envhp The first time a connection is made a new OCI 'environment' is created by DBD::Oracle and stored in the driver handle. Subsequent connects reuse (share) that same OCI environment by default. The ora_envhp attribute can be used to disable the reuse of the OCI environment from a previous connect. If the value is C<0> then a new OCI environment is allocated and used for this connection. The OCI environment holds information about the client side context, such as the local NLS environment. By altering C<%ENV> and setting ora_envhp to 0 you can create connections with different NLS settings. This is most useful for testing. =head4 ora_charset, ora_ncharset For oracle versions >= 9.2 you can specify the client charset and ncharset with the ora_charset and ora_ncharset attributes. You still need to pass C for all but the first connect. These attributes override the settings from environment variables. $dbh = DBI->connect ($dsn, $user, $passwd, {ora_charset => 'AL32UTF8'}); =head4 ora_verbose Use this value to enable DBD::Oracle only tracing. Simply either set the ora_verbose attribute on the connect() method to the trace level you desire like this my $dbh = DBI->connect($dsn, "", "", {ora_verbose=>6}); or set it directly on the DB handle like this; $dbh->{ora_verbose} =6; In both cases the DBD::Oracle trace level is set to 6, which is the highest level tracing most of the calls to OCI. NOTE: In future versions of DBD::Oracle ora_verbose will be changed so that it is simply a switch to turn DBI's DBD tracing on or off. A true value will turn it on and a false value will turn it off. DBI's "DBD" tracing was not available when ora_verbose was created and ora_verbose adds an additional test to every trace test. =head4 ora_oci_success_warn Use this value to print otherwise silent OCI warnings that may happen when an execute or fetch returns "Success With Info" or when you want to tune RowCaching and LOB Reads $dbh->{ora_oci_success_warn} = 1; =head4 ora_objects Use this value to enable extended embedded oracle objects mode. In extended: =over 4 =item 1 Embedded objects are returned as instance (including type-name etc.) instead of simple ARRAY. =item 2 Determine object type for each instance. All object attributes are returned (not only super-type's attributes). =back $dbh->{ora_objects} = 1; =head4 ora_ph_type The default placeholder datatype for the database session. The C or L attributes to L and L override the datatype for individual placeholders. The most frequent reason for using this attribute is to permit trailing spaces in values passed by placeholders. Constants for the values allowed for this attribute can be imported using use DBD::Oracle qw(:ora_types); Only the following values are permitted for this attribute. =over 4 =item ORA_VARCHAR2 Oracle clients using OCI 8 will strip trailing spaces and allow embedded \0 bytes. Oracle clients using OCI 9.2 do not strip trailing spaces and allow embedded \0 bytes. This is the normal default placeholder type. =item ORA_STRING Do not strip trailing spaces and end the string at the first \0. =item ORA_CHAR Do not strip trailing spaces and allow embedded \0. Force 'blank-padded comparison semantics'. For example: use DBD::Oracle qw(:ora_types); $SQL="select username from all_users where username = ?"; #username is a char(8) $sth=$dbh->prepare($SQL)"; $sth->bind_param(1,'bloggs',{ ora_type => ORA_CHAR}); Will pad bloggs out to 8 characters and return the username. =back =head4 ora_parse_error_offset If the previous error was from a failed C due to a syntax error, this attribute gives the offset into the C attribute where the error was found. =head4 ora_array_chunk_size Due to OCI limitations, DBD::Oracle needs to buffer up rows of bind values in its C implementation. This attribute sets the number of rows to buffer at a time (default value is 1000). The C function will collect (at most) this many rows in an array, send them off to the DB for execution, then go back to collect the next chunk of rows and so on. This attribute can be used to limit or extend the number of rows processed at a time. Note that this attribute also applies to C, since that method is implemented using C. =head4 ora_connect_with_default_signals Sometimes the Oracle client seems to change some of the signal handlers of the process during the connect phase. For instance, some users have observed Perl's default C<$SIG{INT}> handler being ignored after connecting to an Oracle database. If this causes problems in your application, set this attribute to an array reference of signals you would like to be localized during the connect process. Once the connect is complete, the signal handlers should be returned to their previous state. For example: $dbh = DBI->connect ($dsn, $user, $passwd, {ora_connect_with_default_signals => [ 'INT' ] }); NOTE disabling the signal handlers the OCI library sets up may affect functionality in the OCI library. NOTE If you are using connect_cached then the above example will lead to DBI thinking each connection is different as an anonymous array reference is being used. To avoid this when using connect_cached you are advised to use: my @ora_default_signals = (...); $dbh = DBI->connect($dsn, $user, $passwd, {ora_connect_with_default_signals => \@ora_default_signals}); In more recent Perl versions you could possibly make use of new state variables. =head2 B Implemented by DBI, no driver-specific impact. Please note that connect_cached as not been tested with DRCP. =head2 B @data_sources = DBI->data_sources('Oracle'); @data_sources = $dbh->data_sources(); Returns a list of available databases. You will have to set either the 'ORACLE_HOME' or 'TNS_ADMIN' environment value to retrieve this list. It will read these values from TNSNAMES.ORA file entries. =head1 METHODS COMMON TO ALL HANDLES For all of the methods below, B<$h> can be either a database handle (B<$dbh>) or a statement handle (B<$sth>). Note that I<$dbh> and I<$sth> can be replaced with any variable name you choose: these are just the names most often used. Another common variable used in this documentation is $I, which stands for "return value". =head2 B $rv = $h->err; Returns the error code from the last method called. =head2 B $str = $h->errstr; Returns the last error that was reported by Oracle. Starting with "ORA-00000" code followed by the error message. =head2 B $str = $h->state; Oracle hasn't supported SQLSTATE since the early versions OCI. It will return empty when the command succeeds and 'S1000' (General Error) for all other errors. While this method can be called as either C<< $sth->state >> or C<< $dbh->state >>, it is usually clearer to always use C<< $dbh->state >>. =head2 B Implemented by DBI, no driver-specific impact. =head2 B Implemented by DBI, no driver-specific impact. =head2 B and B Implemented by DBI, no driver-specific impact. =head2 B DBD::Oracle uses the C method to support a variety of functions. =head2 B Some of these functions are called through the method func() which is described in the DBI documentation. Any function that begins with ora_ can be called directly. =head2 B This function returns a string which describes the errors from the most recent PL/SQL function, procedure, package, or package body compile in a format similar to the output of the SQL*Plus command 'show errors'. The function returns undef if the error string could not be retrieved due to a database error. Look in $dbh->errstr for the cause of the failure. If there are no compile errors, an empty string is returned. Example: # Show the errors if CREATE PROCEDURE fails $dbh->{RaiseError} = 0; if ( $dbh->do( q{ CREATE OR REPLACE PROCEDURE perl_dbd_oracle_test as BEGIN PROCEDURE filltab( stuff OUT TAB ); asdf END; } ) ) {} # Statement succeeded } elsif ( 6550 != $dbh->err ) { die $dbh->errstr; } # Utter failure else { my $msg = $dbh->func( 'plsql_errstr' ); die $dbh->errstr if ! defined $msg; die $msg if $msg; } =head2 B These functions use the PL/SQL DBMS_OUTPUT package to store and retrieve text using the DBMS_OUTPUT buffer. Text stored in this buffer by dbms_output_put or any PL/SQL block can be retrieved by dbms_output_get or any PL/SQL block connected to the same database session. Stored text is not available until after dbms_output_put or the PL/SQL block that saved it completes its execution. This means you B use these functions to monitor long running PL/SQL procedures. Example 1: # Enable DBMS_OUTPUT and set the buffer size $dbh->{RaiseError} = 1; $dbh->func( 1000000, 'dbms_output_enable' ); # Put text in the buffer . . . $dbh->func( @text, 'dbms_output_put' ); # . . . and retrieve it later @text = $dbh->func( 'dbms_output_get' ); Example 2: $dbh->{RaiseError} = 1; $sth = $dbh->prepare(q{ DECLARE tmp VARCHAR2(50); BEGIN SELECT SYSDATE INTO tmp FROM DUAL; dbms_output.put_line('The date is '||tmp); END; }); $sth->execute; # retrieve the string $date_string = $dbh->func( 'dbms_output_get' ); =head2 B This function calls DBMS_OUTPUT.ENABLE to enable calls to package DBMS_OUTPUT procedures GET, GET_LINE, PUT, and PUT_LINE. Calls to these procedures are ignored unless DBMS_OUTPUT.ENABLE is called first. The buffer_size is the maximum amount of text that can be saved in the buffer and must be between 2000 and 1,000,000. If buffer_size is not given, the default is 20,000 bytes. =head2 B This function calls DBMS_OUTPUT.PUT_LINE to add lines to the buffer. If all lines were saved successfully the function returns 1. Depending on the context, an empty list or undef is returned for failure. If any line causes buffer_size to be exceeded, a buffer overflow error is raised and the function call fails. Some of the text might be in the buffer. =head2 B This function calls DBMS_OUTPUT.GET_LINE to retrieve lines of text from the buffer. In an array context, all complete lines are removed from the buffer and returned as a list. If there are no complete lines, an empty list is returned. In a scalar context, the first complete line is removed from the buffer and returned. If there are no complete lines, undef is returned. Any text in the buffer after a call to DBMS_OUTPUT.GET_LINE or DBMS_OUTPUT.GET is discarded by the next call to DBMS_OUTPUT.PUT_LINE, DBMS_OUTPUT.PUT, or DBMS_OUTPUT.NEW_LINE. =head2 B Starts a new session against the current database using the credentials supplied. =head2 B $hashref = $dbh->private_attribute_info(); $hashref = $sth->private_attribute_info(); Returns a hash of all private attributes used by DBD::Oracle, for either a database or a statement handle. Currently, all the hash values are undef. =head1 ATTRIBUTES COMMON TO ALL HANDLES =head2 B (boolean) Implemented by DBI, no driver-specific impact. =head2 B (boolean, inherited) Forces errors to always raise an exception. Although it defaults to off, it is recommended that this be turned on, as the alternative is to check the return value of every method (prepare, execute, fetch, etc.) manually, which is easy to forget to do. =head2 B (boolean, inherited) Forces database errors to also generate warnings, which can then be filtered with methods such as locally redefining I<$SIG{__WARN__}> or using modules such as C. This attribute is on by default. =head2 B (boolean, inherited) Appends information about the current statement to error messages. If placeholder information is available, adds that as well. Defaults to true. =head2 B (boolean, inherited) Enables warnings. This is on by default, and should only be turned off in a local block for a short a time only when absolutely needed. =head2 B (boolean, read-only) Indicates if a handle has been executed. For database handles, this value is true after the L method has been called, or when one of the child statement handles has issued an L. Issuing a L or L always resets the attribute to false for database handles. For statement handles, any call to L or its variants will flip the value to true for the lifetime of the statement handle. =head2 B (integer, inherited) Sets the trace level, similar to the L method. See the sections on L and L for more details. =head2 B (boolean, read-only) Indicates if a handle is active or not. For database handles, this indicates if the database has been disconnected or not. For statement handles, it indicates if all the data has been fetched yet or not. Use of this attribute is not encouraged. =head2 B (integer, read-only) Returns the number of child processes created for each handle type. For a driver handle, indicates the number of database handles created. For a database handle, indicates the number of statement handles created. For statement handles, it always returns zero, because statement handles do not create kids. =head2 B (integer, read-only) Same as C, but only returns those that are active. =head2 B (hash ref) Returns a hashref of handles. If called on a database handle, returns all statement handles created by use of the C method. If called on a driver handle, returns all database handles created by the L method. =head2 B (array ref) Implemented by DBI, no driver-specific impact. =head2 B (boolean, inherited) Implemented by DBI, no driver-specific impact. =head2 B (boolean, inherited) Implemented by DBI, no driver-specific impact. =head2 B (code ref, inherited) Implemented by DBI, no driver-specific impact. =head2 B (unsigned integer) Implemented by DBI, no driver-specific impact. =head2 B (string, inherited) Implemented by DBI, no driver-specific impact. =head2 B (boolean, inherited) Implemented by DBI, no driver-specific impact. =head2 B (boolean, inherited) Implemented by DBI, no driver-specific impact. =head2 B (boolean, inherited) Implemented by DBI, no driver-specific impact. =head2 B (boolean, inherited) Implemented by DBI, no driver-specific impact. =head2 B (inherited) Implemented by DBI, no driver-specific impact. =head2 B (scalar) Returns C for a driver handle, C for a database handle, and C for a statement handle. Should be rarely needed. =head2 B The maximum size of long or longraw columns to retrieve. If one of these columns is longer than LongReadLen then either a data truncation error will be raised (LongTrunkOk is false) or the column will be silently truncated (LongTruncOk is true). DBI currently defaults this to 80. =head2 B Implemented by DBI, no driver-specific impact. =head2 B Type: boolean, inherited The CompatMode attribute is used by emulation layers (such as Oraperl) to enable compatible behaviour in the underlying driver (e.g., DBD::Oracle) for this handle. Not normally set by application code. It also has the effect of disabling the 'quick FETCH' of attribute values from the handles attribute cache. So all attribute values are handled by the drivers own FETCH method. This makes them slightly slower but is useful for special-purpose drivers like DBD::Multiplex. =head1 ORACLE-SPECIFIC DATABASE HANDLE METHODS =head2 B Returns a number indicating whether either of the database character sets is a Unicode encoding. Calls ora_nls_parameters() and passes the optional $refresh parameter to it. 0 = Neither character set is a Unicode encoding. 1 = National character set is a Unicode encoding. 2 = Database character set is a Unicode encoding. 3 = Both character sets are Unicode encodings. =head2 B Returns true if the current connection supports TAF events. False if otherwise. =head2 B Returns a hash reference containing the current NLS parameters, as given by the v$nls_parameters view. The values fetched are cached between calls. To cause the latest values to be fetched, pass a true value to the function. =head1 ORACLE-SPECIFIC DATABASE FUNCTIONS =head2 B $versions = $dbh->func('ora_server_version'); Returns an array reference of server version strings e.g., [11,2,0,2,0] =head1 DATABASE HANDLE METHODS =head2 B $ary_ref = $dbh->selectall_arrayref($sql); $ary_ref = $dbh->selectall_arrayref($sql, \%attr); $ary_ref = $dbh->selectall_arrayref($sql, \%attr, @bind_values); Returns a reference to an array containing the rows returned by preparing and executing the SQL string. See the DBI documentation for full details. =head2 B $hash_ref = $dbh->selectall_hashref($sql, $key_field); Returns a reference to a hash containing the rows returned by preparing and executing the SQL string. See the DBI documentation for full details. =head2 B $ary_ref = $dbh->selectcol_arrayref($sql, \%attr, @bind_values); Returns a reference to an array containing the first column from each rows returned by preparing and executing the SQL string. It is possible to specify exactly which columns to return. See the DBI documentation for full details. =head2 B $sth = $dbh->prepare($statement, \%attr); Prepares a statement for later execution by the database engine and returns a reference to a statement handle object. =head3 B These attributes may be used in the C<\%attr> parameter of the L database handle method. =over 4 =item ora_placeholders Set to false to disable processing of placeholders. Used mainly for loading a PL/SQL package that has been I with Oracle's C utility. =item ora_auto_lob If true (the default), fetching retrieves the contents of the CLOB or BLOB column in most circumstances. If false, fetching retrieves the Oracle "LOB Locator" of the CLOB or BLOB value. See L for more details. See also the LOB tests in 05dbi.t of Oracle::OCI for examples of how to use LOB Locators. =item ora_pers_lob If true the L method for the L will be used for LOBs rather than the default method L. =item ora_clbk_lob If true the L method for the L will be used for LOBs. =item ora_piece_lob If true the L method for the L will be used for LOBs. =item ora_piece_size This is the max piece size for the L and L methods, in chars for CLOBS, and bytes for BLOBS. =item ora_check_sql If 1 (default), force SELECT statements to be described in prepare(). If 0, allow SELECT statements to defer describe until execute(). See L for more information. =item ora_exe_mode This will set the execute mode of the current statement. Presently only one mode is supported; OCI_STMT_SCROLLABLE_READONLY - make result set scrollable See L for more details. =item ora_prefetch_rows Sets the number of rows to be prefetched. If it is not set, then the default value is 1. See L for more details. =item ora_prefetch_memory Sets the memory level for rows to be prefetched. The application then fetches as many rows as will fit into that much memory. See L for more details. =item ora_row_cache_off By default DBD::Oracle will use a row cache when fetching to cut down the number of round trips to the server. If you do not want to use an array fetch set this value to any value other than 0; See L for more details. =back =head3 B There are three types of placeholders that can be used in DBD::Oracle. The first is the "question mark" type, in which each placeholder is represented by a single question mark character. This is the method recommended by the DBI and is the most portable. Each question mark is internally replaced by a "dollar sign number" in the order in which they appear in the query (important when using L). The second type of placeholder is "named parameters" in the format ":foo" which is the one Oracle prefers. $dbh->{RaiseError} = 1; # save having to check each method call $sth = $dbh->prepare("SELECT name, age FROM people WHERE name LIKE :name"); $sth->bind_param(':name', "John%"); $sth->execute; DBI::dump_results($sth); Note when calling bind_param with named parameters you must include the leading colon. The advantage of this placeholder type is that you can use the same placeholder more than once in the same SQL statement but you only need to bind it once. The last placeholder type is a variation of the two above where you name each placeholder :N (where N is a number). Like the named placeholders above you can use the same placeholder multiple times in the SQL but when you call bind_param you only need to pass the N (e.g., for :1 you use bind_param(1,...) and not bind_param(':1',...). The different types of placeholders cannot be mixed within a statement, but you may use different ones for each statement handle you have. This is confusing at best, so stick to one style within your program. =head2 B $sth = $dbh->prepare_cached($statement, \%attr); Implemented by DBI, no driver-specific impact. This method is most useful if the same query is used over and over as it will cut down round trips to the server. =head2 B $rv = $dbh->do($statement); $rv = $dbh->do($statement, \%attr); $rv = $dbh->do($statement, \%attr, @bind_values); Prepare and execute a single statement. Returns the number of rows affected if the query was successful, returns undef if an error occurred, and returns -1 if the number of rows is unknown or not available. Note that this method will return B<0E0> instead of 0 for 'no rows were affected', in order to always return a true value if no error occurred. =head2 B Oracle does not implement auto_increment of serial type columns it uses predefined sequences where the id numbers are either selected before insert, at insert time with a trigger, or as part of the query. Below is an example of you to use the latter with the SQL returning clause to get the ID number back on insert with the bind_param_inout method. . $dbh->do('CREATE SEQUENCE lii_seq START 1'); $dbh->do(q{CREATE TABLE lii ( foobar INTEGER NOT NULL UNIQUE, baz VARCHAR)}); $SQL = "INSERT INTO lii (foobar,baz) VALUES (lii_seq.nextval,'XX') returning foobar into :p_new_id";"; $sth = $dbh->prepare($SQL); my $p_new_id='-1'; $sth->bind_param_inout(":p_new_id",\$p_new_id,38); $sth->execute(); $db->commit(); =head2 B $rv = $dbh->commit; Issues a COMMIT to the server, indicating that the current transaction is finished and that all changes made will be visible to other processes. If AutoCommit is enabled, then a warning is given and no COMMIT is issued. Returns true on success, false on error. =head2 B $rv = $dbh->rollback; Issues a ROLLBACK to the server, which discards any changes made in the current transaction. If AutoCommit is enabled, then a warning is given and no ROLLBACK is issued. Returns true on success, and false on error. =head2 B This method turns on transactions until the next call to L or L, if L is currently enabled. If it is not enabled, calling begin_work will issue an error. Note that the transaction will not actually begin until the first statement after begin_work is called. =head2 B $rv = $dbh->disconnect; Disconnects from the Oracle database. Any uncommitted changes will be rolled back upon disconnection. It's good policy to always explicitly call commit or rollback at some point before disconnecting, rather than relying on the default rollback behavior. If the script exits before disconnect is called (or, more precisely, if the database handle is no longer referenced by anything), then the database handle's DESTROY method will call the rollback() and disconnect() methods automatically. It is best to explicitly disconnect rather than rely on this behavior. =head2 B $rv = $dbh->ping; This C method is used to check the validity of a database handle. The value returned is either 0, indicating that the connection is no longer valid, or 1, indicating the connection is valid. This function does 1 round trip to the Oracle Server. =head2 B $value = $dbh->get_info($info_type); DBD::Oracle supports C, but (currently) only a few info types. =head2 B DBD::Oracle supports attributes for C. In Oracle, the concept of I and I is (currently) the same. Because database objects are owned by an user, the owner names in the data dictionary views correspond to schema names. Oracle does not support catalogues so TABLE_CAT is ignored as selection criterion. Search patterns are supported for TABLE_SCHEM and TABLE_NAME. TABLE_TYPE may contain a comma-separated list of table types. The following table types are supported: TABLE VIEW SYNONYM SEQUENCE The result set is ordered by TABLE_TYPE, TABLE_SCHEM, TABLE_NAME. The special enumerations of catalogues, schemas and table types are supported. However, TABLE_CAT is always NULL. An identifier is passed I, i.e. as the user provides or Oracle returns it. C performs a case-sensitive search. So, a selection criterion should respect upper and lower case. Normally, an identifier is case-insensitive. Oracle stores and returns it in upper case. Sometimes, database objects are created with quoted identifiers (for reserved words, mixed case, special characters, ...). Such an identifier is case-sensitive (if not all upper case). Oracle stores and returns it as given. C has no special quote handling, neither adds nor removes quotes. =head2 B Oracle does not support catalogues so TABLE_CAT is ignored as selection criterion. The TABLE_CAT field of a fetched row is always NULL (undef). See L for more detailed information. If the primary key constraint was created without an identifier, PK_NAME contains a system generated name with the form SYS_Cn. The result set is ordered by TABLE_SCHEM, TABLE_NAME, KEY_SEQ. An identifier is passed I, i.e. as the user provides or Oracle returns it. See L for more detailed information. =head2 B This method (currently) supports the extended behaviour of SQL/CLI, i.e. the result set contains foreign keys that refer to primary B alternate keys. The field UNIQUE_OR_PRIMARY distinguishes these keys. Oracle does not support catalogues, so C<$pk_catalog> and C<$fk_catalog> are ignored as selection criteria (in the new style interface). The UK_TABLE_CAT and FK_TABLE_CAT fields of a fetched row are always NULL (undef). See L for more detailed information. If the primary or foreign key constraints were created without an identifier, UK_NAME or FK_NAME contains a system generated name with the form SYS_Cn. The UPDATE_RULE field is always 3 ('NO ACTION'), because Oracle (currently) does not support other actions. The DELETE_RULE field may contain wrong values. This is a known Bug (#1271663) in Oracle's data dictionary views. Currently (as of 8.1.7), 'RESTRICT' and 'SET DEFAULT' are not supported, 'CASCADE' is mapped correctly and all other actions (incl. 'SET NULL') appear as 'NO ACTION'. The DEFERABILITY field is always NULL, because this columns is not present in the ALL_CONSTRAINTS view of older Oracle releases. The result set is ordered by UK_TABLE_SCHEM, UK_TABLE_NAME, FK_TABLE_SCHEM, FK_TABLE_NAME, ORDINAL_POSITION. An identifier is passed I, i.e. as the user provides or Oracle returns it. See L for more detailed information. =head2 B Oracle does not support catalogues so TABLE_CAT is ignored as selection criterion. The TABLE_CAT field of a fetched row is always NULL (undef). See L for more detailed information. The CHAR_OCTET_LENGTH field is (currently) always NULL (undef). Don't rely on the values of the BUFFER_LENGTH field! Especially the length of FLOATs may be wrong. Datatype codes for non-standard types are subject to change. Attention! The DATA_DEFAULT (COLUMN_DEF) column is of type LONG so you may have to set LongReadLen on the connection handle before calling column_info if you have a large default column. After DBD::Oracle 1.40 LongReadLen is set automatically to 1Mb when calling column_info and reset aftwerwards. The result set is ordered by TABLE_SCHEM, TABLE_NAME, ORDINAL_POSITION. An identifier is passed I, i.e. as the user provides or Oracle returns it. See L for more detailed information. It is possible with Oracle to make the names of the various DB objects (table,column,index etc) case sensitive. alter table bloggind add ("Bla_BLA" NUMBER) So in the example the exact case "Bla_BLA" must be used to get it info on the column. While this alter table bloggind add (Bla_BLA NUMBER) any case can be used to get info on the column. =head2 B Oracle does not support catalogues so TABLE_CAT is ignored as selection criterion. The TABLE_CAT field of a fetched row is always NULL (undef). See L for more detailed information. The INDEX_QUALIFIER field of a fetched row is always NULL (undef), for the same reason as for TABLE_CAT. If an index was created without an identifier (e.g. in the course of a PK creation), INDEX_NAME contains a system generated name with the form SYS_. COLUMN_NAME may contain a system generated name (e.g. for function-based indexes). For the TYPE column, a simple mapping is used: NORMAL btree CLUSTER clustered ... other The C<$quick> parameter is currently ignored. The method uses the dictionary with the gathered statistics, thus cannot ensure that the values for CARDINALITY and PAGES are current. The result set is ordered by NON_UNIQUE, TYPE, INDEX_QUALIFIER, INDEX_NAME, ORDINAL_POSITION. An identifier is passed I, i.e. as the user provides or Oracle returns it. See L for more detailed information. =head2 B @row_ary = $dbh->selectrow_array($sql); @row_ary = $dbh->selectrow_array($sql, \%attr); @row_ary = $dbh->selectrow_array($sql, \%attr, @bind_values); Returns an array of row information after preparing and executing the provided SQL string. The rows are returned by calling L. The string can also be a statement handle generated by a previous prepare. Note that only the first row of data is returned. If called in a scalar context, only the first column of the first row is returned. Because this is not portable, it is not recommended that you use this method in that way. =head2 B $ary_ref = $dbh->selectrow_arrayref($statement); $ary_ref = $dbh->selectrow_arrayref($statement, \%attr); $ary_ref = $dbh->selectrow_arrayref($statement, \%attr, @bind_values); Exactly the same as L, except that it returns a reference to an array, by internal use of the L method. =head2 B $hash_ref = $dbh->selectrow_hashref($sql); $hash_ref = $dbh->selectrow_hashref($sql, \%attr); $hash_ref = $dbh->selectrow_hashref($sql, \%attr, @bind_values); Exactly the same as L, except that it returns a reference to an hash, by internal use of the L method. =head2 B $other_dbh = $dbh->clone(); Creates a copy of the database handle by connecting with the same parameters as the original handle, then trying to merge the attributes. See the DBI documentation for complete usage. =head1 DATABASE HANDLE ATTRIBUTES =head2 B (boolean) Supported by DBD::Oracle as proposed by DBI.The default of AutoCommit is on, but this may change in the future, so it is highly recommended that you explicitly set it when calling L. =head2 B (boolean) $dbh->{ReadOnly} = 1; Specifies if the current database connection should be in read-only mode or not. Please not that this method is not foolproof: there are still ways to update the database. Consider this a safety net to catch applications that should not be issuing commands such as INSERT, UPDATE, or DELETE. This method method requires DBI version 1.55 or better. =head2 B (string, read-only) Returns the name of the current database. This is the same as the DSN, without the "dbi:Oracle:" part. =head2 B (string, read-only) Returns the name of the user connected to the database. =head2 B (handle, read-only) Holds the handle of the parent driver. The only recommended use for this is to find the name of the driver using: $dbh->{Driver}->{Name} =head2 B DBD::Oracle supports both Server pre-fetch and Client side row caching. By default both are turned on to give optimum performance. Most of the time one can just let DBD::Oracle figure out the best optimization. =head3 B Row caching occurs on the client side and the object of it is to cut down the number of round trips made to the server when fetching rows. At each fetch a set number of rows will be retrieved from the server and stored locally. Further calls the server are made only when the end of the local buffer(cache) is reached. Rows up to the specified top level row count C are fetched if it occupies no more than the specified memory usage limit. The default value is 0, which means that memory size is not included in computing the number of rows to prefetch. If the C value is set to a negative number then the positive value of RowCacheSize is used to compute the number of rows to prefetch. By default C is automatically set. If you want to totally turn off prefetching set this to 1. For any SQL statement that contains a LOB, Long or Object Type Row Caching will be turned off. However server side caching still works. If you are only selecting a LOB Locator then Row Caching will still work. =head3 Row Prefetching Row prefetching occurs on the server side and uses the DBI database handle attribute C and or the Prepare Attribute 'ora_prefetch_memory'. Tweaking these values may yield improved performance. $dbh->{RowCacheSize} = 100; $sth=$dbh->prepare($SQL,{ora_exe_mode=>OCI_STMT_SCROLLABLE_READONLY,ora_prefetch_memory=>10000}); In the above example 10 rows will be prefetched up to a maximum of 10000 bytes of data. The Oracle Call Interface Programmer's Guide, suggests a good row cache value for a scrollable cursor is about 20% of expected size of the record set. The prefetch settings tell the DBD::Oracle to grab x rows (or x-bytes) when it needs to get new rows. This happens on the first fetch that sets the current_positon to any value other than 0. In the above example if we do a OCI_FETCH_FIRST the first 10 rows are loaded into the buffer and DBD::Oracle will not have to go back to the server for more rows. When record 11 is fetched DBD::Oracle fetches and returns this row and the next 9 rows are loaded into the buffer. In this case if you fetch backwards from 10 to 1 no server round trips are made. With large record sets it is best not to attempt to go to the last record as this may take some time, A large buffer size might even slow down the fetch. If you must get the number of rows in a large record set you might try using an few large OCI_FETCH_ABSOLUTEs and then an OCI_FETCH_LAST, this might save some time. So if you had a record set of 10000 rows and you set the buffer to 5000 and did a OCI_FETCH_LAST one would fetch the first 5000 rows into the buffer then the next 5000 rows. If one requires only the first few rows there is no need to set a large prefetch value. If the ora_prefetch_memory less than 1 or not present then memory size is not included in computing the number of rows to prefetch otherwise the number of rows will be limited to memory size. Likewise if the RowCacheSize is less than 1 it is not included in the computing of the prefetch rows. =head1 ORACLE-SPECIFIC STATEMENT HANDLE METHODS =head2 B Returns the OCI Statement Type number for the SQL of a statement handle. =head2 B Returns the OCI Statement Type name for the SQL of a statement handle. =head1 DBI STATEMENT HANDLE OBJECT METHODS =head2 B $rv = $sth->bind_param($param_num, $bind_value); $rv = $sth->bind_param($param_num, $bind_value, $bind_type); $rv = $sth->bind_param($param_num, $bind_value, \%attr); Allows the user to bind a value and/or a data type to a placeholder. The value of C<$param_num> is a number if using the '?' or if using ":foo" style placeholders, the complete name (e.g. ":foo") must be given. The C<$bind_value> argument is fairly self-explanatory. A value of C will bind a C to the placeholder. Using C is useful when you want to change just the type and will be overwriting the value later. (Any value is actually usable, but C is easy and efficient). The C<\%attr> hash is used to indicate the data type of the placeholder. The default value is "varchar". If you need something else, you must use one of the values provided by DBI or by DBD::Pg. To use a SQL value, modify your "use DBI" statement at the top of your script as follows: use DBI qw(:sql_types); This will import some constants into your script. You can plug those directly into the L call. Some common ones that you will encounter are: SQL_INTEGER To use Oracle SQL data types, import the list of values like this: use DBD::Pg qw(:ora_types); You can then set the data types by setting the value of the C key in the hash passed to L. The current list of Oracle data types exported is: ORA_VARCHAR2 ORA_STRING ORA_NUMBER ORA_LONG ORA_ROWID ORA_DATE ORA_RAW ORA_LONGRAW ORA_CHAR ORA_CHARZ ORA_MLSLABEL ORA_XMLTYPE ORA_CLOB ORA_BLOB ORA_RSET ORA_VARCHAR2_TABLE ORA_NUMBER_TABLE SQLT_INT SQLT_FLT ORA_OCI SQLT_CHR SQLT_BIN Data types are "sticky," in that once a data type is set to a certain placeholder, it will remain for that placeholder, unless it is explicitly set to something else afterwards. If the statement has already been prepared, and you switch the data type to something else, DBD::Oracle will re-prepare the statement for you before doing the next execute. Examples: use DBI qw(:sql_types); use DBD::Pg qw(:ora_types); $SQL = "SELECT id FROM ptable WHERE size > ? AND title = ?"; $sth = $dbh->prepare($SQL); ## Both arguments below are bound to placeholders as "varchar" $sth->execute(123, "Merk"); ## Reset the datatype for the first placeholder to an integer $sth->bind_param(1, undef, SQL_INTEGER); ## The "undef" bound above is not used, since we supply params to execute $sth->execute(123, "Merk"); ## Set the first placeholder's value and data type $sth->bind_param(1, 234, { pg_type => ORA_NUMBER }); ## Set the second placeholder's value and data type. ## We don't send a third argument, so the default "varchar" is used $sth->bind_param('$2', "Zool"); ## We realize that the wrong data type was set above, so we change it: $sth->bind_param('$1', 234, { pg_type => SQL_INTEGER }); ## We also got the wrong value, so we change that as well. ## Because the data type is sticky, we don't need to change it $sth->bind_param(1, 567); ## This executes the statement with 567 (integer) and "Zool" (varchar) $sth->execute(); These attributes may be used in the C<\%attr> parameter of the L or L statement handle methods. =over 4 =item ora_type Specify the placeholder's datatype using an Oracle datatype. A fatal error is raised if C and the DBI C attribute are used for the same placeholder. Some of these types are not supported by the current version of DBD::Oracle and will cause a fatal error if used. Constants for the Oracle datatypes may be imported using use DBD::Oracle qw(:ora_types); Potentially useful values when DBD::Oracle was built using OCI 7 and later: ORA_VARCHAR2, ORA_STRING, ORA_LONG, ORA_RAW, ORA_LONGRAW, ORA_CHAR, ORA_MLSLABEL, ORA_RSET Additional values when DBD::Oracle was built using OCI 8 and later: ORA_CLOB, ORA_BLOB, ORA_XMLTYPE, ORA_VARCHAR2_TABLE, ORA_NUMBER_TABLE Additional values when DBD::Oracle was built using OCI 9.2 and later: SQLT_CHR, SQLT_BIN See L for the correct way to use ORA_RSET. See L for how to use ORA_CLOB and ORA_BLOB. See L for ORA_VARCHAR2_TABLE, ORA_NUMBER_TABLE. See L for the correct way to use SQLT_CHR and SQLT_BIN. See L for more information. See also L. =item ora_csform Specify the OCI_ATTR_CHARSET_FORM for the bind value. Valid values are SQLCS_IMPLICIT (1) and SQLCS_NCHAR (2). Both those constants can be imported from the DBD::Oracle module. Rarely needed. =item ora_csid Specify the I OCI_ATTR_CHARSET_ID for the bind value. Character set names can't be used currently. =item ora_maxdata_size Specify the integer OCI_ATTR_MAXDATA_SIZE for the bind value. May be needed if a character set conversion from client to server causes the data to use more space and so fail with a truncation error. =item ora_maxarray_numentries Specify the maximum number of array entries to allocate. Used with ORA_VARCHAR2_TABLE, ORA_NUMBER_TABLE. Define the maximum number of array entries Oracle can pass back to you in OUT variable of type TABLE OF ... . =item ora_internal_type Specify internal data representation. Currently is supported only for ORA_NUMBER_TABLE. =back =head3 Optimizing Results =head4 Prepare Postponed Till Execute The DBD::Oracle module can avoid an explicit 'describe' operation prior to the execution of the statement unless the application requests information about the results (such as $sth->{NAME}). This reduces communication with the server and increases performance (reducing the number of PARSE_CALLS inside the server). However, it also means that SQL errors are not detected until C (or $sth->{NAME} etc) is called instead of when C is called. Note that if the describe is triggered by the use of $sth->{NAME} or a similar attribute and the describe fails then I even if C is false! Set L to 0 in prepare() to enable this behaviour. =head2 B $rv = $sth->bind_param_inout($param_num, \$scalar, 0); DBD::Oracle fully supports bind_param_inout below are some uses for this method. =head3 B Oracle supports an extended SQL insert syntax which will return one or more of the values inserted. This can be particularly useful for single-pass insertion of values with re-used sequence values (avoiding a separate "select seq.nextval from dual" step). $sth = $dbh->prepare(qq{ INSERT INTO foo (id, bar) VALUES (foo_id_seq.nextval, :bar) RETURNING id INTO :id }); $sth->bind_param(":bar", 42); $sth->bind_param_inout(":id", \my $new_id, 99); $sth->execute; print "The id of the new record is $new_id\n"; If you have many columns to bind you can use code like this: @params = (... column values for record to be inserted ...); $sth->bind_param($_, $params[$_-1]) for (1..@params); $sth->bind_param_inout(@params+1, \my $new_id, 99); $sth->execute; If you have many rows to insert you can take advantage of Oracle's built in execute array feature with code like this: my @in_values=('1',2,'3','4',5,'6',7,'8',9,'10'); my @out_values; my @status; my $sth = $dbh->prepare(qq{ INSERT INTO foo (id, bar) VALUES (foo_id_seq.nextval, ?) RETURNING id INTO ? }); $sth->bind_param_array(1,\@in_values); $sth->bind_param_inout_array(2,\@out_values,0,{ora_type => ORA_VARCHAR2}); $sth->execute_array({ArrayTupleStatus=>\@status}) or die "error inserting"; foreach my $id (@out_values){ print 'returned id='.$id.'\n'; } Which will return all the ids into @out_values. =over =item B =item This will only work for numbered (?) placeholders, =item The third parameter of bind_param_inout_array, (0 in the example), "maxlen" is required by DBI but not used by DBD::Oracle =item The "ora_type" attribute is not needed but only ORA_VARCHAR2 will work. =back =head3 Returning A Recordset DBD::Oracle does not currently support binding a PL/SQL table (aka array) as an IN OUT parameter to any Perl data structure. You cannot therefore call a PL/SQL function or procedure from DBI that uses a non-atomic datatype as either a parameter, or a return value. However, if you are using Oracle 9.0.1 or later, you can make use of table (or pipelined) functions. For example, assume you have the existing PL/SQL Package : CREATE OR REPLACE PACKAGE Array_Example AS -- TYPE tRec IS RECORD ( Col1 NUMBER, Col2 VARCHAR2 (10), Col3 DATE) ; -- TYPE taRec IS TABLE OF tRec INDEX BY BINARY_INTEGER ; -- FUNCTION Array_Func RETURN taRec ; -- END Array_Example ; CREATE OR REPLACE PACKAGE BODY Array_Example AS -- FUNCTION Array_Func RETURN taRec AS -- l_Ret taRec ; -- BEGIN FOR i IN 1 .. 5 LOOP l_Ret (i).Col1 := i ; l_Ret (i).Col2 := 'Row : ' || i ; l_Ret (i).Col3 := TRUNC (SYSDATE) + i ; END LOOP ; RETURN l_Ret ; END ; -- END Array_Example ; / Currently, there is no way to directly call the function Array_Example.Array_Func from DBI. However, by making the following relatively painless additions, its not only possible, but extremely efficient. First, you need to create database object types that correspond to the record and table types in the package. From the above example, these would be : CREATE OR REPLACE TYPE tArray_Example__taRec AS OBJECT ( Col1 NUMBER, Col2 VARCHAR2 (10), Col3 DATE ) ; CREATE OR REPLACE TYPE taArray_Example__taRec AS TABLE OF tArray_Example__taRec ; Now, assuming the existing function needs to remain unchanged (it is probably being called from other PL/SQL code), we need to add a new function to the package. Here's the new package specification and body : CREATE OR REPLACE PACKAGE Array_Example AS -- TYPE tRec IS RECORD ( Col1 NUMBER, Col2 VARCHAR2 (10), Col3 DATE) ; -- TYPE taRec IS TABLE OF tRec INDEX BY BINARY_INTEGER ; -- FUNCTION Array_Func RETURN taRec ; FUNCTION Array_Func_DBI RETURN taArray_Example__taRec PIPELINED ; -- END Array_Example ; CREATE OR REPLACE PACKAGE BODY Array_Example AS -- FUNCTION Array_Func RETURN taRec AS l_Ret taRec ; BEGIN FOR i IN 1 .. 5 LOOP l_Ret (i).Col1 := i ; l_Ret (i).Col2 := 'Row : ' || i ; l_Ret (i).Col3 := TRUNC (SYSDATE) + i ; END LOOP ; RETURN l_Ret ; END ; FUNCTION Array_Func_DBI RETURN taArray_Example__taRec PIPELINED AS l_Set taRec ; BEGIN l_Set := Array_Func ; FOR i IN l_Set.FIRST .. l_Set.LAST LOOP PIPE ROW ( tArray_Example__taRec ( l_Set (i).Col1, l_Set (i).Col2, l_Set (i).Col3 ) ) ; END LOOP ; RETURN ; END ; -- END Array_Example ; As you can see, the new function is very simple. Now, it is a simple matter of calling the function as a straight-forward SELECT from your DBI code. From the above example, the code would look something like this : my $sth = $dbh->prepare('SELECT * FROM TABLE(Array_Example.Array_Func_DBI)'); $sth->execute; while ( my ($col1, $col2, $col3) = $sth->fetchrow_array { ... } =head3 B DBD::Oracle has built-in support for B and B datatypes. The simple example is here: my $statement=' DECLARE tbl SYS.DBMS_SQL.VARCHAR2_TABLE; BEGIN tbl := :mytable; :cc := tbl.count(); tbl(1) := \'def\'; tbl(2) := \'ijk\'; :mytable := tbl; END; '; my $sth=$dbh->prepare( $statement ); my @arr=( "abc","efg","hij" ); $sth->bind_param_inout(":mytable", \\@arr, 10, { ora_type => ORA_VARCHAR2_TABLE, ora_maxarray_numentries => 100 } ) ; $sth->bind_param_inout(":cc", \$cc, 100 ); $sth->execute(); print "Result: cc=",$cc,"\n", "\tarr=",Data::Dumper::Dumper(\@arr),"\n"; =over =item B =item Take careful note that we use '\\@arr' here because the 'bind_param_inout' will only take a reference to a scalar. =back =head3 B SYS.DBMS_SQL.VARCHAR2_TABLE object is always bound to array reference. ( in bind_param() and bind_param_inout() ). When you bind array, you need to specify full buffer size for OUT data. So, there are two parameters: I (specified as 3rd argument of bind_param_inout() ), and I. They define maximum array entry length and maximum rows, that can be passed to Oracle and back to you. In this example we send array with 1 element with length=3, but allocate space for 100 Oracle array entries with maximum length 10 of each. So, you can get no more than 100 array entries with length <= 10. If you set I to zero, maximum array entry length is calculated as maximum length of entry of array bound. If 0 < I < length( $some_element ), truncation occur. If you set I to zero, current (at bind time) bound array length is used as maximum. If 0 < I < scalar(@array), not all array entries are bound. =head3 B SYS.DBMS_SQL.NUMBER_TABLE object handling is much alike ORA_VARCHAR2_TABLE. The main difference is internal data representation. Currently 2 types of bind is allowed : as C-integer, or as C-double type. To select one of them, you may specify additional bind parameter I as either B or B for C-integer and C-double types. Integer size is architecture-specific and is usually 32 or 64 bit. Double is standard IEEE 754 type. I defaults to double (SQLT_FLT). I is ignored for OCI_NUMBER_TABLE. Currently, you cannot bind full native Oracle NUMBER(38). If you really need, send request to dbi-dev list. The usage example is here: $statement=' DECLARE tbl SYS.DBMS_SQL.NUMBER_TABLE; BEGIN tbl := :mytable; :cc := tbl(2); tbl(4) := -1; tbl(5) := -2; :mytable := tbl; END; '; $sth=$dbh->prepare( $statement ); if( ! defined($sth) ){ die "Prepare error: ",$dbh->errstr,"\n"; } @arr=( 1,"2E0","3.5" ); # note, that ora_internal_type defaults to SQLT_FLT for ORA_NUMBER_TABLE . if( not $sth->bind_param_inout(":mytable", \\@arr, 10, { ora_type => ORA_NUMBER_TABLE, ora_maxarray_numentries => (scalar(@arr)+2), ora_internal_type => SQLT_FLT } ) ){ die "bind :mytable error: ",$dbh->errstr,"\n"; } $cc=undef; if( not $sth->bind_param_inout(":cc", \$cc, 100 ) ){ die "bind :cc error: ",$dbh->errstr,"\n"; } if( not $sth->execute() ){ die "Execute failed: ",$dbh->errstr,"\n"; } print "Result: cc=",$cc,"\n", "\tarr=",Data::Dumper::Dumper(\@arr),"\n"; The result is like: Result: cc=2 arr=$VAR1 = [ '1', '2', '3.5', '-1', '-2' ]; If you change bind type to B, like: ora_internal_type => SQLT_INT you get: Result: cc=2 arr=$VAR1 = [ 1, 2, 3, -1, -2 ]; =head2 B DBD::Oracle supports this undocumented feature of DBI. See L for an example. =head2 B $rv = $sth->bind_param_array($param_num, $array_ref_or_value) $rv = $sth->bind_param_array($param_num, $array_ref_or_value, $bind_type) $rv = $sth->bind_param_array($param_num, $array_ref_or_value, \%attr) Binds an array of values to a placeholder, so that each is used in turn by a call to the L method. =head2 B $rv = $sth->execute(@bind_values); Perform whatever processing is necessary to execute the prepared statement. =head2 B $tuples = $sth->execute_array() or die $sth->errstr; $tuples = $sth->execute_array(\%attr) or die $sth->errstr; $tuples = $sth->execute_array(\%attr, @bind_values) or die $sth->errstr; ($tuples, $rows) = $sth->execute_array(\%attr) or die $sth->errstr; ($tuples, $rows) = $sth->execute_array(\%attr, @bind_values) or die $sth->errstr; Execute a prepared statement once for each item in a passed-in hashref, or items that were previously bound via the L method. See the DBI documentation for more details. DBD::Oracle takes full advantage of OCI's array interface so inserts and updates using this interface will run very quickly. =head2 B $tuples = $sth->execute_for_fetch($fetch_tuple_sub); $tuples = $sth->execute_for_fetch($fetch_tuple_sub, \@tuple_status); ($tuples, $rows) = $sth->execute_for_fetch($fetch_tuple_sub); ($tuples, $rows) = $sth->execute_for_fetch($fetch_tuple_sub, \@tuple_status); Used internally by the L method, and rarely used directly. See the DBI documentation for more details. =head2 B $ary_ref = $sth->fetchrow_arrayref; Fetches the next row of data from the statement handle, and returns a reference to an array holding the column values. Any columns that are NULL are returned as undef within the array. If there are no more rows or if an error occurs, the this method return undef. You should check C<< $sth->err >> afterwards (or use the L attribute) to discover if the undef returned was due to an error. Note that the same array reference is returned for each fetch, so don't store the reference and then use it after a later fetch. Also, the elements of the array are also reused for each row, so take care if you want to take a reference to an element. See also L. =head2 B @ary = $sth->fetchrow_array; Similar to the L method, but returns a list of column information rather than a reference to a list. Do not use this in a scalar context. =head2 B $hash_ref = $sth->fetchrow_hashref; $hash_ref = $sth->fetchrow_hashref($name); Fetches the next row of data and returns a hashref containing the name of the columns as the keys and the data itself as the values. Any NULL value is returned as undef value. If there are no more rows or if an error occurs, the this method return undef. You should check C<< $sth->err >> afterwards (or use the L attribute) to discover if the undef returned was due to an error. The optional C<$name> argument should be either C, C or C, and indicates what sort of transformation to make to the keys in the hash. By default Oracle uses upper case. =head2 B $tbl_ary_ref = $sth->fetchall_arrayref(); $tbl_ary_ref = $sth->fetchall_arrayref( $slice ); $tbl_ary_ref = $sth->fetchall_arrayref( $slice, $max_rows ); Returns a reference to an array of arrays that contains all the remaining rows to be fetched from the statement handle. If there are no more rows, an empty arrayref will be returned. If an error occurs, the data read in so far will be returned. Because of this, you should always check C<< $sth->err >> after calling this method, unless L has been enabled. If C<$slice> is an array reference, fetchall_arrayref uses the L method to fetch each row as an array ref. If the C<$slice> array is not empty then it is used as a slice to select individual columns by perl array index number (starting at 0, unlike column and parameter numbers which start at 1). With no parameters, or if $slice is undefined, fetchall_arrayref acts as if passed an empty array ref. If C<$slice> is a hash reference, fetchall_arrayref uses L to fetch each row as a hash reference. See the DBI documentation for a complete discussion. =head2 B $hash_ref = $sth->fetchall_hashref( $key_field ); Returns a hashref containing all rows to be fetched from the statement handle. See the DBI documentation for a full discussion. =head2 B $rv = $sth->finish; Indicates to DBI that you are finished with the statement handle and are not going to use it again. Only needed when you have not fetched all the possible rows. =head2 B $rv = $sth->rows; Returns the number of rows affected for updates, deletes and inserts and -1 for selects. =head2 B $rv = $sth->bind_col($column_number, \$var_to_bind); $rv = $sth->bind_col($column_number, \$var_to_bind, \%attr ); $rv = $sth->bind_col($column_number, \$var_to_bind, $bind_type ); Binds a Perl variable and/or some attributes to an output column of a SELECT statement. Column numbers count up from 1. You do not need to bind output columns in order to fetch data. NOTE: DBD::Oracle does not use the C<$bind_type> to determine how to bind the column; it uses what Oracle says the data type is. You can however set the StrictlyTyped/DiscardString attributes and these will take effect as these attributes are applied after the column is retrieved. See the DBI documentation for a discussion of the optional parameters C<\%attr> and C<$bind_type> =head2 B $rv = $sth->bind_columns(@list_of_refs_to_vars_to_bind); Calls the L method for each column in the SELECT statement, using the supplied list. =head2 B $rows = $sth->dump_results($maxlen, $lsep, $fsep, $fh); Fetches all the rows from the statement handle, calls C for each row, and prints the results to C<$fh> (which defaults to F). Rows are separated by C<$lsep> (which defaults to a newline). Columns are separated by C<$fsep> (which defaults to a comma). The C<$maxlen> controls how wide the output can be, and defaults to 35. This method is designed as a handy utility for prototyping and testing queries. Since it uses "neat_list" to format and edit the string for reading by humans, it is not recommended for data transfer applications. =head1 STATEMENT HANDLE ATTRIBUTES =head2 B (integer, read-only) Returns the number of columns returned by the current statement. A number will only be returned for SELECT statements for INSERT, UPDATE, and DELETE statements which contain a RETURNING clause. This method returns undef if called before C. =head2 B (integer, read-only) Returns the number of placeholders in the current statement. =head2 B (arrayref, read-only) Returns an arrayref of column names for the current statement. This method will only work for SELECT statements, for SHOW statements, and for INSERT, UPDATE, and DELETE statements which contain a RETURNING clause. This method returns undef if called before C. =head2 B (arrayref, read-only) The same as the C attribute, except that all column names are forced to lower case. =head2 B (arrayref, read-only) The same as the C attribute, except that all column names are forced to upper case. =head2 B (hashref, read-only) Similar to the C attribute, but returns a hashref of column names instead of an arrayref. The names of the columns are the keys of the hash, and the values represent the order in which the columns are returned, starting at 0. This method returns undef if called before C. =head2 B (hashref, read-only) The same as the C attribute, except that all column names are forced to lower case. =head2 B (hashref, read-only) The same as the C attribute, except that all column names are forced to lower case. =head2 B (arrayref, read-only) Returns an arrayref indicating the data type for each column in the statement. This method returns undef if called before C. =head2 B (arrayref, read-only) Returns an arrayref of integer values for each column returned by the statement. The number indicates the precision for C columns, the size in number of characters for C and C columns, and for all other types of columns it returns the number of I. This method returns undef if called before C. =head2 B (arrayref, read-only) Returns an arrayref of integer values for each column returned by the statement. The number indicates the scale of the that column. The only type that will return a value is C. This method returns undef if called before C. =head2 B (arrayref, read-only) Returns an arrayref of integer values for each column returned by the statement. The number indicates if the column is nullable or not. 0 = not nullable, 1 = nullable, 2 = unknown. This method returns undef if called before C. =head2 B (dbh, read-only) Returns the database handle this statement handle was created from. =head2 B (hash ref, read-only) Returns a reference to a hash containing the values currently bound to placeholders. If the "named parameters" type of placeholders are being used (such as ":foo"), then the keys of the hash will be the names of the placeholders (without the colon). If the "dollar sign numbers" type of placeholders are being used, the keys of the hash will be the numbers, without the dollar signs. If the "question mark" type is used, integer numbers will be returned, starting at one and increasing for every placeholder. If this method is called before L, the literal values passed in are returned. If called after L, then the quoted versions of the values are returned. =head2 B (hash ref, read-only) Returns a reference to a hash containing the type names currently bound to placeholders. The keys are the same as returned by the ParamValues method. The values are hashrefs containing a single key value pair, in which the key is either 'TYPE' if the type has a generic SQL equivalent, and 'pg_type' if the type can only be expressed by a Postgres type. The value is the internal number corresponding to the type originally passed in. (Placeholders that have not yet been bound will return undef as the value). This allows the output of ParamTypes to be passed back to the L method. =head2 B (string, read-only) Returns the statement string passed to the most recent "prepare" method called in this database handle, even if that method failed. This is especially useful where "RaiseError" is enabled and the exception handler checks $@ and sees that a C method call failed. =head2 B Returns the number of un-fetched rows in the cache for selects. =head1 SCROLLABLE CURSORS Oracle supports the concept of a 'Scrollable Cursor' which is defined as a 'Result Set' where the rows can be fetched either sequentially or non-sequentially. One can fetch rows forward, backwards, from any given position or the n-th row from the current position in the result set. Rows are numbered sequentially starting at one and client-side caching of the partial or entire result set can improve performance by limiting round trips to the server. Oracle does not support DML type operations with scrollable cursors so you are limited to simple 'Select' operations only. As well you can not use this functionality with remote mapped queries or if the LONG datatype is part of the select list. However, LOBSs, CLOBSs, and BLOBs do work as do all the regular bind, and fetch methods. Only use scrollable cursors if you really have a good reason to. They do use up considerable more server and client resources and have poorer response times than non-scrolling cursors. =head2 Enabling Scrollable Cursors To enable this functionality you must first import the 'Fetch Orientation' and the 'Execution Mode' constants by using; use DBD::Oracle qw(:ora_fetch_orient :ora_exe_modes); Next you will have to tell DBD::Oracle that you will be using scrolling by setting the ora_exe_mode attribute on the statement handle to 'OCI_STMT_SCROLLABLE_READONLY' with the prepare method; $sth=$dbh->prepare($SQL,{ora_exe_mode=>OCI_STMT_SCROLLABLE_READONLY}); When the statement is executed you will then be able to use 'ora_fetch_scroll' method to get a row or you can still use any of the other fetch methods but with a poorer response time than if you used a non-scrolling cursor. As well scrollable cursors are compatible with any applicable bind methods. =head2 Scrollable Cursor Methods The following driver-specific methods are used with scrollable cursors. =over =item ora_scroll_position $position = $sth->ora_scroll_position(); This method returns the current position (row number) attribute of the result set. Prior to the first fetch this value is 0. This is the only time this value will be 0 after the first fetch the value will be set, so you can use this value to test if any rows have been fetched. The minimum value will always be 1 after the first fetch. The maximum value will always be the total number of rows in the record set. =item ora_fetch_scroll $ary_ref = $sth->ora_fetch_scroll($fetch_orient,$fetch_offset); Works the same as C, excepts one passes in a 'Fetch Orientation' constant and a fetch_offset value which will then determine the row that will be fetched. It returns the row as a list containing the field values. Null fields are returned as I values in the list. The valid orientation constant and fetch offset values combination are detailed below OCI_FETCH_CURRENT, fetches the current row, the fetch offset value is ignored. OCI_FETCH_NEXT, fetches the next row from the current position, the fetch offset value is ignored. OCI_FETCH_FIRST, fetches the first row, the fetch offset value is ignored. OCI_FETCH_LAST, fetches the last row, the fetch offset value is ignored. OCI_FETCH_PRIOR, fetches the previous row from the current position, the fetch offset value is ignored. OCI_FETCH_ABSOLUTE, fetches the row that is specified by the fetch offset value. OCI_FETCH_ABSOLUTE, and a fetch offset value of 1 is equivalent to a OCI_FETCH_FIRST. OCI_FETCH_ABSOLUTE, and a fetch offset value of 0 is equivalent to a OCI_FETCH_CURRENT. OCI_FETCH_RELATIVE, fetches the row relative from the current position as specified by the fetch offset value. OCI_FETCH_RELATIVE, and a fetch offset value of 0 is equivalent to a OCI_FETCH_CURRENT. OCI_FETCH_RELATIVE, and a fetch offset value of 1 is equivalent to a OCI_FETCH_NEXT. OCI_FETCH_RELATIVE, and a fetch offset value of -1 is equivalent to a OCI_FETCH_PRIOR. The effect that a ora_fetch_scroll method call has on the current_positon attribute is detailed below. OCI_FETCH_CURRENT, has no effect on the current_positon attribute. OCI_FETCH_NEXT, increments current_positon attribute by 1 OCI_FETCH_NEXT, when at the last row in the record set does not change current_positon attribute, it is equivalent to a OCI_FETCH_CURRENT OCI_FETCH_FIRST, sets the current_positon attribute to 1. OCI_FETCH_LAST, sets the current_positon attribute to the total number of rows in the record set. OCI_FETCH_PRIOR, decrements current_positon attribute by 1. OCI_FETCH_PRIOR, when at the first row in the record set does not change current_positon attribute, it is equivalent to a OCI_FETCH_CURRENT. OCI_FETCH_ABSOLUTE, sets the current_positon attribute to the fetch offset value. OCI_FETCH_ABSOLUTE, and a fetch offset value that is less than 1 does not change current_positon attribute, it is equivalent to a OCI_FETCH_CURRENT. OCI_FETCH_ABSOLUTE, and a fetch offset value that is greater than the number of records in the record set, does not change current_positon attribute, it is equivalent to a OCI_FETCH_CURRENT. OCI_FETCH_RELATIVE, sets the current_positon attribute to (current_positon attribute + fetch offset value). OCI_FETCH_RELATIVE, and a fetch offset value that makes the current position less than 1, does not change fetch offset value so it is equivalent to a OCI_FETCH_CURRENT. OCI_FETCH_RELATIVE, and a fetch offset value that makes it greater than the number of records in the record set, does not change fetch offset value so it is equivalent to a OCI_FETCH_CURRENT. The effects of the differing orientation constants on the first fetch (current_postion attribute at 0) are as follows. OCI_FETCH_CURRENT, dose not fetch a row or change the current_positon attribute. OCI_FETCH_FIRST, fetches row 1 and sets the current_positon attribute to 1. OCI_FETCH_LAST, fetches the last row in the record set and sets the current_positon attribute to the total number of rows in the record set. OCI_FETCH_NEXT, equivalent to a OCI_FETCH_FIRST. OCI_FETCH_PRIOR, equivalent to a OCI_FETCH_CURRENT. OCI_FETCH_ABSOLUTE, and a fetch offset value that is less than 1 is equivalent to a OCI_FETCH_CURRENT. OCI_FETCH_ABSOLUTE, and a fetch offset value that is greater than the number of records in the record set is equivalent to a OCI_FETCH_CURRENT. OCI_FETCH_RELATIVE, and a fetch offset value that is less than 1 is equivalent to a OCI_FETCH_CURRENT. OCI_FETCH_RELATIVE, and a fetch offset value that makes it greater than the number of records in the record set, is equivalent to a OCI_FETCH_CURRENT. =back =head2 Scrollable Cursor Usage Given a simple code like this: use DBI; use DBD::Oracle qw(:ora_types :ora_fetch_orient :ora_exe_modes); my $dbh = DBI->connect($dsn, $dbuser, ''); my $SQL = "select id, first_name, last_name from employee"; my $sth=$dbh->prepare($SQL,{ora_exe_mode=>OCI_STMT_SCROLLABLE_READONLY}); $sth->execute(); my $value; and one assumes that the number of rows returned from the query is 20, the code snippets below will illustrate the use of ora_fetch_scroll method; =over =item Fetching the Last Row $value = $sth->ora_fetch_scroll(OCI_FETCH_LAST,0); print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n"; print "current scroll position=".$sth->ora_scroll_position()."\n"; The current_positon attribute to will be 20 after this snippet. This is also a way to get the number of rows in the record set, however, if the record set is large this could take some time. =item Fetching the Current Row $value = $sth->ora_fetch_scroll(OCI_FETCH_CURRENT,0); print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n"; print "current scroll position=".$sth->ora_scroll_position()."\n"; The current_positon attribute will still be 20 after this snippet. =item Fetching the First Row $value = $sth->ora_fetch_scroll(OCI_FETCH_FIRST,0); print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n"; print "current scroll position=".$sth->ora_scroll_position()."\n"; The current_positon attribute will be 1 after this snippet. =item Fetching the Next Row for(my $i=0;$i<=3;$i++){ $value = $sth->ora_fetch_scroll(OCI_FETCH_NEXT,0); print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n"; } print "current scroll position=".$sth->ora_scroll_position()."\n"; The current_positon attribute will be 5 after this snippet. =item Fetching the Prior Row for(my $i=0;$i<=3;$i++){ $value = $sth->ora_fetch_scroll(OCI_FETCH_PRIOR,0); print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n"; } print "current scroll position=".$sth->ora_scroll_position()."\n"; The current_positon attribute will be 1 after this snippet. =item Fetching the 10th Row $value = $sth->ora_fetch_scroll(OCI_FETCH_ABSOLUTE,10); print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n"; print "current scroll position=".$sth->ora_scroll_position()."\n"; The current_positon attribute will be 10 after this snippet. =item Fetching the 10th to 14th Row for(my $i=10;$i<15;$i++){ $value = $sth->ora_fetch_scroll(OCI_FETCH_ABSOLUTE,$i); print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n"; } print "current scroll position=".$sth->ora_scroll_position()."\n"; The current_positon attribute will be 14 after this snippet. =item Fetching the 14th to 10th Row for(my $i=14;$i>9;$i--){ $value = $sth->ora_fetch_scroll(OCI_FETCH_ABSOLUTE,$i); print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n"; } print "current scroll position=".$sth->ora_scroll_position()."\n"; The current_positon attribute will be 10 after this snippet. =item Fetching the 5th Row From the Present Position. $value = $sth->ora_fetch_scroll(OCI_FETCH_RELATIVE,5); print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n"; print "current scroll position=".$sth->ora_scroll_position()."\n"; The current_positon attribute will be 15 after this snippet. =item Fetching the 9th Row Prior From the Present Position $value = $sth->ora_fetch_scroll(OCI_FETCH_RELATIVE,-9); print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n"; print "current scroll position=".$sth->ora_scroll_position()."\n"; The current_positon attribute will be 6 after this snippet. =item Use Finish $sth->finish(); When using scrollable cursors it is required that you use the $sth->finish() method when you are done with the cursor as this type of cursor has to be explicitly cancelled on the server. If you do not do this you may cause resource problems on your database. =back =head1 LOBS AND LONGS The key to working with LOBs (CLOB, BLOBs) is to remember the value of an Oracle LOB column is not the content of the LOB. It's a 'LOB Locator' which, after being selected or inserted needs extra processing to read or write the content of the LOB. There are also legacy LONG types (LONG, LONG RAW, VARCHAR2) which are presently deprecated by Oracle but are still in use. These LONG types do not utilize a 'LOB Locator' and also are more limited in functionality than CLOB or BLOB fields. DBD::Oracle now offers three interfaces to LOB and LONG data, =over =item L With this interface DBD::Oracle handles your data directly utilizing regular OCI calls, Oracle itself takes care of the LOB Locator operations in the case of BLOBs and CLOBs treating them exactly as if they were the same as the legacy LONG or LONG RAW types. =item L With this interface DBD::Oracle handles your data utilizing LOB Locator OCI calls so it only works with CLOB and BLOB datatypes. With this interface DBD::Oracle takes care of the LOB Locator operations for you. =item L This allows the user direct access to the LOB Locator methods, so you have to take case of the LOB Locator operations yourself. =back Generally speaking the interface that you will chose will be dependent on what end you are trying to achieve. All have their benefits and drawbacks. One point to remember when working with LOBs (CLOBs, BLOBs) is if your LOB column can be in one of three states; =over =item NULL The table cell is created, but the cell holds no locator or value. If your LOB field is in this state then there is no LOB Locator that DBD::Oracle can work so if your encounter a DBD::Oracle::db::ora_lob_read: locator is not of type OCILobLocatorPtr error when working with a LOB. You can correct this by using an SQL UPDATE statement to reset the LOB column to a non-NULL (or empty LOB) value with either EMPTY_BLOB or EMPTY_CLOB as in this example; UPDATE lob_example SET bindata=EMPTY_BLOB() WHERE bindata IS NULL. =item Empty A LOB instance with a locator exists in the cell, but it has no value. The length of the LOB is zero. In this case DBD::Oracle will return 'undef' for the field. =item Populated A LOB instance with a locator and a value exists in the cell. You actually get the LOB value. =back =head2 Data Interface for Persistent LOBs This is the original interface for LONG and LONG RAW datatypes and from Oracle 9iR1 and later the OCI API was extended to work directly with the other LOB datatypes. In other words you can treat all LOB type data (BLOB, CLOB) as if it was a LONG, LONG RAW, or VARCHAR2. So you can perform INSERT, UPDATE, fetch, bind, and define operations on LOBs using the same techniques you would use on other datatypes that store character or binary data. In some cases there are fewer round trips to the server as no 'LOB Locators' are used, normally one can get an entire LOB is a single round trip. =head3 Simple Fetch for LONGs and LONG RAWs As the name implies this is the simplest way to use this interface. DBD::Oracle just attempts to get your LONG datatypes as a single large piece. There are no special settings, simply set the database handle's 'LongReadLen' attribute to a value that will be the larger than the expected size of the LONG or LONG RAW. If the size of the LONG or LONG RAW exceeds the 'LongReadLen' DBD::Oracle will return a 'ORA-24345: A Truncation' error. To stop this set the database handle's 'LongTruncOk' attribute to '1'. The maximum value of 'LongReadLen' seems to be dependent on the physical memory limits of the box that Oracle is running on. You have most likely reached this limit if you run into an 'ORA-01062: unable to allocate memory for define buffer' error. One solution is to set the size of 'LongReadLen' to a lower value. For example give this table; CREATE TABLE test_long ( id NUMBER, long1 long) this code; $dbh->{LongReadLen} = 2*1024*1024; #2 meg $SQL='select p_id,long1 from test_long'; $sth=$dbh->prepare($SQL); $sth->execute(); while (my ( $p_id,$long )=$sth->fetchrow()){ print "p_id=".$p_id."\n"; print "long=".$long."\n"; } Will select out all of the long1 fields in the table as long as they are all under 2MB in length. A value in long1 longer than this will throw an error. Adding this line; $dbh->{LongTruncOk}=1; before the execute will return all the long1 fields but they will be truncated at 2MBs. =head3 Using ora_ncs_buff_mtpl When getting CLOBs and NCLOBs in or out of Oracle, the Server will translate from the Server's NCharSet to the Client's. If they happen to be the same or at least compatible then all of these actions are a 1 char to 1 char bases. Thus if you set your LongReadLen buffer to 10_000_000 you will get up to 10_000_000 char. However if the Server has to translate from one NCharSet to another it will use bytes for conversion. The buffer value is set to 4 * LONG_READ_LEN which was very wasteful as you might only be asking for 10_000_000 bytes but you were actually using 40_000_000 bytes of buffer under the hood. You would still get 10_000_000 bytes (maybe less characters though) but you are using allot more memory that you need. You can now customize the size of the buffer by setting the 'ora_ncs_buff_mtpl' either on the connection or statement handle. You can also set this as 'ORA_DBD_NCS_BUFFER' OS environment variable so you will have to go back and change all your code if you are getting into trouble. The default value is still set to 4 for backward compatibility. You can lower this value and thus increase the amount of data you can retrieve. If the ora_ncs_buff_mtpl is too small DBD::Oracle will throw and error telling you to increase this buffer by one. If the error is not captured then you may get at some random point later on, usually at a finish() or disconnect() or even a fetch() this error; ORA-03127: no new operations allowed until the active operation ends This is one of the more obscure ORA errors (have some fun and report it to Meta-Link they will scratch their heads for hours) If you get this, simply increment the ora_ncs_buff_mtpl by one until it goes away. This should greatly increase your ability to select very large CLOBs or NCLOBs, by freeing up a large block of memory. You can tune this value by setting ora_oci_success_warn which will display the following OCILobRead field 2 of 3 SUCCESS: csform 1 (SQLCS_IMPLICIT), LOBlen 10240(characters), LongReadLen 20(characters), BufLen 80(characters), Got 28(characters) In the case above the query Got 28 characters (well really only 20 characters of 28 bytes) so we could use ora_ncs_buff_mtpl=>2 (20*2=40) thus saving 40bytes of memory. =head3 Simple Fetch for CLOBs and BLOBs To use this interface for CLOBs and LOBs datatypes set the 'ora_pers_lob' attribute of the statement handle to '1' with the prepare method, as well set the database handle's 'LongReadLen' attribute to a value that will be the larger than the expected size of the LOB. If the size of the LOB exceeds the 'LongReadLen' DBD::Oracle will return a 'ORA-24345: A Truncation' error. To stop this set the database handle's 'LongTruncOk' attribute to '1'. The maximum value of 'LongReadLen' seems to be dependent on the physical memory limits of the box that Oracle is running on in the same way that LONGs and LONG RAWs are. For CLOBs and NCLOBs the limit is 64k chars if there is no truncation, this is an internal OCI limit complain to them if you want it changed. However if you CLOB is longer than this and also larger than the 'LongReadLen' than the 'LongReadLen' in chars is returned. It seems with BLOBs you are not limited by the 64k. For example give this table; CREATE TABLE test_lob (id NUMBER, clob1 CLOB, clob2 CLOB, blob1 BLOB, blob2 BLOB) this code; $dbh->{LongReadLen} = 2*1024*1024; #2 meg $SQL='select p_id,lob_1,lob_2,blob_2 from test_lobs'; $sth=$dbh->prepare($SQL,{ora_pers_lob=>1}); $sth->execute(); while (my ( $p_id,$log,$log2,$log3,$log4 )=$sth->fetchrow()){ print "p_id=".$p_id."\n"; print "clob1=".$clob1."\n"; print "clob2=".$clob2."\n"; print "blob1=".$blob2."\n"; print "blob2=".$blob2."\n"; } Will select out all of the LOBs in the table as long as they are all under 2MB in length. Longer lobs will throw an error. Adding this line; $dbh->{LongTruncOk}=1; before the execute will return all the lobs but they will be truncated at 2MBs. =head3 Piecewise Fetch with Callback With a piecewise callback fetch DBD::Oracle sets up a function that will 'callback' to the DB during the fetch and gets your LOB (LONG, LONG RAW, CLOB, BLOB) piece by piece. To use this interface set the 'ora_clbk_lob' attribute of the statement handle to '1' with the prepare method. Next set the 'ora_piece_size' to the size of the piece that you want to return on the callback. Finally set the database handle's 'LongReadLen' attribute to a value that will be the larger than the expected size of the LOB. Like the L and L the if the size of the LOB exceeds the is 'LongReadLen' you can use the 'LongTruncOk' attribute to truncate the LOB or set the 'LongReadLen' to a higher value. With this interface the value of 'ora_piece_size' seems to be constrained by the same memory limit as found on the Simple Fetch interface. If you encounter an 'ORA-01062' error try setting the value of 'ora_piece_size' to a smaller value. The value for 'LongReadLen' is dependent on the version and settings of the Oracle DB you are using. In theory it ranges from 8GBs in 9iR1 up to 128 terabytes with 11g but you will also be limited by the physical memory of your PERL instance. Using the table from the last example this code; $dbh->{LongReadLen} = 20*1024*1024; #20 meg $SQL='select p_id,lob_1,lob_2,blob_2 from test_lobs'; $sth=$dbh->prepare($SQL,{ora_clbk_lob=>1,ora_piece_size=>5*1024*1024}); $sth->execute(); while (my ( $p_id,$log,$log2,$log3,$log4 )=$sth->fetchrow()){ print "p_id=".$p_id."\n"; print "clob1=".$clob1."\n"; print "clob2=".$clob2."\n"; print "blob1=".$blob2."\n"; print "blob2=".$blob2."\n"; } Will select out all of the LOBs in the table as long as they are all under 20MB in length. If the LOB is longer than 5MB (ora_piece_size) DBD::Oracle will fetch it in at least 2 pieces to a maximum of 4 pieces (4*5MB=20MB). Like the Simple Fetch examples Lobs longer than 20MB will throw an error. Using the table from the first example (LONG) this code; $dbh->{LongReadLen} = 20*1024*1024; #2 meg $SQL='select p_id,long1 from test_long'; $sth=$dbh->prepare($SQL,{ora_clbk_lob=>1,ora_piece_size=>5*1024*1024}); $sth->execute(); while (my ( $p_id,$long )=$sth->fetchrow()){ print "p_id=".$p_id."\n"; print "long=".$long."\n"; } Will select all of the long1 fields from table as long as they are is under 20MB in length. If the long1 filed is longer than 5MB (ora_piece_size) DBD::Oracle will fetch it in at least 2 pieces to a maximum of 4 pieces (4*5MB=20MB). Like the other examples long1 fields longer than 20MB will throw an error. =head4 Piecewise Fetch with Polling With a polling piecewise fetch DBD::Oracle iterates (Polls) over the LOB during the fetch getting your LOB (LONG, LONG RAW, CLOB, BLOB) piece by piece. To use this interface set the 'ora_piece_lob' attribute of the statement handle to '1' with the prepare method. Next set the 'ora_piece_size' to the size of the piece that you want to return on the callback. Finally set the database handle's 'LongReadLen' attribute to a value that will be the larger than the expected size of the LOB. Like the L and Simple Fetches if the size of the LOB exceeds the is 'LongReadLen' you can use the 'LongTruncOk' attribute to truncate the LOB or set the 'LongReadLen' to a higher value. With this interface the value of 'ora_piece_size' seems to be constrained by the same memory limit as found on the L. Using the table from the example above this code; $dbh->{LongReadLen} = 20*1024*1024; #20 meg $SQL='select p_id,lob_1,lob_2,blob_2 from test_lobs'; $sth=$dbh->prepare($SQL,{ora_piece_lob=>1,ora_piece_size=>5*1024*1024}); $sth->execute(); while (my ( $p_id,$log,$log2,$log3,$log4 )=$sth->fetchrow()){ print "p_id=".$p_id."\n"; print "clob1=".$clob1."\n"; print "clob2=".$clob2."\n"; print "blob1=".$blob2."\n"; print "blob2=".$blob2."\n"; } Will select out all of the LOBs in the table as long as they are all under 20MB in length. If the LOB is longer than 5MB (ora_piece_size) DBD::Oracle will fetch it in at least 2 pieces to a maximum of 4 pieces (4*5MB=20MB). Like the other fetch methods LOBs longer than 20MB will throw an error. Finally with this code; $dbh->{LongReadLen} = 20*1024*1024; #2 meg $SQL='select p_id,long1 from test_long'; $sth=$dbh->prepare($SQL,{ora_piece_lob=>1,ora_piece_size=>5*1024*1024}); $sth->execute(); while (my ( $p_id,$long )=$sth->fetchrow()){ print "p_id=".$p_id."\n"; print "long=".$long."\n"; } Will select all of the long1 fields from table as long as they are is under 20MB in length. If the long1 field is longer than 5MB (ora_piece_size) DBD::Oracle will fetch it in at least 2 pieces to a maximum of 4 pieces (4*5MB=20MB). Like the other examples long1 fields longer than 20MB will throw an error. =head3 Binding for Updates and Inserts for CLOBs and BLOBs To bind for updates and inserts all that is required to use this interface is to set the statement handle's prepare method 'ora_type' attribute to 'SQLT_CHR' in the case of CLOBs and NCLOBs or 'SQLT_BIN' in the case of BLOBs as in this example for an insert; my $in_clob = "\n"; $in_clob .= " $_\n" for 1 .. 10_000; $in_clob .= "\n"; my $in_blob ="0101" for 1 .. 10_000; $SQL='insert into test_lob3@tpgtest (id,clob1,clob2, blob1,blob2) values(?,?,?,?,?)'; $sth=$dbh->prepare($SQL ); $sth->bind_param(1,3); $sth->bind_param(2,$in_clob,{ora_type=>SQLT_CHR}); $sth->bind_param(3,$in_clob,{ora_type=>SQLT_CHR}); $sth->bind_param(4,$in_blob,{ora_type=>SQLT_BIN}); $sth->bind_param(5,$in_blob,{ora_type=>SQLT_BIN}); $sth->execute(); So far the only limit reached with this form of insert is the LOBs must be under 2GB in size. =head3 Support for Remote LOBs; Starting with Oracle 10gR2 the interface for Persistent LOBs was expanded to support remote LOBs (access over a dblink). Given a database called 'lob_test' that has a 'LINK' defined like this; CREATE DATABASE LINK link_test CONNECT TO test_lobs IDENTIFIED BY tester USING 'lob_test'; to a remote database called 'test_lobs', the following code will work; $dbh = DBI->connect('dbi:Oracle:','test@lob_test','test'); $dbh->{LongReadLen} = 2*1024*1024; #2 meg $SQL='select p_id,lob_1,lob_2,blob_2 from test_lobs@link_test'; $sth=$dbh->prepare($SQL,{ora_pers_lob=>1}); $sth->execute(); while (my ( $p_id,$log,$log2,$log3,$log4 )=$sth->fetchrow()){ print "p_id=".$p_id."\n"; print "clob1=".$clob1."\n"; print "clob2=".$clob2."\n"; print "blob1=".$blob2."\n"; print "blob2=".$blob2."\n"; } Below are the limitations of Remote LOBs; =over =item Queries involving more than one database are not supported; so the following returns an error: SELECT t1.lobcol, a2.lobcol FROM t1, t2.lobcol@dbs2 a2 W WHERE LENGTH(t1.lobcol) = LENGTH(a2.lobcol); as does: SELECT t1.lobcol FROM t1@dbs1 UNION ALL SELECT t2.lobcol FROM t2@dbs2; =item DDL commands are not supported; so the following returns an error: CREATE VIEW v AS SELECT lob_col FROM tab@dbs; =item Only binds and defines for data going into remote persistent LOBs are supported. so that parameter passing in PL/SQL where CHAR data is bound or defined for remote LOBs is not allowed . These statements all produce errors: SELECT foo() FROM table1@dbs2; SELECT foo()@dbs INTO char_val FROM DUAL; SELECT XMLType().getclobval FROM table1@dbs2; =item If the remote object is a view such as CREATE VIEW v AS SELECT foo() FROM ... the following would not work: SELECT * FROM v@dbs2; =item Limited PL/SQL parameter passing PL/SQL parameter passing is not allowed where the actual argument is a LOB type and the remote argument is one of VARCHAR2, NVARCHAR2, CHAR, NCHAR, or RAW. =item RETURNING INTO does not support implicit conversions between CHAR and CLOB. so the following returns an error: SELECT t1.lobcol as test, a2.lobcol FROM t1, t2.lobcol@dbs2 a2 RETURNING test =back =head2 Locator Data Interface =head3 Simple Usage When fetching LOBs with this interface a 'LOB Locator' is created then used to get the lob with the LongReadLen and LongTruncOk attributes. The value for 'LongReadLen' is dependent on the version and settings of the Oracle DB you are using. In theory it ranges from 8GBs in 9iR1 up to 128 terabytes with 11g but you will also be limited by the physical memory of your PERL instance. When inserting or updating LOBs some I magic has to be performed behind the scenes to make it transparent. Basically the driver has to insert a 'LOB Locator' and then refetch the newly inserted LOB Locator before being able to write the data into it. However, it works well most of the time, and I've made it as fast as possible, just one extra server-round-trip per insert or update after the first. For the time being, only single-row LOB updates are supported. To insert or update a large LOB using a placeholder, DBD::Oracle has to know in advance that it is a LOB type. So you need to say: $sth->bind_param($field_num, $lob_value, { ora_type => ORA_CLOB }); The ORA_CLOB and ORA_BLOB constants can be imported using use DBD::Oracle qw(:ora_types); or use the corresponding integer values (112 and 113). One further wrinkle: for inserts and updates of LOBs, DBD::Oracle has to be able to tell which parameters relate to which table fields. In all cases where it can possibly work it out for itself, it does, however, if there are multiple LOB fields of the same type in the table then you need to tell it which field each LOB param relates to: $sth->bind_param($idx, $value, { ora_type=>ORA_CLOB, ora_field=>'foo' }); There are some limitations inherent in the way DBD::Oracle makes typical LOB operations simple by hiding the LOB Locator processing: - Can't read/write LOBs in chunks (except via DBMS_LOB.WRITEAPPEND in PL/SQL) - To INSERT a LOB, you need UPDATE privilege. The alternative is to disable the automatic LOB Locator processing. If L is 0 in prepare(), you can fetch the LOB Locators and do all the work yourself using the ora_lob_*() methods. See the L section below. =head3 LOB support in PL/SQL LOB Locators can be passed to PL/SQL calls by binding them to placeholders with the proper C. If L is true, output LOB parameters will be automatically returned as strings. If the Oracle driver has support for temporary LOBs (Oracle 9i and higher), strings can be bound to input LOB placeholders and will be automatically converted to LOBs. Example: # Build a large XML document, bind it as a CLOB, # extract elements through PL/SQL and return as a CLOB # $dbh is a connected database handle # output will be large local $dbh->{LongReadLen} = 1_000_000; my $in_clob = "\n"; $in_clob .= " $_\n" for 1 .. 10_000; $in_clob .= "\n"; my $out_clob; my $sth = $dbh->prepare(<bind_param( ':in', $in_clob, { ora_type => ORA_CLOB } ); $sth->bind_param_inout( ':out', \$out_clob, 0, { ora_type => ORA_CLOB } ); $sth->execute; If you ever get an ORA-01691 unable to extend lob segment sss.ggg by nnn in tablespace ttt error, while attempting to insert a LOB, this means the Oracle user has insufficient space for LOB you are trying to insert. One solution it to use "alter database datafile 'sss.ggg' resize Mnnn" to increase the available memory for LOBs. =head2 Persistent & Locator Interface Caveats Now that one has the option of using the Persistent or the Locator interface for LOBs the questions arises which one to use. For starters, if you want to access LOBs over a dblink you will have to use the Persistent interface so that choice is simple. The question of which one to use after that is a little more tricky. It basically boils down to a choice between LOB size and speed. The Callback and Polling piecewise fetches are very very slow when compared to the Simple and the Locator fetches but they can handle very large blocks of data. Given a situation where a large LOB is to be read the Locator fetch may time out while either of the piecewise fetches may not. With the Simple fetch you are limited by physical memory of your server but it runs a little faster than the Locator, as there are fewer round trips to the server. So if you have small LOBs and need to save a little bandwidth this is the one to use. It you are going after large LOBs then the Locator interface is the one to use. If you need to update more than a single row of with LOB data then the Persistent interface can do it while the Locator can't. If you encounter a situation where you have to access the legacy LOBs (LONG, LONG RAW) and the values are to large for you system then you can use the Callback or Polling piecewise fetches to get all of the data. Not all of the Persistent interface has been implemented yet, the following are not supported; 1) Piecewise, polling and callback binds for INSERT and UPDATE operations. 2) Piecewise array binds for SELECT, INSERT and UPDATE operations. Most of the time you should just use the L as this is in one that has the best combination of speed and size. All this being said if you are doing some critical programming I would use the L as this gives you very fine grain control of your LOBs, of course the code for this will be somewhat more involved. =head2 Data Interface for LOB Locators The following driver-specific methods let you manipulate "LOB Locators" directly. To select a LOB locator directly set the if the C attribute to false, or alternatively they can be returned via PL/SQL procedure calls. (If using a DBI version earlier than 1.36 they must be called via the func() method. Note that methods called via func() don't honour RaiseError etc, and so it's important to check $dbh->err after each call. It's recommended that you upgrade to DBI 1.38 or later.) Note that LOB locators are only valid while the statement handle that created them is valid. When all references to the original statement handle are lost, the handle is destroyed and the locators are freed. =over 4 =item ora_lob_read $data = $dbh->ora_lob_read($lob_locator, $offset, $length); Read a portion of the LOB. $offset starts at 1. Uses the Oracle OCILobRead function. NOTE: DBD::Oracle post 1.46 will return undef for any read lob if the length specified in the ora_lob_read is 0. See RT 55028. This avoids the potential problem with empty lobs (created with empty_clob) which return a length of 0 from ora_lob_length and prior to 1.46 a call to ora_lob_read with a 0 length would segfault. =item ora_lob_write $rc = $dbh->ora_lob_write($lob_locator, $offset, $data); Write/overwrite a portion of the LOB. $offset starts at 1. Uses the Oracle OCILobWrite function. =item ora_lob_append $rc = $dbh->ora_lob_append($lob_locator, $data); Append $data to the LOB. Uses the Oracle OCILobWriteAppend function. =item ora_lob_trim $rc = $dbh->ora_lob_trim($lob_locator, $length); Trims the length of the LOB to $length. Uses the Oracle OCILobTrim function. =item ora_lob_length $length = $dbh->ora_lob_length($lob_locator); Returns the length of the LOB. Uses the Oracle OCILobGetLength function. =item ora_lob_is_init $is_init = $dbh->ora_lob_is_init($lob_locator); Returns true(1) if the Lob Locator is initialized false(0) if it is not, or 'undef' if there is an error. Uses the Oracle OCILobLocatorIsInit function. =item ora_lob_chunk_size $chunk_size = $dbh->ora_lob_chunk_size($lob_locator); Returns the chunk size of the LOB. Uses the Oracle OCILobGetChunkSize function. For optimal performance, Oracle recommends reading from and writing to a LOB in batches using a multiple of the LOB chunk size. In Oracle 10g and before, when all defaults are in place, this chunk size defaults to 8k (8192). =back =head3 LOB Locator Method Examples I Make sure you first read the note in the section above about multi-byte character set issues with these methods. The following examples demonstrate the usage of LOB Locators to read, write, and append data, and to query the size of large data. The following examples assume a table containing two large object columns, one binary and one character, with a primary key column, defined as follows: CREATE TABLE lob_example ( lob_id INTEGER PRIMARY KEY, bindata BLOB, chardata CLOB ) It also assumes a sequence for use in generating unique lob_id field values, defined as follows: CREATE SEQUENCE lob_example_seq =head3 Example: Inserting a new row with large data Unless enough memory is available to store and bind the entire LOB data for insert all at once, the LOB columns must be written interactively, piece by piece. In the case of a new row, this is performed by first inserting a row, with empty values in the LOB columns, then modifying the row by writing the large data interactively to the LOB columns using their LOB locators as handles. The insert statement must create token values in the LOB columns. Here, we use the empty string for both the binary and character large object columns 'bindata' and 'chardata'. After the INSERT statement, a SELECT statement is used to acquire LOB locators to the 'bindata' and 'chardata' fields of the newly inserted row. Because these LOB locators are subsequently written, they must be acquired from a select statement containing the clause 'FOR UPDATE' (LOB locators are only valid within the transaction that fetched them, so can't be used effectively if AutoCommit is enabled). my $lob_id = $dbh->selectrow_array( <<" SQL" ); SELECT lob_example_seq.nextval FROM DUAL SQL my $sth = $dbh->prepare( <<" SQL" ); INSERT INTO lob_example ( lob_id, bindata, chardata ) VALUES ( ?, EMPTY_BLOB(),EMPTY_CLOB() ) SQL $sth->execute( $lob_id ); $sth = $dbh->prepare( <<" SQL", { ora_auto_lob => 0 } ); SELECT bindata, chardata FROM lob_example WHERE lob_id = ? FOR UPDATE SQL $sth->execute( $lob_id ); my ( $bin_locator, $char_locator ) = $sth->fetchrow_array(); $sth->finish(); open BIN_FH, "/binary/data/source" or die; open CHAR_FH, "/character/data/source" or die; my $chunk_size = $dbh->ora_lob_chunk_size( $bin_locator ); # BEGIN WRITING BIN_DATA COLUMN my $offset = 1; # Offsets start at 1, not 0 my $length = 0; my $buffer = ''; while( $length = read( BIN_FH, $buffer, $chunk_size ) ) { $dbh->ora_lob_write( $bin_locator, $offset, $buffer ); $offset += $length; } # BEGIN WRITING CHAR_DATA COLUMN $chunk_size = $dbh->ora_lob_chunk_size( $char_locator ); $offset = 1; # Offsets start at 1, not 0 $length = 0; $buffer = ''; while( $length = read( CHAR_FH, $buffer, $chunk_size ) ) { $dbh->ora_lob_write( $char_locator, $offset, $buffer ); $offset += $length; } In this example we demonstrate the use of ora_lob_write() interactively to append data to the columns 'bin_data' and 'char_data'. Had we used ora_lob_append(), we could have saved ourselves the trouble of keeping track of the offset into the lobs. The snippet of code beneath the comment 'BEGIN WRITING BIN_DATA COLUMN' could look as follows: my $buffer = ''; while ( read( BIN_FH, $buffer, $chunk_size ) ) { $dbh->ora_lob_append( $bin_locator, $buffer ); } The scalar variables $offset and $length are no longer needed, because ora_lob_append() keeps track of the offset for us. =head3 Example: Updating an existing row with large data In this example, we demonstrate a technique for overwriting a portion of a blob field with new binary data. The blob data before and after the section overwritten remains unchanged. Hence, this technique could be used for updating fixed length subfields embedded in a binary field. my $lob_id = 5; # Arbitrary row identifier, for example $sth = $dbh->prepare( <<" SQL", { ora_auto_lob => 0 } ); SELECT bindata FROM lob_example WHERE lob_id = ? FOR UPDATE SQL $sth->execute( $lob_id ); my ( $bin_locator ) = $sth->fetchrow_array(); my $offset = 100234; my $data = "This string will overwrite a portion of the blob"; $dbh->ora_lob_write( $bin_locator, $offset, $data ); After running this code, the row where lob_id = 5 will contain, starting at position 100234 in the bin_data column, the string "This string will overwrite a portion of the blob". =head3 Example: Streaming character data from the database In this example, we demonstrate a technique for streaming data from the database to a file handle, in this case STDOUT. This allows more data to be read in and written out than could be stored in memory at a given time. my $lob_id = 17; # Arbitrary row identifier, for example $sth = $dbh->prepare( <<" SQL", { ora_auto_lob => 0 } ); SELECT chardata FROM lob_example WHERE lob_id = ? SQL $sth->execute( $lob_id ); my ( $char_locator ) = $sth->fetchrow_array(); my $chunk_size = 1034; # Arbitrary chunk size, for example my $offset = 1; # Offsets start at 1, not 0 while(1) { my $data = $dbh->ora_lob_read( $char_locator, $offset, $chunk_size ); last unless length $data; print STDOUT $data; $offset += $chunk_size; } Notice that the select statement does not contain the phrase "FOR UPDATE". Because we are only reading from the LOB Locator returned, and not modifying the LOB it refers to, the select statement does not require the "FOR UPDATE" clause. A word of caution when using the data returned from an ora_lob_read in a conditional statement. for example if the code below; while( my $data = $dbh->ora_lob_read( $char_locator, $offset, $chunk_size ) ) { print STDOUT $data; $offset += $chunk_size; } was used with a chunk size of 4096 against a blob that requires more than 1 chunk to return the data and the last chunk is one byte long and contains a zero (ASCII 48) you will miss this last byte as $data will contain 0 which PERL will see as false and not print it out. =head3 Example: Truncating existing large data In this example, we truncate the data already present in a large object column in the database. Specifically, for each row in the table, we truncate the 'bindata' value to half its previous length. After acquiring a LOB Locator for the column, we query its length, then we trim the length by half. Because we modify the large objects with the call to ora_lob_trim(), we must select the LOB locators 'FOR UPDATE'. my $sth = $dbh->prepare( <<" SQL", { ora_auto_lob => 0 } ); SELECT bindata FROM lob_example FOR UPATE SQL $sth->execute(); while( my ( $bin_locator ) = $sth->fetchrow_array() ) { my $binlength = $dbh->ora_lob_length( $bin_locator ); if( $binlength > 0 ) { $dbh->ora_lob_trim( $bin_locator, $binlength/2 ); } } =head1 SPACES AND PADDING =head2 Trailing Spaces Only the Oracle OCI 8 strips trailing spaces from VARCHAR placeholder values and uses Nonpadded Comparison Semantics with the result. This causes trouble if the spaces are needed for comparison with a CHAR value or to prevent the value from becoming '' which Oracle treats as NULL. Look for Blank-padded Comparison Semantics and Nonpadded Comparison Semantics in Oracle's SQL Reference or Server SQL Reference for more details. To preserve trailing spaces in placeholder values for Oracle clients that use OCI 8, either change the default placeholder type with L or the placeholder type for a particular call to L or L with L or C. Using L with L or C with C allows the placeholder to be used with Padded Comparison Semantics if the value it is being compared to is a CHAR, NCHAR, or literal. Please remember that using spaces as a value or at the end of a value makes visually distinguishing values with different numbers of spaces difficult and should be avoided. Oracle Clients that use OCI 9.2 do not strip trailing spaces. =head2 Padded Char Fields Oracle Clients after OCI 9.2 will automatically pad CHAR placeholder values to the size of the CHAR. As the default placeholder type value in DBD::Oracle is ORA_VARCHAR2 to access this behaviour you will have to change the default placeholder type with L or placeholder type for a particular call with L or L with L. =head1 UNICODE DBD::Oracle now supports Unicode UTF-8. There are, however, a number of issues you should be aware of, so please read all this section carefully. In this section we'll discuss "Perl and Unicode", then "Oracle and Unicode", and finally "DBD::Oracle and Unicode". Information about Unicode in general can be found at: L. It is well worth reading because there are many misconceptions about Unicode and you may be holding some of them. =head2 Perl and Unicode Perl began implementing Unicode with version 5.6, but the implementation did not mature until version 5.8 and later. If you plan to use Unicode you are I urged to use Perl 5.8.2 or later and to I read the Perl documentation on Unicode: perldoc perluniintro # in Perl 5.8 or later perldoc perlunicode And then read it again. Perl's internal Unicode format is UTF-8 which corresponds to the Oracle character set called AL32UTF8. =head2 Oracle and Unicode Oracle supports many characters sets, including several different forms of Unicode. These include: AL16UTF16 => valid for NCHAR columns (CSID=2000) UTF8 => valid for NCHAR columns (CSID=871), deprecated AL32UTF8 => valid for NCHAR and CHAR columns (CSID=873) When you create an Oracle database, you must specify the DATABASE character set (used for DDL, DML and CHAR datatypes) and the NATIONAL character set (used for NCHAR and NCLOB types). The character sets used in your database can be found using: $hash_ref = $dbh->ora_nls_parameters() $database_charset = $hash_ref->{NLS_CHARACTERSET}; $national_charset = $hash_ref->{NLS_NCHAR_CHARACTERSET}; The Oracle 9.2 and later default for the national character set is AL16UTF16. The default for the database character set is often US7ASCII. Although many experienced DBAs will consider an 8bit character set like WE8ISO8859P1 or WE8MSWIN1252. To use any character set with Oracle other than US7ASCII, requires that the NLS_LANG environment variable be set. See the L<"Oracle UTF8 is not UTF-8"> section below. You are strongly urged to read the Oracle Internationalization documentation specifically with respect the choices and trade offs for creating a databases for use with international character sets. Oracle uses the NLS_LANG environment variable to indicate what character set is being used on the client. When fetching data Oracle will convert from whatever the database character set is to the client character set specified by NLS_LANG. Similarly, when sending data to the database Oracle will convert from the character set specified by NLS_LANG to the database character set. The NLS_NCHAR environment variable can be used to define a different character set for 'national' (NCHAR) character types. Both UTF8 and AL32UTF8 can be used in NLS_LANG and NLS_NCHAR. For example: NLS_LANG=AMERICAN_AMERICA.UTF8 NLS_LANG=AMERICAN_AMERICA.AL32UTF8 NLS_NCHAR=UTF8 NLS_NCHAR=AL32UTF8 =head2 Oracle UTF8 is not UTF-8 AL32UTF8 should be used in preference to UTF8 if it works for you, which it should for Oracle 9.2 or later. If you're using an old version of Oracle that doesn't support AL32UTF8 then you should avoid using any Unicode characters that require surrogates, in other words characters beyond the Unicode BMP (Basic Multilingual Plane). That's because the character set that Oracle calls "UTF8" doesn't conform to the UTF-8 standard in its handling of surrogate characters. Technically the encoding that Oracle calls "UTF8" is known as "CESU-8". Here are a couple of extracts from L: CESU-8 is useful in 8-bit processing environments where binary collation with UTF-16 is required. It is designed and recommended for use only within products requiring this UTF-16 binary collation equivalence. It is not intended nor recommended for open interchange. As a very small percentage of characters in a typical data stream are expected to be supplementary characters, there is a strong possibility that CESU-8 data may be misinterpreted as UTF-8. Therefore, all use of CESU-8 outside closed implementations is strongly discouraged, such as the emittance of CESU-8 in output files, markup language or other open transmission forms. Oracle uses this internally because it collates (sorts) in the same order as UTF16, which is the basis of Oracle's internal collation definitions. Rather than change UTF8 for clients Oracle chose to define a new character set called "AL32UTF8" which does conform to the UTF-8 standard. (The AL32UTF8 character set can't be used on the server because it would break collation.) Because of that, for the rest of this document we'll use "AL32UTF8". If you're using an Oracle version below 9.2 you'll need to use "UTF8" until you upgrade. =head2 DBD::Oracle and Unicode DBD::Oracle Unicode support has been implemented for Oracle versions 9 or greater, and Perl version 5.6 or greater (though we I suggest that you use Perl 5.8.2 or later). You can check which Oracle version your DBD::Oracle was built with by importing the C constant from DBD::Oracle. B Any data returned from Oracle to DBD::Oracle in the AL32UTF8 character set will be marked as UTF-8 to ensure correct handling by Perl. For Oracle to return data in the AL32UTF8 character set the NLS_LANG or NLS_NCHAR environment variable I be set as described in the previous section. When fetching NCHAR, NVARCHAR, or NCLOB data from Oracle, DBD::Oracle will set the Perl UTF-8 flag on the returned data if either NLS_NCHAR is AL32UTF8, or NLS_NCHAR is not set and NLS_LANG is AL32UTF8. When fetching other character data from Oracle, DBD::Oracle will set the Perl UTF-8 flag on the returned data if NLS_LANG is AL32UTF8. B Data bound to a placeholder is assumed to be in the default client character set (specified by NLS_LANG) except for a few special cases. These are listed here with the highest precedence first: If the C attribute is given to bind_param() then that is passed to Oracle and takes precedence. If the value is a Perl Unicode string (UTF-8) then DBD::Oracle ensures that Oracle uses the Unicode character set, regardless of the NLS_LANG and NLS_NCHAR settings. If the placeholder is for inserting an NCLOB then the client NLS_NCHAR character set is used. (That's useful but inconsistent with the other behaviour so may change. Best to be explicit by using the C attribute.) If the C attribute is given to bind_param() then that determines if the value should be assumed to be in the default (NLS_LANG) or NCHAR (NLS_NCHAR) client character set. use DBD::Oracle qw( SQLCS_IMPLICIT SQLCS_NCHAR ); ... $sth->bind_param(1, $value, { ora_csform => SQLCS_NCHAR }); or $dbh->{ora_ph_csform} = SQLCS_NCHAR; # default for all future placeholders Binding with bind_param_array and execute_array is also UTF-8 compatible in the same way. If you attempt to insert UTF-8 data into a non UTF-8 Oracle instance or with an non UTF-8 NCHAR or NVARCHAR the insert will still happen but a error code of 0 will be returned with the following warning; DBD Oracle Warning: You have mixed utf8 and non-utf8 in an array bind in parameter#1. This may result in corrupt data. The Query charset id=1, name=US7ASCII The warning will report the parameter number and the NCHAR setting that the query is running. B Oracle assumes the SQL statement is in the default client character set (as specified by NLS_LANG). So Unicode strings containing non-ASCII characters should not be used unless the default client character set is AL32UTF8. =head2 DBD::Oracle and Other Character Sets and Encodings The only multi-byte Oracle character set supported by DBD::Oracle is "AL32UTF8" (and "UTF8"). Single-byte character sets should work well. =head1 OBJECT & COLLECTION DATA TYPES Oracle databases allow for the creation of object oriented like user-defined types. There are two types of objects, Embedded--an object stored in a column of a regular table and REF--an object that uses the REF retrieval mechanism. DBD::Oracle supports only the 'selection' of embedded objects of the following types OBJECT, VARRAY and TABLE in any combination. Support is seamless and recursive, meaning you need only supply a simple SQL statement to get all the values in an embedded object. You can either get the values as an array of scalars or they can be returned into a DBD::Oracle::Object. Array example, given this type and table; CREATE OR REPLACE TYPE "PHONE_NUMBERS" as varray(10) of varchar(30); CREATE TABLE "CONTACT" ( "COMPANYNAME" VARCHAR2(40), "ADDRESS" VARCHAR2(100), "PHONE_NUMBERS" "PHONE_NUMBERS" ) The code to access all the data in the table could be something like this; my $sth = $dbh->prepare('SELECT * FROM CONTACT'); $sth->execute; while ( my ($company, $address, $phone) = $sth->fetchrow()) { print "Company: ".$company."\n"; print "Address: ".$address."\n"; print "Phone #: "; foreach my $items (@$phone){ print $items.", "; } print "\n"; } Note that values in PHONE_NUMBERS are returned as an array reference '@$phone'. As stated before DBD::Oracle will automatically drill into the embedded object and extract all of the data as reference arrays of scalars. The example below has OBJECT type embedded in a TABLE type embedded in an SQL TABLE; CREATE OR REPLACE TYPE GRADELIST AS TABLE OF NUMBER; CREATE OR REPLACE TYPE STUDENT AS OBJECT( NAME VARCHAR2(60), SOME_GRADES GRADELIST); CREATE OR REPLACE TYPE STUDENTS_T AS TABLE OF STUDENT; CREATE TABLE GROUPS( GRP_ID NUMBER(4), GRP_NAME VARCHAR2(10), STUDENTS STUDENTS_T) NESTED TABLE STUDENTS STORE AS GROUP_STUDENTS_TAB (NESTED TABLE SOME_GRADES STORE AS GROUP_STUDENT_GRADES_TAB); The following code will access all of the embedded data; $SQL='select grp_id,grp_name,students as my_students_test from groups'; $sth=$dbh->prepare($SQL); $sth->execute(); while (my ($grp_id,$grp_name,$students)=$sth->fetchrow()){ print "Group ID#".$grp_id." Group Name =".$grp_name."\n"; foreach my $student (@$students){ print "Name:".$student->[0]."\n"; print "Marks:"; foreach my $grades (@$student->[1]){ foreach my $marks (@$grades){ print $marks.","; } } print "\n"; } print "\n"; } Object example, given this object and table; CREATE OR REPLACE TYPE Person AS OBJECT ( name VARCHAR2(20), age INTEGER) ) NOT FINAL; CREATE TYPE Employee UNDER Person ( salary NUMERIC(8,2) ); CREATE TABLE people (id INTEGER, obj Person); INSERT INTO people VALUES (1, Person('Black', 25)); INSERT INTO people VALUES (2, Employee('Smith', 44, 5000)); The following code will access the data; $dbh{'ora_objects'} =>1; $sth = $dbh->prepare("select * from people order by id"); $sth->execute(); # object are fetched as instance of DBD::Oracle::Object my ($id1, $obj1) = $sth->fetchrow(); my ($id2, $obj2) = $sth->fetchrow(); # get full type-name of object print $obj1->type_name."44\n"; # 'TEST.PERSON' is printed print $obj2->type_name."4\n"; # 'TEST.EMPLOYEE' is printed # get attribute NAME from object print $obj1->attr('NAME')."3\n"; # 'Black' is printed print $obj2->attr('NAME')."3\n"; # 'Smith' is printed # get all atributes as hash reference my $h1 = $obj1->attr; # returns {'NAME' => 'Black', 'AGE' => 25} my $h2 = $obj2->attr; # returns {'NAME' => 'Smith', 'AGE' => 44, # 'SALARY' => 5000 } # get all attributes (names and values) as array my @a1 = $obj1->attributes; # returns ('NAME', 'Black', 'AGE', 25) my @a2 = $obj2->attributes; # returns ('NAME', 'Smith', 'AGE', 44, # 'SALARY', 5000 ) So far DBD::Oracle has been tested on a table with 20 embedded Objects, Varrays and Tables nested to 10 levels. Any NULL values found in the embedded object will be returned as 'undef'. =head1 OTHER DATA TYPES DBD::Oracle does not I support most Oracle datatypes. It simply asks Oracle to return them as strings and Oracle does so. Mostly. Similarly when binding placeholder values DBD::Oracle binds them as strings and Oracle converts them to the appropriate type, such as DATE, when used. Some of these automatic conversions to and from strings use NLS settings to control the formatting for output and the parsing for input. The most common example is the DATE type. The default NLS format for DATE might be DD-MON-YYYY and so when a DATE type is fetched that's how Oracle will format the date. NLS settings also control the default parsing of strings into DATE values. An error will be generated if the contents of the string don't match the NLS format. If you're dealing in dates which don't match the default NLS format then you can either change the default NLS format or, more commonly, use TO_CHAR(field, "format") and TO_DATE(?, "format") to explicitly specify formats for converting to and from strings. A slightly more subtle problem can occur with NUMBER types. The default NLS settings might format numbers with a fullstop ("C<.>") to separate thousands and a comma ("C<,>") as the decimal point. Perl will generate warnings and use incorrect values when numbers, returned and formatted as strings in this way by Oracle, are used in a numeric context. You could explicitly convert each numeric value using the TO_CHAR(...) function but that gets tedious very quickly. The best fix is to change the NLS settings. That can be done for an individual connection by doing: $dbh->do("ALTER SESSION SET NLS_NUMERIC_CHARACTERS = '.,'"); There are some types, like BOOLEAN, that Oracle does not automatically convert to or from strings (pity). These need to be converted explicitly using SQL or PL/SQL functions. Examples: # DATE values my $sth0 = $dbh->prepare( <= TO_DATE( ?, ? ) SQL_END $sth0->execute( 'YYYY-MM-DD HH24:MI:SS', "2003", 'YYYY' ); # BOOLEAN values my $sth2 = $dbh->prepare( <bind_param( ":i0", $i0 ); $sth2->bind_param( ":i1", $i1 ); $sth2->bind_param_inout( ":o0", \$o0, 32 ); $sth2->bind_param_inout( ":o1", \$o1, 32 ); $sth2->execute(); foreach ( $i0, $b0, $o0, $i1, $b1, $o1 ) { $_ = "(undef)" if ! defined $_; } print "$i0 to $o0, $i1 to $o1\n"; # Result is : "'' to '(undef)', 'Something else' to '1'" =head2 Support for Insert of XMLType (ORA_XMLTYPE) Inserting large XML data sets into tables with XMLType fields is now supported by DBD::Oracle. The only special requirement is the use of bind_param() with an attribute hash parameter that specifies ora_type as ORA_XMLTYPE. For example with a table like this; create table books (book_id number, book_xml XMLType); one can insert data using this code $SQL='insert into books values (1,:p_xml)'; $xml= ' Programming the Perl DBI The Cheetah Book T. Bunce Alligator Descartes ... '; my $sth =$dbh-> prepare($SQL); $sth-> bind_param("p_xml", $xml, { ora_type => ORA_XMLTYPE }); $sth-> execute(); In the above case we will assume that $xml has 10000 Book nodes and is over 32k in size and is well formed XML. This will also work for XML that is smaller than 32k as well. Attempting to insert malformed XML will cause an error. =head2 Binding Cursors Cursors can be returned from PL/SQL blocks, either from stored functions (or procedures with OUT parameters) or from direct C statements, as shown below: use DBI; use DBD::Oracle qw(:ora_types); my $dbh = DBI->connect(...); my $sth1 = $dbh->prepare(q{ BEGIN OPEN :cursor FOR SELECT table_name, tablespace_name FROM user_tables WHERE tablespace_name = :space; END; }); $sth1->bind_param(":space", "USERS"); my $sth2; $sth1->bind_param_inout(":cursor", \$sth2, 0, { ora_type => ORA_RSET } ); $sth1->execute; # $sth2 is now a valid DBI statement handle for the cursor while ( my @row = $sth2->fetchrow_array ) { ... } The only special requirement is the use of C with an attribute hash parameter that specifies C as C. If you don't do that you'll get an error from the C like: "ORA-06550: line X, column Y: PLS-00306: wrong number or types of arguments in call to ...". Here's an alternative form using a function that returns a cursor. This example uses the pre-defined weak (or generic) REF CURSOR type SYS_REFCURSOR. This is an Oracle 9 feature. # Create the function that returns a cursor $dbh->do(q{ CREATE OR REPLACE FUNCTION sp_ListEmp RETURN SYS_REFCURSOR AS l_cursor SYS_REFCURSOR; BEGIN OPEN l_cursor FOR select ename, empno from emp ORDER BY ename; RETURN l_cursor; END; }); # Use the function that returns a cursor my $sth1 = $dbh->prepare(q{BEGIN :cursor := sp_ListEmp; END;}); my $sth2; $sth1->bind_param_inout(":cursor", \$sth2, 0, { ora_type => ORA_RSET } ); $sth1->execute; # $sth2 is now a valid DBI statement handle for the cursor while ( my @row = $sth2->fetchrow_array ) { ... } A cursor obtained from PL/SQL as above may be passed back to PL/SQL by binding for input, as shown in this example, which explicitly closes a cursor: my $sth3 = $dbh->prepare("BEGIN CLOSE :cursor; END;"); $sth3->bind_param(":cursor", $sth2, { ora_type => ORA_RSET } ); $sth3->execute; It is not normally necessary to close a cursor explicitly in this way. Oracle will close the cursor automatically at the first client-server interaction after the cursor statement handle is destroyed. An explicit close may be desirable if the reference to the cursor handle from the PL/SQL statement handle delays the destruction of the cursor handle for too long. This reference remains until the PL/SQL handle is re-bound, re-executed or destroyed. NOTE: From DBD::Oracle 1.57 functions or procedures returning SYS_REFCURSORs which have not been opened (are still in the initialised state) will return undef for the cursor statement handle e.g., in the example above if the sp_ListEmp function simply returned l_cursor instead of opening it. This means you can have a function/procedure which can elect to open the cursor or not, Before this change if you called a function/procedure which returned a SYS_REFCURSOR which was not opened DBD::Oracle would error in the execute for a OCIAttrGet on the uninitialised cursor. See the C script in the Oracle.ex directory in the DBD::Oracle source distribution for a complete working example. =head2 Fetching Nested Cursors Oracle supports the use of select list expressions of type REF CURSOR. These may be explicit cursor expressions - C, or calls to PL/SQL functions which return REF CURSOR values. The values of these expressions are known as nested cursors. The value returned to a Perl program when a nested cursor is fetched is a statement handle. This statement handle is ready to be fetched from. It should not (indeed, must not) be executed. Oracle imposes a restriction on the order of fetching when nested cursors are used. Suppose C<$sth1> is a handle for a select statement involving nested cursors, and C<$sth2> is a nested cursor handle fetched from C<$sth1>. C<$sth2> can only be fetched from while C<$sth1> is still active, and the row containing C<$sth2> is still current in C<$sth1>. Any attempt to fetch another row from C<$sth1> renders all nested cursor handles previously fetched from C<$sth1> defunct. Fetching from such a defunct handle results in an error with the message C. This means that the C or C methods are not useful for queries returning nested cursors. By the time such a method returns, all the nested cursor handles it has fetched will be defunct. It is necessary to use an explicit fetch loop, and to do all the fetching of nested cursors within the loop, as the following example shows: use DBI; my $dbh = DBI->connect(...); my $sth = $dbh->prepare(q{ SELECT dname, CURSOR( SELECT ename FROM emp WHERE emp.deptno = dept.deptno ORDER BY ename ) FROM dept ORDER BY dname }); $sth->execute; while ( my ($dname, $nested) = $sth->fetchrow_array ) { print "$dname\n"; while ( my ($ename) = $nested->fetchrow_array ) { print " $ename\n"; } } The cursor returned by the function C defined in the previous section can be fetched as a nested cursor as follows: my $sth = $dbh->prepare(q{SELECT sp_ListEmp FROM dual}); $sth->execute; my ($nested) = $sth->fetchrow_array; while ( my @row = $nested->fetchrow_array ) { ... } =head2 Pre-fetching Nested Cursors By default, DBD::Oracle pre-fetches rows in order to reduce the number of round trips to the server. For queries which do not involve nested cursors, the number of pre-fetched rows is controlled by the DBI database handle attribute C (q.v.). In Oracle, server side open cursors are a controlled resource, limited in number, on a per session basis, to the value of the initialization parameter C. Nested cursors count towards this limit. Each nested cursor in the current row counts 1, as does each nested cursor in a pre-fetched row. Defunct nested cursors do not count. An Oracle specific database handle attribute, C, further controls pre-fetching for queries involving nested cursors. For each statement handle, the total number of nested cursors in pre-fetched rows is limited to the value of this parameter. The default value is 0, which disables pre-fetching for queries involving nested cursors. =head1 PL/SQL Examples Most of these PL/SQL examples come from: Eric Bartley . /* * PL/SQL to create package with stored procedures invoked by * Perl examples. Execute using sqlplus. * * Use of "... OR REPLACE" prevents failure in the event that the * package already exists. */ CREATE OR REPLACE PACKAGE plsql_example IS PROCEDURE proc_np; PROCEDURE proc_in ( err_code IN NUMBER ); PROCEDURE proc_in_inout ( test_num IN NUMBER, is_odd IN OUT NUMBER ); FUNCTION func_np RETURN VARCHAR2; END plsql_example; / CREATE OR REPLACE PACKAGE BODY plsql_example IS PROCEDURE proc_np IS whoami VARCHAR2(20) := NULL; BEGIN SELECT USER INTO whoami FROM DUAL; END; PROCEDURE proc_in ( err_code IN NUMBER ) IS BEGIN RAISE_APPLICATION_ERROR(err_code, 'This is a test.'); END; PROCEDURE proc_in_inout ( test_num IN NUMBER, is_odd IN OUT NUMBER ) IS BEGIN is_odd := MOD(test_num, 2); END; FUNCTION func_np RETURN VARCHAR2 IS ret_val VARCHAR2(20); BEGIN SELECT USER INTO ret_val FROM DUAL; RETURN ret_val; END; END plsql_example; / /* End PL/SQL for example package creation. */ use DBI; my($db, $csr, $ret_val); $db = DBI->connect('dbi:Oracle:database','user','password') or die "Unable to connect: $DBI::errstr"; # So we don't have to check every DBI call we set RaiseError. # See the DBI docs now if you're not familiar with RaiseError. $db->{RaiseError} = 1; # Example 1 Eric Bartley # # Calling a PLSQL procedure that takes no parameters. This shows you the # basic's of what you need to execute a PLSQL procedure. Just wrap your # procedure call in a BEGIN END; block just like you'd do in SQL*Plus. # # p.s. If you've used SQL*Plus's exec command all it does is wrap the # command in a BEGIN END; block for you. $csr = $db->prepare(q{ BEGIN PLSQL_EXAMPLE.PROC_NP; END; }); $csr->execute; # Example 2 Eric Bartley # # Now we call a procedure that has 1 IN parameter. Here we use bind_param # to bind out parameter to the prepared statement just like you might # do for an INSERT, UPDATE, DELETE, or SELECT statement. # # I could have used positional placeholders (e.g. :1, :2, etc.) or # ODBC style placeholders (e.g. ?), but I prefer Oracle's named # placeholders (but few DBI drivers support them so they're not portable). my $err_code = -20001; $csr = $db->prepare(q{ BEGIN PLSQL_EXAMPLE.PROC_IN(:err_code); END; }); $csr->bind_param(":err_code", $err_code); # PROC_IN will RAISE_APPLICATION_ERROR which will cause the execute to 'fail'. # Because we set RaiseError, the DBI will croak (die) so we catch that with eval. eval { $csr->execute; }; print 'After proc_in: $@=',"'$@', errstr=$DBI::errstr, ret_val=$ret_val\n"; # Example 3 Eric Bartley # # Building on the last example, I've added 1 IN OUT parameter. We still # use a placeholders in the call to prepare, the difference is that # we now call bind_param_inout to bind the value to the place holder. # # Note that the third parameter to bind_param_inout is the maximum size # of the variable. You normally make this slightly larger than necessary. # But note that the Perl variable will have that much memory assigned to # it even if the actual value returned is shorter. my $test_num = 5; my $is_odd; $csr = $db->prepare(q{ BEGIN PLSQL_EXAMPLE.PROC_IN_INOUT(:test_num, :is_odd); END; }); # The value of $test_num is _copied_ here $csr->bind_param(":test_num", $test_num); $csr->bind_param_inout(":is_odd", \$is_odd, 1); # The execute will automagically update the value of $is_odd $csr->execute; print "$test_num is ", ($is_odd) ? "odd - ok" : "even - error!", "\n"; # Example 4 Eric Bartley # # What about the return value of a PLSQL function? Well treat it the same # as you would a call to a function from SQL*Plus. We add a placeholder # for the return value and bind it with a call to bind_param_inout so # we can access it's value after execute. my $whoami = ""; $csr = $db->prepare(q{ BEGIN :whoami := PLSQL_EXAMPLE.FUNC_NP; END; }); $csr->bind_param_inout(":whoami", \$whoami, 20); $csr->execute; print "Your database user name is $whoami\n"; $db->disconnect; You can find more examples in the t/plsql.t file in the DBD::Oracle source directory. Oracle 9.2 appears to have a bug where a variable bound with bind_param_inout() that isn't assigned to by the executed PL/SQL block may contain garbage. See L =head2 Avoid Using "SQL Call" Avoid using the "SQL Call" statement with DBD:Oracle as you might find that DBD::Oracle will not raise an exception in some case. Specifically if you use "SQL Call" to run a procedure all "No data found" exceptions will be quietly ignored and returned as null. According to Oracle support this is part of the same mechanism where; select (select * from dual where 0=1) from dual returns a null value rather than an exception. =head1 CONTRIBUTING If you'd like DBD::Oracle to do something new or different the best way to make that happen is to do it yourself and email to dbi-dev@perl.org a patch of the source code (using 'diff' - see below) that shows the changes. =head2 How to create a patch using Subversion The DBD::Oracle source code is maintained using Subversion (a replacement for CVS, see L). To access the source you'll need to install a Subversion client. Then, to get the source code, do: svn checkout http://svn.perl.org/modules/dbd-oracle/trunk If it prompts for a username and password use your perl.org account if you have one, else just 'guest' and 'guest'. The source code will be in a new subdirectory called C. To keep informed about changes to the source you can send an empty email to dbd-oracle-changes-subscribe@perl.org after which you'll get an email with the change log message and diff of each change checked-in to the source. After making your changes you can generate a patch file, but before you do, make sure your source is still upto date using: svn update If you get any conflicts reported you'll need to fix them first. Then generate the patch file from within the C directory using: svn diff > foo.patch Read the patch file, as a sanity check, and then email it to dbi-dev@perl.org. =head2 How to create a patch without Subversion Unpack a fresh copy of the distribution: tar xfz DBD-Oracle-1.40.tar.gz Rename the newly created top level directory: mv DBD-Oracle-1.40 DBD-Oracle-1.40.your_foo Edit the contents of DBD-Oracle-1.40.your_foo/* till it does what you want. Test your changes and then remove all temporary files: make test && make distclean Go back to the directory you originally unpacked the distribution: cd .. Unpack I copy of the original distribution you started with: tar xfz DBD-Oracle-1.40.tar.gz Then create a patch file by performing a recursive C on the two top level directories: diff -r -u DBD-Oracle-1.40 DBD-Oracle-1.40.your_foo > DBD-Oracle-1.40.your_foo.patch =head2 Speak before you patch For anything non-trivial or possibly controversial it's a good idea to discuss (on dbi-dev@perl.org) the changes you propose before actually spending time working on them. Otherwise you run the risk of them being rejected because they don't fit into some larger plans you may not be aware of. =head2 GitHub repository A git mirror of the subversion is also available at `https://github.com/yanick/DBD-Oracle`. =head1 WHICH VERSION OF DBD::ORACLE IS FOR ME? From version 1.25 onwards DBD::Oracle only support Oracle clients 9.2 or greater. Support for ProC connections was dropped in 1.29. If you are still stuck with an older version of Oracle or its client you might want to look at the table below. +---------------------+-----------------------------------------------------+ | | Oracle Version | +---------------------+----+-------------+---------+------+--------+--------+ | DBD::Oracle Version | <8 | 8.0.3~8.0.6 | 8iR1~R2 | 8iR3 | 9i | 9.2~11 | +---------------------+----+-------------+---------+------+--------+--------+ | 0.1~16 | Y | Y | Y | Y | Y | Y | +---------------------+----+-------------+---------+------+--------+--------+ | 1.17 | Y | Y | Y | Y | Y | Y | +---------------------+----+-------------+---------+------+--------+--------+ | 1.18 | N | N | N | Y | Y | Y | +---------------------+----+-------------+---------+------+--------+--------+ | 1.19 | N | N | N | Y | Y | Y | +---------------------+----+-------------+---------+------+--------+--------+ | 1.20 | N | N | N | Y | Y | Y | +---------------------+----+-------------+---------+------+--------+--------+ | 1.21~1.24 | N | N | N | N | Y | Y | +---------------------+----+-------------+---------+------+--------+--------+ | 1.25+ | N | N | N | N | N | Y | +---------------------+----+-------------+---------+------+--------+--------+ As there are dozens of different versions of Oracle's clients this list does not include all of them, just the major released versions of Oracle. Note that one can still connect to any Oracle version with the older DBD::Oracle versions the only problem you will have is that some of the newer OCI and Oracle features available in later DBD::Oracle releases will not be available to you. So to make a short story a little longer: =over =item 1 If you are using Oracle 7 or early 8 DB and you can manage to get a 9 client and you can use any DBD::Oracle version. =item 2 If you have to use an Oracle 7 client then DBD::Oracle 1.17 should work =item 3 Same thing for 8 up to R2, use 1.17, if you are lucky and have the right patch-set you might go with 1.18. =item 4 For 8iR3 you can use any of the DBD::Oracle versions up to 1.21. Again this depends on your patch-set, If you run into trouble go with 1.19 =item 5 After 9.2 you can use any version you want. =item 6 It seems that the 10g client can only connect to 9 and 11 DBs while the 9 can go back to 7 and even get to 10. I am not sure what the 11g client can connect to. =back =head1 BUGS AND LIMITATIONS There is a known problem with the 11.2g Oracle client and the C PL/SQL function. See L for the details. =head1 SEE ALSO =over =item L http://search.cpan.org/~timb/DBD-Oracle/MANIFEST for all files in the DBD::Oracle source distribution including the examples in the Oracle.ex directory =item DBD::Oracle Tutorial http://www.pythian.com/blogs/wp-content/uploads/introduction-dbd-oracle.html =item Oracle Instant Client http://www.oracle.com/technology/tech/oci/instantclient/index.html =item Oracle on Linux http://www.ixora.com.au/ =item Free Oracle Tools and Links ora_explain supplied and installed with DBD::Oracle. http://www.orafaq.com/ http://vonnieda.org/oracletool/ =item Commercial Oracle Tools and Links Assorted tools and references for general information. No recommendation implied. http://www.platinum.com http://www.SoftTreeTech.com Also PL/Vision from RevealNet and Steven Feuerstein, and "Q" from Savant Corporation. =back =head1 AUTHORS DBI by Tim Bunce L. The original C was by Tim Bunce. Maintained as of release 1.17 (February 2006) by John Scoles, then Yanick Champoux, under the auspice of the Pythian Group (L). =head1 ACKNOWLEDGEMENTS A great many people have helped with DBD::Oracle over the 17 years between 1994 and 2011. Far too many to name, but we thank them all. Many are named in the Changes file. =head1 COPYRIGHT The DBD::Oracle module is Copyright (c) 1994-2006 Tim Bunce. Ireland. The DBD::Oracle module is Copyright (c) 2006-2011 John Scoles (The Pythian Group). Canada. The DBD::Oracle module is Copyright (c) 2011 John Scoles. Canada. The DBD::Oracle module is free open source software; you can redistribute it and/or modify it under the same terms as Perl 5. =head1 AUTHORS =over 4 =item * Tim Bunce =item * John Scoles =item * Yanick Champoux =item * Martin J. Evans =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 1994 by Tim Bunce. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBD-Oracle-1.74/lib/DBD/Oracle/0000775000175000017500000000000012326332111015117 5ustar yanickyanickDBD-Oracle-1.74/lib/DBD/Oracle/GetInfo.pm0000644000175000017500000003401212326332111017006 0ustar yanickyanickpackage DBD::Oracle::GetInfo; $DBD::Oracle::GetInfo::VERSION = '1.74'; BEGIN { $DBD::Oracle::GetInfo::AUTHORITY = 'cpan:PYTHIAN'; } # ABSTRACT: Wrapper to get Oracle information use strict; use DBD::Oracle(); my $sql_driver = 'Oracle'; my $sql_ver_fmt = '%02d.%02d.%04d'; # ODBC version string: ##.##.##### my ($a,$b,$c) = (0,0,0); my $ver = $DBD::Oracle::VERSION; my @parts = split /\./, $ver; $a = $parts[0]; ($b,$c) = split /_/, $parts[1]; $c = 0 if !$c; my $sql_driver_ver = sprintf $sql_ver_fmt, $a, $b, $c; sub sql_dbms_version { my $dbh = shift; local $^W; # for ora_server_version having too few parts return sprintf $sql_ver_fmt, @{DBD::Oracle::db::ora_server_version($dbh)}; } my @Keywords = qw( ACCESS AUDIT BFILE BLOB CLOB CLUSTER COMMENT COMPRESS EXCLUSIVE FILE IDENTIFIED INCREMENT INITIAL LOCK LONG MAXEXTENTS MINUS MODE MODIFY NCLOB NOAUDIT NOCOMPRESS NOWAIT NUMBER OFFLINE ONLINE PCTFREE RAW RENAME RESOURCE ROW ROWID ROWLABEL ROWNUM SHARE START SUCCESSFUL SYNONYM SYSDATE TRIGGER UID VALIDATE VARCHAR ); sub sql_keywords { return join ',', @Keywords; } sub sql_data_source_name { my $dbh = shift; return "dbi:$sql_driver:" . $dbh->{Name}; } sub sql_user_name { my $dbh = shift; # CURRENT_USER is a non-standard attribute, probably undef # Username is a standard DBI attribute return $dbh->{CURRENT_USER} || $dbh->{Username}; } our %info = ( 0 => 0, # SQL_MAX_DRIVER_CONNECTIONS 1 => 0, # SQL_MAX_CONCURRENT_ACTIVITIES 2 => \&sql_data_source_name, # SQL_DATA_SOURCE_NAME 3 => 147209344, # SQL_DRIVER_HDBC 4 => 147212776, # SQL_DRIVER_HENV # 5 => undef, # SQL_DRIVER_HSTMT 6 => $INC{'DBD/Oracle.pm'}, # SQL_DRIVER_NAME 7 => $sql_driver_ver, # SQL_DRIVER_VER 8 => 191, # SQL_FETCH_DIRECTION 9 => 1, # SQL_ODBC_API_CONFORMANCE 10 => '03.52', # SQL_ODBC_VER 11 => 'Y', # SQL_ROW_UPDATES 12 => 0, # SQL_ODBC_SAG_CLI_CONFORMANCE 13 => sub {"$_[0]->{Name}"}, # SQL_SERVER_NAME 14 => '\\', # SQL_SEARCH_PATTERN_ESCAPE 15 => 1, # SQL_ODBC_SQL_CONFORMANCE 16 => 'DEVEL', # SQL_DATABASE_NAME 17 => 'Oracle', # SQL_DBMS_NAME 18 => \&sql_dbms_version, # SQL_DBMS_VERSION 19 => 'Y', # SQL_ACCESSIBLE_TABLES 20 => 'Y', # SQL_ACCESSIBLE_PROCEDURES 21 => 'Y', # SQL_PROCEDURES 22 => 1, # SQL_CONCAT_NULL_BEHAVIOR 23 => 2, # SQL_CURSOR_COMMIT_BEHAVIOR 24 => 2, # SQL_CURSOR_ROLLBACK_BEHAVIOR 25 => 'N', # SQL_DATA_SOURCE_READ_ONLY 26 => 8, # SQL_DEFAULT_TRANSACTION_ISOLATION 27 => 'Y', # SQL_EXPRESSIONS_IN_ORDERBY 28 => 1, # SQL_IDENTIFIER_CASE 29 => '"', # SQL_IDENTIFIER_QUOTE_CHAR 30 => 30, # SQL_MAXIMUM_COLUMN_NAME_LENGTH 31 => 30, # SQL_MAXIMUM_CURSOR_NAME_LENGTH 32 => 30, # SQL_MAXIMUM_SCHEMA_NAME_LENGTH 33 => 92, # SQL_MAX_PROCEDURE_NAME_LEN 34 => 0, # SQL_MAXIMUM_CATALOG_NAME_LENGTH 35 => 30, # SQL_MAXIMUM_TABLE_NAME_LENGTH 36 => 'Y', # SQL_MULT_RESULT_SETS 37 => 'Y', # SQL_MULTIPLE_ACTIVE_TXN 38 => 'Y', # SQL_OUTER_JOINS 39 => 'Owner', # SQL_SCHEMA_TERM 40 => 'Procedure', # SQL_PROCEDURE_TERM 41 => '@', # SQL_QUALIFIER_NAME_SEPARATOR 42 => 'Database Link', # SQL_QUALIFIER_TERM 43 => 7, # SQL_SCROLL_CONCURRENCY 44 => 19, # SQL_SCROLL_OPTIONS 45 => 'Table', # SQL_TABLE_TERM 46 => 3, # SQL_TRANSACTION_CAPABLE 47 => \&sql_user_name, # SQL_USER_NAME 48 => 1, # SQL_CONVERT_FUNCTIONS 49 => 16646015, # SQL_NUMERIC_FUNCTIONS 50 => 8355839, # SQL_STRING_FUNCTIONS 51 => 7, # SQL_SYSTEM_FUNCTIONS 52 => 1023999, # SQL_TIMEDATE_FUNCTIONS 53 => 10518015, # SQL_CONVERT_BIGINT 54 => 10775839, # SQL_CONVERT_BINARY 55 => 10518015, # SQL_CONVERT_BIT 56 => 15106047, # SQL_CONVERT_CHAR 57 => 164097, # SQL_CONVERT_DATE 58 => 10518015, # SQL_CONVERT_DECIMAL 59 => 10514943, # SQL_CONVERT_DOUBLE 60 => 10514943, # SQL_CONVERT_FLOAT 61 => 10518015, # SQL_CONVERT_INTEGER 62 => 14680833, # SQL_CONVERT_LONGVARCHAR 63 => 10518015, # SQL_CONVERT_NUMERIC 64 => 10514943, # SQL_CONVERT_REAL 65 => 10518015, # SQL_CONVERT_SMALLINT 66 => 0, # SQL_CONVERT_TIME 67 => 10718465, # SQL_CONVERT_TIMESTAMP 68 => 10518015, # SQL_CONVERT_TINYINT 69 => 10775839, # SQL_CONVERT_VARBINARY 70 => 15204351, # SQL_CONVERT_VARCHAR 71 => 265216, # SQL_CONVERT_LONGVARBINARY 72 => 10, # SQL_TRANSACTION_ISOLATION_OPTION 73 => 'N', # SQL_ODBC_SQL_OPT_IEF 74 => 2, # SQL_CORRELATION_NAME 75 => 1, # SQL_NON_NULLABLE_COLUMNS # 76 => undef, # SQL_DRIVER_HLIB 77 => '03.52', # SQL_DRIVER_ODBC_VER 78 => 1, # SQL_LOCK_TYPES 79 => 1, # SQL_POS_OPERATIONS 80 => 7, # SQL_POSITIONED_STATEMENTS 81 => 15, # SQL_GETDATA_EXTENSIONS 82 => 88, # SQL_BOOKMARK_PERSISTENCE 83 => 0, # SQL_STATIC_SENSITIVITY 84 => 0, # SQL_FILE_USAGE 85 => 1, # SQL_NULL_COLLATION 86 => 1029739, # SQL_ALTER_TABLE 87 => 'Y', # SQL_COLUMN_ALIAS 88 => 2, # SQL_GROUP_BY 89 => \&sql_keywords, # SQL_KEYWORDS 90 => 'N', # SQL_ORDER_BY_COLUMNS_IN_SELECT 91 => 31, # SQL_SCHEMA_USAGE 92 => 3, # SQL_QUALIFIER_USAGE 93 => 3, # SQL_QUOTED_IDENTIFIER_CASE 94 => '$#', # SQL_SPECIAL_CHARACTERS 95 => 31, # SQL_SUBQUERIES 96 => 3, # SQL_UNION_STATEMENT 97 => 0, # SQL_MAXIMUM_COLUMNS_IN_GROUP_BY 98 => 0, # SQL_MAXIMUM_COLUMNS_IN_INDEX 99 => 0, # SQL_MAXIMUM_COLUMNS_IN_ORDER_BY 100 => 1000, # SQL_MAXIMUM_COLUMNS_IN_SELECT 101 => 1000, # SQL_MAXIMUM_COLUMNS_IN_TABLE 102 => 0, # SQL_MAXIMUM_INDEX_SIZE 103 => 'N', # SQL_MAX_ROW_SIZE_INCLUDES_LONG 104 => 0, # SQL_MAXIMUM_ROW_SIZE 105 => 0, # SQL_MAXIMUM_STATEMENT_LENGTH 106 => 0, # SQL_MAXIMUM_TABLES_IN_SELECT 107 => 30, # SQL_MAXIMUM_USER_NAME_LENGTH 108 => 0, # SQL_MAX_CHAR_LITERAL_LEN 109 => 0, # SQL_TIMEDATE_ADD_INTERVALS 110 => 0, # SQL_TIMEDATE_DIFF_INTERVALS 111 => 'N', # SQL_NEED_LONG_DATA_LEN 112 => 0, # SQL_MAX_BINARY_LITERAL_LEN 113 => 'Y', # SQL_LIKE_ESCAPE_CLAUSE 114 => 2, # SQL_QUALIFIER_LOCATION 115 => 127, # SQL_OUTER_JOIN_CAPABILITIES 116 => 0, # SQL_ACTIVE_ENVIRONMENTS 117 => 0, # SQL_ALTER_DOMAIN 118 => 1, # SQL_SQL_CONFORMANCE 119 => 0, # SQL_DATETIME_LITERALS 120 => 0, # SQL_BATCH_ROW_COUNT 121 => 0, # SQL_BATCH_SUPPORT 122 => 15106047, # SQL_CONVERT_WCHAR 123 => 0, # SQL_CONVERT_INTERVAL_DAY_TIME 124 => 0, # SQL_CONVERT_INTERVAL_YEAR_MONTH 125 => 14680833, # SQL_CONVERT_WLONGVARCHAR 126 => 15106047, # SQL_CONVERT_WVARCHAR 127 => 0, # SQL_CREATE_ASSERTION 128 => 0, # SQL_CREATE_CHARACTER_SET 129 => 0, # SQL_CREATE_COLLATION 130 => 0, # SQL_CREATE_DOMAIN 131 => 3, # SQL_CREATE_SCHEMA 132 => 14305, # SQL_CREATE_TABLE 133 => 0, # SQL_CREATE_TRANSLATION 134 => 3, # SQL_CREATE_VIEW # 135 => undef, # SQL_DRIVER_HDESC 136 => 0, # SQL_DROP_ASSERTION 137 => 0, # SQL_DROP_CHARACTER_SET 138 => 0, # SQL_DROP_COLLATION 139 => 0, # SQL_DROP_DOMAIN 140 => 0, # SQL_DROP_SCHEMA 141 => 1, # SQL_DROP_TABLE 142 => 0, # SQL_DROP_TRANSLATION 143 => 1, # SQL_DROP_VIEW 144 => 0, # SQL_DYNAMIC_CURSOR_ATTRIBUTES1 145 => 0, # SQL_DYNAMIC_CURSOR_ATTRIBUTES2 146 => 57345, # SQL_FORWARD_ONLY_CURSOR_ATTRIBUTES1 147 => 2183, # SQL_FORWARD_ONLY_CURSOR_ATTRIBUTES2 148 => 3, # SQL_INDEX_KEYWORDS 149 => 65568, # SQL_INFO_SCHEMA_VIEWS 150 => 0, # SQL_KEYSET_CURSOR_ATTRIBUTES1 151 => 0, # SQL_KEYSET_CURSOR_ATTRIBUTES2 152 => 3, # SQL_ODBC_INTERFACE_CONFORMANCE 153 => 2, # SQL_PARAM_ARRAY_ROW_COUNTS 154 => 3, # SQL_PARAM_ARRAY_SELECTS 155 => 0, # SQL_SQL92_DATETIME_FUNCTIONS 156 => 0, # SQL_SQL92_FOREIGN_KEY_DELETE_RULE 157 => 0, # SQL_SQL92_FOREIGN_KEY_UPDATE_RULE 158 => 16, # SQL_SQL92_GRANT 159 => 0, # SQL_SQL92_NUMERIC_VALUE_FUNCTIONS 160 => 7687, # SQL_SQL92_PREDICATES 161 => 0, # SQL_SQL92_RELATIONAL_JOIN_OPERATORS 162 => 0, # SQL_SQL92_REVOKE 163 => 0, # SQL_SQL92_ROW_VALUE_CONSTRUCTOR 164 => 0, # SQL_SQL92_STRING_FUNCTIONS 165 => 1, # SQL_SQL92_VALUE_EXPRESSIONS 166 => 3, # SQL_STANDARD_CLI_CONFORMANCE 167 => 57935, # SQL_STATIC_CURSOR_ATTRIBUTES1 168 => 4231, # SQL_STATIC_CURSOR_ATTRIBUTES2 169 => 64, # SQL_AGGREGATE_FUNCTIONS 170 => 3, # SQL_DDL_INDEX 171 => '03.52.0002.0002', # SQL_DM_VER 172 => 7, # SQL_INSERT_STATEMENT 173 => 0, # SQL_CONVERT_GUID 10000 => 1995, # SQL_XOPEN_CLI_YEAR 10001 => 1, # SQL_CURSOR_SENSITIVITY 10002 => 'Y', # SQL_DESCRIBE_PARAMETER 10003 => 'N', # SQL_CATALOG_NAME 10004 => '', # SQL_COLLATING_SEQUENCE 10005 => 30, # SQL_MAXIMUM_IDENTIFIER_LENGTH 10021 => 2, # SQL_ASYNC_MODE 10022 => 0, # SQL_MAX_ASYNC_CONCURRENT_STATEMENTS # 20000 => undef, # SQL_MAXIMUM_STMT_OCTETS # 20001 => undef, # SQL_MAXIMUM_STMT_OCTETS_DATA # 20002 => undef, # SQL_MAXIMUM_STMT_OCTETS_SCHEMA ); 1; __END__ =pod =encoding UTF-8 =head1 NAME DBD::Oracle::GetInfo - Wrapper to get Oracle information =head1 VERSION version 1.74 =head1 AUTHORS =over 4 =item * Tim Bunce =item * John Scoles =item * Yanick Champoux =item * Martin J. Evans =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 1994 by Tim Bunce. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBD-Oracle-1.74/lib/DBD/Oracle/Troubleshooting/0000775000175000017500000000000012326332111020306 5ustar yanickyanickDBD-Oracle-1.74/lib/DBD/Oracle/Troubleshooting/Win32.pod0000644000175000017500000003001012326332111021704 0ustar yanickyanick#PODNAME: DBD::Oracle::Troubleshooting::Win32 #ABSTRACT: Tips and Hints to Troubleshoot DBD::Oracle on Win32 __END__ =pod =encoding UTF-8 =head1 NAME DBD::Oracle::Troubleshooting::Win32 - Tips and Hints to Troubleshoot DBD::Oracle on Win32 =head1 VERSION version 1.74 =head1 GENERAL INFO In general, on Windows, it's best to just use ActiveState Perl and the PPM package manager to install a pre-built version of DBD::Oracle however only version 1.17 is available there. =head1 Oracle Instant Client 11.1.0.6.0 Notes So far I have managed to get it to Makefile and compile test and install and work. However it seems one needs to set "NLS_LANG" to a valid value in the environment variables. As well IC 11 seems to have trouble finding the .ORA files. A quick fix for this is to add "TNS_ADMIN" to the environment variables and point it to where your .ORA files are. =head1 Other information, some of which is out of date --- DBD-Oracle for Windows and Oracle Instantclient and 10XE (Express Edition) By: John Scoles The Pythian Group The preferred method of getting DBD::Oracle is to use a pre-built version from the ActiveState repository, which can be installed with PPM. Compiling and installing DBD::Oracle 1.18 or later on a windows 2000 professional or XP OS for use with Oracle instantClient ver 10.2.0.1 & 10.1.0.5 or Oracle XE requires only a few downloads and a minimal number of environment setting. The procedures below were tested on a clean Windows platform having no Oracle or other development environment installed. 1) The first part of the process is to download and install the latest version of Active Perl from http://www.activeperl.com/. 2) Use the PPM application to get the latest version of DBI 3) Download the latest DBD::Oracle from http://svn.perl.org/modules/dbd-oracle/trunk/ 4) Download and unzip the Oracle Instant Client (10.2.0.1 or 10.1.0.5) 32 bit from http://www.oracle.com/technology/tech/oci/instantclient/instantclient.html You will need all three of these products i. Instant Client Package - Basic ii. Instant Client Package - SQL*Plus: iii. Instant Client Package - SDK: or install oracle 10XE http://www.oracle.com/technology/products/database/xe/index.html 5) You will now need the Microsoft Visual C++ toolkit 2003. Unfortunately this product is no longer available from Microsoft. The file name was VCToolkitSetup.exe and is available at this mirror site http://www.filewatcher.com/m/VCToolkitSetup.exe.32952488.0.0.html at the time of writing. Microsoft's replacement for this tool kit is Visual C++ 2005 Express Edition and all attempts to compile DBD::Oracle with this product fail. It has been successfully compiled using a complete edition of Microsoft Visual Studio 2005. Download and then install this product. 6) You will also need the Windows SDK. Which can be found at http://www.microsoft.com/downloads/details.aspx?FamilyId=A55B6B43-E24F-4EA3-A93E-40C0EC4F68E5&displaylang=en You have the choice to of either to download the entire SDK and install or run an online install from the page. Both have been tested and proven to work. 7) Next download and install the Microsoft .net framework 1.1 skd from http://www.microsoft.com/downloads/details.aspx?FamilyID=9b3a2ca6-3647-4070-9f41-a333c6b9181d&displaylang=en 8) You will also need a copy of nmake.exe which you can download here http://download.microsoft.com/download/vc15/patch/1.52/w95/en-us/nmake15.exe 9) Enough Downloading and installing go have a coffee. 10) You should at this time attempt to connect to an Oracle database with the version SQL*Plus that you installed in step 4. If you are unable to connect at this stage then any problems you encounter later may have nothing to do with DBD::Oracle 11) On the path where you installed Visual C++ find and edit the vcvars32.bat file as follows. You may have to modify these path values depending where you installed the products on you computer, i. Add the local path to the windows platform SDK include directory to the Set INCLUDE Command Line to include the needed files from the Windows SDK. e.g. "C:\Program Files\Microsoft Platform SDK\Include;" ii. Add the local path to the .net Vc7 lib directory to the Set LIB command to include the needed library file from the .Net SKD e.g. C:\Program Files\Microsoft Visual Studio .NET 2003\Vc7\lib; iii. Add the local path to the windows platform SDK Lib directory to the Set Lib command to include the needed library files from the Windows SDK e.g. C:\Program Files\Microsoft Platform SDK\Lib; 12) Open a Windows Visual C++ command window from the start menu. 13) Add the path to the instant client to the Path command. If you are compiling aginst a 10XE db/client then you can skip steps 12 to 14. e.g. PATH = C:/Oracle/instantclient;%PATH% 14) Using the "Set" command add "ORACLE_HOME=path to Instant client" to the environment variables. e.g. Set ORACLE_HOME=C:\Oracle\instantclient 15) Using the "Set" command add "NLS_LANG=.WE8ISO8859P15" to the environment variables. The globalization variable is required, with this or another compatible value, by Oracle instantclient in order for it to compile correctly. e.g. Set NLS_LANG=.WE8ISO8859P15 16) Using the "Set" command add "ORACLE_USERID=test/test@test" substituting test with the username/password@database you wish to run the make test files against. Note: it is not necessary to do this step for the compile and install to work. However: The self-test programs included with Oracle-DBD will mostly fail. 17) Move to the DBD-Oracle directory in the Visual C++ window DOS prompt and enter the following. c:\oracle-dbd\>perl Makefile.PL The Makefile should then run and compile Oracle-dbd without reporting any errors. 18) From this DOS prompt enter the following command c:\oracle-dbd\>nmake The Visual C++ make executable will then build you DBD-execuable. There should be no errors at this point. 19) You can test the compile by either entering c:\oracle-dbd\>nmake test As long as you have given a valid user name, password and database name in step 15 you will see some results. If it appears to run but you do not get a connection check the following. i. User name password and DB Name ii. Ensure the a valid TNSNAMES.ORA file is in the Instantclient directory iii. Attempt to log into the version of SQLPLUS that comes with Instantclient. If you manage to log on use the username password and TNS name with the Set ORACLE_USERID = and rerun the tests. iv If you are compiling against 10XE and have skiped steps 12 to 14 try again bu this time carry out these steps 20) You can now install DBD-Oracle into you system by entering the following command from the Visual C++ window dos prompt; c:\oracle-dbd\>nmake install 21) You should now be able to run DBD-Oracle on you system =head1 09/30 2006 from asu DBD::Oracle 1.18a Linux, Debian unstable ( DBI: 1.52 perl v5.8.8 built for i486-linux-gnu-thread-multi ) Oracle Instant client (10.1.0.5) The problem is in Makefile.PL. In line 130 the function find_oracle_home is used to guess a value form $ORACLE_HOME if it is not set explicitly. This value is used in line 138 to setup the environment (regardless which client is used). in line 1443 (sub get_client_version) sqlplus is used to get the version string, but for the oracle instant client you must not set $ORACLE_HOME (it will generate an error "SP2-0642: SQL*Plus internal error state 2165, context 4294967295:0:0") A solution that worked for me was to set local $ENV{ORACLE_HOME} = ''; in line 1463 immediately before sqlplus is called (but I cannot tell if this fails for full client installations) 11/30/05 -- John Scoles I have confirmed that this Makefile.pl will work for both Oracle InstantClient 10.2.0.1 & 10.1.0.4 using same process the Andy Hassall uses. Starting with a clean OD One needs only to get the latest version of Active Perl 5.8.7 use PPM to get DBI and then install Microsoft Visual C++ toolkit, Windows SDK, and the Microsoft .net framework 1.1. and modify the vcvars32.bat in C++ dir as follows 1) Add the local path to the windows platform SDK include directory to the Set INCLUDE Command Line to include the needed files from the Windows SDK. e.g. "C:\Program Files\Microsoft Platform SDK\Include;" 2) Add the local path to the .net Vc7 lib directory to the Set LIB command to include the needed library files from the .Net SKD e.g. C:\Program Files\Microsoft Visual Studio .NET 2003\Vc7\lib; 3) Add the local path to the windows platform SDK Lib directory to the Set Lib command to include the needed library files from the Windows SDK e.g. C:\Program Files\Microsoft Platform SDK\Lib; If one happens to have visual studio installed you may not have to download additional MS products. 12/01/05 --- John Scoles Oracle 10XE No big problem here as 10XE seems to use the instantclient as well. Just ensure your NLS_LANG and ORACLE_HOME are set to the same directory that 10XE uses 10/07/05 --John Scoles Andy Hassall kindly added some changes to the Makefile.PL so it will work for the Instant Client 10g on Windows OSs. Below is how he set up his environment and the steps he preformed to get it to compile. Setting environment for using Microsoft Visual Studio .NET 2003 tools. (If you have another version of Visual Studio or Visual C++ installed and wish to use its tools from the command line, run vcvars32.bat for that version.) C:\Documents and Settings\andyh>d: D:\>cd cygwin\home\andyh\src\pythian D:\cygwin\home\andyh\src\pythian>set ORACLE_HOME=d:\lib\instantclient_10_2 D:\cygwin\home\andyh\src\pythian>set NLS_LANG=.WE8ISO8859P15 D:\cygwin\home\andyh\src\pythian>set PATH=d:\lib\instantclient_10_2;D:\Program F iles\Microsoft Visual Studio .NET 2003\Common7\IDE;D:\Program Files\Microsoft Vi sual Studio .NET 2003\VC7\BIN;D:\Program Files\Microsoft Visual Studio .NET 2003 \Common7\Tools;D:\Program Files\Microsoft Visual Studio .NET 2003\Common7\Tools\ bin\prerelease;D:\Program Files\Microsoft Visual Studio .NET 2003\Common7\Tools\ bin;D:\Program Files\Microsoft Visual Studio .NET 2003\SDK\v1.1\bin;C:\WINNT\Mic rosoft.NET\Framework\v1.1.4322;d:\Perl\bin\;C:\WINNT\system32;C:\WINNT;C:\WINNT\ System32\Wbem;D:\Program Files\Microsoft SDK\Bin;D:\Program Files\Microsoft SDK\ Bin\WinNT D:\cygwin\home\andyh\src\pythian>set ORACLE_USERID=test/test@test102 D:\cygwin\home\andyh\src\pythian>perl Makefile.PL 4/27/04 -- Jeff Urlwin Do not untar this distribution in a directory with spaces. This will not work. i.e. C:\Program Files\ORacle\DBD Oracle Distribution is bad while c:\dev\dbd-oracle-1.15 is good ;) 9/14/02 -- Michael Chase Makefile.PL uses Win32::TieRegistry or Win32::Registry to find the current Oracle Home directory if the ORACLE_HOME environment variable is not set. If neither module is installed, you must set ORACLE_HOME before running Makefile.PL. Since the registry location of the current Oracle Home is in different locations in different Oracle versions, it is usually safer to set ORACLE_HOME before running Makefile.PL. =head1 AUTHORS =over 4 =item * Tim Bunce =item * John Scoles =item * Yanick Champoux =item * Martin J. Evans =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 1994 by Tim Bunce. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBD-Oracle-1.74/lib/DBD/Oracle/Troubleshooting/Vms.pod0000644000175000017500000000765212326332111021567 0ustar yanickyanick#PODNAME: DBD::Oracle::Troubleshooting::Vms #ABSTRACT: Tips and Hints to Troubleshoot DBD::Oracle on Vms __END__ =pod =encoding UTF-8 =head1 NAME DBD::Oracle::Troubleshooting::Vms - Tips and Hints to Troubleshoot DBD::Oracle on Vms =head1 VERSION version 1.74 =head1 General Info This is related to Oracle RDBMS 9.2 and later, since Oracle made fundamental changes to oracle installation requirements and factual installation with this release. Oracle's goal was to make VMS installation be more like on *nix and Windows, with an all new Oracle Home structure too, requiring an ODS-5 disk to install Oracle Home on instead of the good old ODS-2. Another major change is the introduction of an Oracle generated logical name table for oracle logical names like ORA_ROOT and all its derivatives like ORA_PROGINT etc. And that this logical name table is inserted in LNM$FILE_DEV in LNM$PROCESS_DIRECTORY. (LNM$PROCESS_DIRECTORY) "LNM$FILE_DEV" = "SERVER_810111112" = "LNM$PROCESS" = "LNM$JOB" = "LNM$GROUP" = "LNM$SYSTEM" = "DECW$LOGICAL_NAMES" This ensures that any process that needs to have access to oracle gets the environment by just adding one logical name table to a central process specific mechanism. But as it is inserted at the very top of LNM$FILE_DEV it also represents a source of misfortune - especially if a user with enough privilege to update the oracle table does so (presumably unintentionally), as an example by changing NLS_LANG. PERL has the ability to define, redefine and undefine (deassign) logical names, but if not told otherwise by the user does it in the first table in above list, and not as one would normally expect in the process table. Installing DBI and DBD::Oracle has influence upon this since in both cases a few environment variables are read or set in the test phase. For DBI it is the logical SYS$SCRATCH, which is a JOB logical. For DBD-Oracle it is when testing a new feature in the Oracle RDBMS: UTF8 and UTF16 character set functionality, and in order to do this it sets and unsets the related environment variables NLS_NCHAR and NLS_LANG. If one is not careful this changes the values set in the oracle table - and in the worst case stays active until the next major system reset. It can also be a very hard error to track down since it happens in a place where one normally never looks. Furthermore, it is very possibly that some or all of the UTF tests fails, since if one have a variable like NLS_LANG in his process table, then even though 'mms test' sets it in the wrong table it is not invoked as it is overruled by the process logical... The way to ensure that no logicals are set in the oracle table and that the UTF tests get the best environment to test in, and that DBI correctly translates the SYS$SCRATCH logical, use the logical PERL_ENV_TABLES to ensure that PERL's behavior is to leave the oracle table alone and use the process table instead: $ DEFINE PERL_ENV_TABLES LNM$PROCESS, LNM$JOB This tells PERL to use the LNM$PROCESS table as the default place to set and unset variables so that only the perl users environment is affected when installing DBD::Oracle, and ensures that the LNM$JOB table is read when SYS$SCRATCH is to be translated. PERL_ENV_TABLES is well documented in the PERLVMS man page. Oracle8 releases are not affected, as they don't have the oracle table implementation, and no UTF support. Oracle 9.0 is uncertain, since testing has not been possible yet, but the remedy will not hurt :) =head1 AUTHORS =over 4 =item * Tim Bunce =item * John Scoles =item * Yanick Champoux =item * Martin J. Evans =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 1994 by Tim Bunce. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBD-Oracle-1.74/lib/DBD/Oracle/Troubleshooting/Hpux.pod0000644000175000017500000010243212326332111021736 0ustar yanickyanick#PODNAME: DBD::Oracle::Troubleshooting::Hpux #ABSTRACT: Tips and Hints to Troubleshoot DBD::Oracle on HP-UX __END__ =pod =encoding UTF-8 =head1 NAME DBD::Oracle::Troubleshooting::Hpux - Tips and Hints to Troubleshoot DBD::Oracle on HP-UX =head1 VERSION version 1.74 =head1 INTRODUCTION Building a working dynamically linked version of the Oracle DBD driver on HP-UX (11.00) has been a challenge for many. For months after taking a new job, where HP-UX was the standard database server environment, I had only been able to build a statically linked version of Perl and the DBD-Oracle module on HP-UX 11.00. Then Roger Foskett posted instructions for what turned out to be dynamic build. Rogers's post got me further than I had previously gotten. In fact, after resolving some undefined symbol errors, I succeeded where for I had previously despaired of finding the time to hack out the right incantation. This document describes the combined knowledge of a number of folks who invested many hours discovering a working set of build options. The instructions in this file, which include building Perl from source, will produce a working dynamically linked DBD-Oracle that can be used with mod_perl and Apache. See L for exact build configurations used by me an others. For HPUX 11 on Itanium see also http://www.nntp.perl.org/group/perl.dbi.users/23840 =head1 First things First: Introduction The reason you are even reading this file is because you want to connect to an Oracle database from your perl program using the DBD::Oracle DBI driver. So before you start, install (at least the Oracle client software) (SQL*Net, Pro*C, SQL*Plus) upon the machine you intend to install Perl/DBI/DBD-Oracle. You B, I repeat, I need to build a database on this machine. After you have installed the Oracle client software, B. Make sure you can connect to the target database using SQL*Plus (or any other Oracle supplied tool). The (gory) details of the install are beyond the scope of this document, some information can be found in the section L, or see your friendly Oracle DBA. One final remark, 3 years after this was first written. This has been updated numerous times over the years. And some of the new build recipe's see simpler than some of the original instructions in this file. I think one reason the recipe is getting simpler may be that the build hints, in the base perl build have gotten more right, as we have moved from perl 5.6.1 to the 5.8.8 (now the stable version). Someday, if I ever find myself building on HP again I should probably update as many of these recipes (that I can test) by trying to remove more of the special case stuff I have in my build scripts now. Gram Ludlows's build for the default bundled C compiler shows that a lot of this may no longer be necessary. On the other hand, it would be bad if we deleted information that others might need, so I err on the side of too much, in the hope that the person who really needs the information, will not have to look beyond this file. -- Lincoln =head1 Build your own Perl HP's default Perl is no good (and antique). By default, HP-UX 11.00 delivered Perl 5.00503 until September 2001. Others tell me that the default is a threaded GNUpro build of 5.6.1. This is not what I found on our systems, and it probably depends on which packages you install. In any case, this version of Perl delivered by HP will in all likelihood not work. Before you check, be sure to prevent the perl4 located in /usr/contrib/bin from being the first Perl version found in your $PATH. As of application release September 2001, HP-UX 11.00 is shipped with Perl-5.6.1 in /opt/perl. The first occurrence is on CD 5012-7954. The build is a portable hppa-1.1 multithread build that supports large files compiled with gcc-2.9-hppa-991112. When you have a modern system with a hppa-2.0 architecture (PA8xxx processor) and/or the HP C-ANSI-C compiler consider building your own Perl, which will surely outperform this version. If you are reading this, you have probably discovered that something did not work. To get a working version of the DBD-Oracle driver, we have to start with a Perl that as been built with the correct compiler flags and shared libraries. This means that you must build your own version of Perl from source. See L for a copy of a makefile used by me to build Perl on HP-UX and all other platforms on which he works (Sun and Red Hat). The instructions below have been used for building a dynamically linked working DBD-Oracle driver that works with mod_perl and Apache. These instructions are based on Perl 5.6.0 and 5.6.1, and 5.8.0. To this author's knowledge, they have not be tested on earlier versions of Perl. Note that is important to build a B-threaded Perl, but linked with -lcl and -lpthread. Since Oracle on HP uses libpthread, everything that dynamically loads it (such as DBD-Oracle) must be built/linked with '-lpthread -lcl'. (When used with Apache, it and any associated modules must also be built this way - otherwise all it does is core dump when loading DBD::Oracle). A good link that explains thread local storage problems is http://my1.itrc.hp.com/cm/QuestionAnswer/1,1150,0x0d0a6d96588ad4118fef0090279cd0f9!0,00.html One more note, it would appear that the README.hpux in the Perl 5.8.0 directory, is somewhat out of date, but is up-to-date in versions 5.8.3 and up. H.Merijn Brand points out that Perl I 64bit compliant when the -Duse64bitall flag is used to Configure. While Perl will be built in a pure LP64 environment via the +DD64 flag is used, the +DA2.0w flag is preferred on PA-RISC, and when an incantation can be concocted that eliminates the noisy warnings the produces at link time, this will probably become the default. Older 64bit versions of GCC, are known to be unable to build a good LP64 perl. And these flags will cause gcc to barf. On HP-UX 11i (11.11), gcc-3.4.4 or gcc-3.4.5 is preferred over gcc-4.0.2 (or older gcc-4 versions) as 64bit builds on PA-RISC with that versions of the compiler are unreliable. =head1 Compilers =head2 HP Softbench Compiler Both Roger Foskett, I and most others have been using the HP Softbench C compiler normally installed in: /opt/softbench/bin/cc. While the DBD-Oracle F checks for some of the conditions which, when met, we know will produce a working build, there are many variations of Oracle installations and features. Not all of these can be tested by any one of us, if you discover a way to make a variation which did not previously work, please submit patches to the Makefile.PL to Tim Bunce, and patches to this README to me, and I will incorporate them into the next README. The instructions herein, have compiled, linked cleanly, and tested cleanly using the HP softbench compiler, and Oracle 8.0.5 (32bit), and Oracle 8.1.6, 8.1.7 (64 bit). Oracle 8.1.5 will probably work as well. Oracle 8.1.7.4 (32bit) with DBI-1.35 and DBD-Oracle-1.13 has been proven to work on HP-UX 11.00 (64bit) with Perl 5.6.1, Perl 5.8.x using the guidelines in this document for both HP-C-ANSI-C and gcc-3.2. Later versions have been proven to work as well. Current DBI-1.42 and DBD-Oracle-1.16 have been proven to work. This Oracle 9.2 client (at least) should be used if you plan to do work with Unicode. See the DBD-Oracle POD/Man documentation. =head2 gcc Compiler As of gcc-3.4, perl-5.8.3 and up should build out-of-the box when Configure is invoked with -Dcc=gcc. Please read README.hpux carefully for the differences with HP C-ANSI-C. Once built, tested and installed, both DBI and DBD-Oracle should be able to build against that perl without trouble. In the past, Waldemar Zurowski and Michael Schuh sent useful information about builds of Perl with DBD-Oracle using gcc on HP-UX. Both were able to get working executables, and their explanations shed much light on the issues. Waldemar's build is described in L, and Michael's is described in L. While I have not reproduced either of these configurations, I believe the information is complete enough (particularly in the aggregate) to be helpful to others who might wish to replicate it. If someone would be willing to submit a makefile equivalent to the makefile in any of the examples from L, which uses gcc to build Perl and the DBI/DBD-Oracle interfaces, I will be happy to include it in the next README. =head2 The "default" built in compiler 64bit build (/usr/bin/cc) And now, at long last, we have a recipe for building perl and DBD-Oracle using the default bundled C compiler. Please see the L build instructions provided by Gram Ludlow, using the default /usr/bin/cc bundled compiler. Please note that perl itself will I build using that compiler. =head2 Configure (doing it manually) Once you have downloaded and unpacked the Perl sources (version 5.8.8 assumed here), you must configure Perl. For those of you new to building Perl from source, the Configure program will ask you a series of questions about how to build Perl. You may supply default answers to the questions when you invoke the Configure program by command line flags. We want to build a Perl that understands large files (over 2GB, wich is the default for building perl on HP-UX), and that is incompatible with v5.005 Perl scripts (compiling with v5.005 compatibility causes mod_perl to complain about malloc pollution). At the command prompt type: cd perl-5.8.8 sh ./Configure -A prepend:libswanted='cl pthread ' -des or, if you need a 64bit build sh ./Configure -A prepend:libswanted='cl pthread ' -Duse64bitall -des Do not forget the trailing space inside the single quotes. This is also described by H.Merijn Brand in the README.hpux from the perl core distribution. When asked: Any additional cc flags? - Answer by prepending: I<+Z> to enable position independent code. For example: Any additional cc flags? [-D_HP-UX_SOURCE -Aa] -Ae +Z -z Though this should be the default in more recent perl versions. Lastly, and this is optional, when asked: Do you want to install Perl as /usr/bin/perl? [y] n You may or may not want to install directly in /usr/bin/perl, many persons on HP install Perl in /opt/perl/bin/perl and put a symbolic link to /usr/bin/perl. Furthermore, you can supply the answer to this question by adding an additional switch to the invocation of Configure such as: Configure -Dprefix=/opt/perl After you have answered the above questions, accept the default values for all of the remaining questions. You may press for each remaining question, or you may enter "& -d" (good idea) at the next question and the Configure will go into auto-pilot and use the Perl supplied defaults. BTW: If you add -lcl and -lpthread to the end of the list it will not work. I wasted a day and a half trying to figure out why I had lost the recipe, before I realized that this was the problem. The symptom will be that make test of Perl itself will fail to load dynamic libraries. You can check in the generated 'config.sh' that the options you selected are correct. If not, modify config.sh and then re-run ./Configure with the '-d' option to process the config.sh file. Build & Install make make test make install If you are going to build mod_perl and Apache it has been suggested that you modify Config.pm to the change the HP-UX ldflags & ccdlflags in F as follows: ccdlflags='' cccdlflags='+Z' ldflags=' -L/usr/local/lib' This is not necessary if you are not using mod_perl and Apache. =head1 Build and Install DBI cd DBI-1.50 Perl Makefile.PL make make test make install =head1 Build and Install DBD-Oracle-1.07 and later It is critical to setup your Oracle environmental variables. Many people do this incorrectly and spend days trying to get a working version of DBD-Oracle. Below are examples of a local database and a remote database (i.e. the database is on a different machine than your Perl/DBI/DBD installation) environmental variable setup. Example (local database): export ORACLE_USERID= export ORACLE_HOME= export ORACLE_SID= export SHLIB_PATH=$ORACLE_HOME/lib #for 32bit HP export LD_LIBRARY_PATH=$ORACLE_HOME/lib #for 64bit HP (I defined them both) Note that HP-UX supports I SHLIB_PATH I LD_LIBRARY_PATH for all libraries that need to be found, but that each library itself can enable or disable any of the two, and can also set preference for the order they are used, so please set them to the same value. Example (remote database): export ORACLE_USERID= export ORACLE_HOME= export ORACLE_SID=@ export SHLIB_PATH=$ORACLE_HOME/lib #for 32bit HP export LD_LIBRARY_PATH=$ORACLE_HOME/lib #for 64bit HP (I defined them both) The standard mantra now works out of the box on HP-UX: cd DBD-Oracle-1.07 # or more recent version perl Makefile.PL make make test make install # if all went smoothly And with DBD-1.14 and later the following can be used: cd DBD-Oracle-1.14 # or more recent version perl Makefile.PL -l # uses a simple link to oracle's main library make make test make install # if all went smoothly If you have trouble, see the L instructions below, for hints of what might be wrong... and send me a note, describing your configuration, and what you did to fix it. =head1 Trouble Shooting =head2 "Unresolved symbol" In general, find the symbols, edit the Makefile, and make test. You'll have to modify the recipe accordingly, in my case the symbol "LhtStrCreate" was unresolved. (Authors Note: thanks patch suggestions by Jay Strauss this situation which occurs with Oracle 8.1.6 should now be handled in Makefile.PL.) 1) Find the symbols. a) The following ksh/bash code (courtesy of Roger) will search from $ORACLE_HOME and below for Symbols in files in lib directories. Save the following to a file called "findSymbol". >>>> CUT HERE <<<<< cd $ORACLE_HOME echo "\nThis takes a while, grepping a lot of stuff" echo " ignore the \"no symbols\" warnings\n" sym=$1; shift; libs="*.sl" for lib in $(find . -name $libs -print); do if nm -p $lib | grep -q $sym; then echo "found \"$sym\" in $lib" fi done >>>>> CUT HERE <<<< Note that on Itanium machines (HP-UX 11.23), the shared libraries have a .so extension instead of the .sl HP-UX uses on PA-RISC. b) Run it (replace "LhtStrCreate" with your "Unresolved symbol"). For example, at my installation, findSymbols produced the following output: # chmod 755 findSymbols # ./findSymbol LhtStrCreate found "LhtStrCreate" in ./lib/libagtsh.sl found "LhtStrCreate" in ./lib/libclntsh.sl found "LhtStrCreate" in ./lib/libwtc8.sl 2) Edit the Makefile In the previous step your unresolved symbol was found in one or more library files. You will need to edit the OTHERLDFLAGS makefile macro, and add the missing libraries. When you add those library files to OTHERLDFLAGS you must convert the name from the actual name to the notation that OTHERLDFLAGS uses. libclntsh.sl becomes => -lclntsh libagtsh.sl becomes => -lagtsh libwtc8.sl becomes => -lwtc8 That is, you replace the "lib" in the name to "-l" and remove the ".sl" (or the .so). You can edit the Makefile in 2 ways: a) Do this: perl -pi -e's/\b(OTHERLDFLAGS.*$)/$1 -lclntsh/' Makefile b) Using vi, emacs... edit the file, find OTHERLDFLAGS, and add the above "-l" entries to the end of the line. For example the line: OTHERLDFLAGS = -L/opt/oracle/product/8.1.6/lib/... -lqsmashr Becomes: OTHERLDFLAGS = -L/opt/oracle/product/8.1.6/lib/... -lqsmashr -lclntsh 3) make test Perform a make test, if symbols are still unresolved repeat the editing of the Makefile and make test again. =head1 DBD-Oracle-1.06 You are strongly urged to upgrade. However here is what you may need to know to get it or work, if you insist on using an earlier version. Check the output that above command produces, to verify that -Wl,+n -W1,+s is b present. and that -lqsmashr B present. If the version of Makefile.PL does not include the patch produced at the time of this document, then the above conditions will likely not be met. You can fix this as follows: perl -pi -e's/-Wl,\+[sn]//' Makefile =head1 Building on a Oracle Client Machine If you need to build or deliver the DBD-Oracle interface on or to a machine upon which the Oracle database has not been installed you need take the following into consideration: =over =item 1) Oracle files are needed for DBD::Oracle to compile =item 2) Oracle files are needed for the compiled DBD to connect =item 3) ORACLE_HOME environment variable must be set =item 4) SHLIB_PATH environment variable must be set =back =head2 Compiling on a Client Machine This may seem obvious to some, but the Oracle software has to be present to compile and run DBD-Oracle. The best way to compile and install on a client machine, is to use the oracle installer to install the oracle (client) software locally. Install SQL*Net, Pro*C and SQL*Plus. After this some tests with SQL*Net (tnsping at a minimum) are an good idea. Make sure you can connect to your remote database, and everything works with Oracle before you start bashing your head into the wall trying to get DBD-Oracle to work. If you do not have the Oracle installer handy, the following hack has been known to work: Either open an NFS share from the oracle installation directory on the machine that has Oracle and point both of the above-mentioned env vars to that share, or alternatively copy the following four directories from your Oracle installation over to the machine on which you are compiling the DBD: drwxr-xr-x 3 oracle dba 3072 Jul 3 09:36 lib drwxr-xr-x 13 oracle dba 512 Jul 3 09:38 network drwxr-xr-x 7 oracle dba 512 Jul 2 19:25 plsql drwxr-xr-x 12 oracle dba 512 Jul 3 09:38 rdbms then point the above-mentioned env vars to the containing directory (good place to put them, if copying locally, might be /usr/lib/oracle, /usr/local/lib/oracle, or /opt/oracle/lib ) In any case, the compiler needs to be able to find files in the above four directories from Oracle in order to get all the source code needed to compile properly. =head2 Required Runtime environment Again, use the Oracle installer to install the Oracle Client on the machine where your scripts will be running. If the Oracle installer is not available, the following hack should suffice: For running the compiled DBD in Perl and connecting, you need only the files in the 'lib' folder mentioned above, either connecting to them through an NFS share on the Oracle machine, or having copied them directly onto the local machine, say, in /usr/lib/oracle . Make sure the env variable for ORACLE_HOME = /usr/lib/oracle and LD_LIBRARY_PATH includes /usr/lib/oracle . You can set the env var in your perl script by typing $ENV{ORACLE_HOME} = '/usr/lib/oracle'; =head1 Apache and mod_perl B these instructions are now more than a year and a half old, you may have to tinker. If you are not building this version of Perl for Apache you can go on to build what ever other modules you require. The following instructions describe how these modules were built with the Perl/DBD-Oracle built above: The following is what worked for Roger Foskett: =head1 Apache Web server cd apache_1.3.14/ LDFLAGS_SHLIB_EXPORT="" \ LDFLAGS="-lm -lpthread -lcl" \ CC=/usr/bin/cc \ CFLAGS="-D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64" \ ./configure \ --prefix=/opt/www/apache \ --enable-shared=max \ --disable-rule=EXPAT \ --enable-module=info \ --enable-rule=SHARED_CORE The Expat XML parser is disabled as it conflicts with the Perl XML-Parser module causing core dumps. -lcl is needed to ensure that Apache does not coredump complaining about thread local storage make make install Once installed, ensure that the generated httpd.conf is properly configured, change the relevant lines to below (the default user/group caused problems on HP (the user 'www' may need to be created) User www Group other port 80 =head2 mod_perl cd mod_perl-1.24_01/ perl Makefile.PL \ NO_HTTPD=1 \ USE_APXS=1 \ WITH_APXS=/opt/www/apache/bin/apxs \ EVERYTHING=1 make make install =head2 htdig intranet search engine cd htdig-3.1.5/ CC='cc' CPP='aCC' \ ./configure \ --prefix=/opt/www/htdig \ --with-cgi-bin-dir=/opt/www/htdig/cgi-bin \ --with-image-dir=/opt/www/htdig/images =head1 CONTRIBUTORS The following folks contributed to this document: Lincoln A. Baxter H.Merijn Brand Jay Strauss Roger Foskett Weiguo Sun Tony Foiani Hugh J. Hitchcock Heiko Herms Waldemar Zurowski Michael Schuh Gram M. Ludlow And probably others unknown to me. =head1 AUTHOR Lincoln A. Baxter H.Merijn Brand =head1 APPENDICES =head2 Appendix A (gcc build info from Waldemar Zurowski) This is pretty much verbatim the build information I received from Waldemar Zurowski on building Perl and DBD-Oracle using gcc on HP. Note that this build was on a PA-RISC1.1 machine. =head3 Host HP-UX hostname B.11.11 U 9000/800 XXXXXXXXX unlimited-user license =head3 Oracle Oracle 8.1.7 =head3 Parameters to build Perl ./Configure -des -Uinstallusrbinperl -Uusethreads -Uuseithreads -Duselargefiles -Dcc=gcc -Darchname=PA-RISC1.1 -Dprefix=/opt/perl-non-thread -Dlibs='-lcl -lpthread -L${ORACLE_HOME}/JRE/lib/PA_RISC/native_threads -ljava -lnsl -lnm -lndbm -ldld -lm -lc -lndir -lcrypt -lsec' -L${ORACLE_HOME}/JRE/lib/PA_RISC/native_threads -ljava, was added because DBD::Oracle wants to link with it (probably due to Oracle's own build rules picked up by Makefile.PL) Set environment variable LDOPTS to '+s' (see ld(1)). This holds extra parameters to HP-UX's ld command, as I don't use GNU ld (does anybody?). This allows you to build an executable, which when run would search for dynamic linked libraries using SHLIB_PATH (for 32-bit executable) and LD_LIBRARY_PATH (for 64-bit executable). Obviously LDOPTS is needed only when building Perl _and_ DBI + DBD::Oracle. Then, after building Perl + DBI + DBD::Oracle and moving it into production environment it was enough to add to SHLIB_PATH ${ORACLE_HOME}/lib and ${ORACLE_HOME}/JRE/lib/PA_RISC/native_threads, for example: SHLIB_PATH=${ORACLE_HOME}/lib:${ORACLE_HOME}/JRE/lib/PA_RISC/native_threads: $SHLIB_PATH Please note output of ldd command: $ ldd -s ./perl [...] find library=/home/ora817/JRE/lib/PA_RISC/native_threads/libjava.sl; required by ./perl search path=/home/ora817/lib:/home/ora817/JRE/lib/PA_RISC/native_threads (SHLIB_PATH) trying path=/home/ora817/lib/libjava.sl trying path=/home/ora817/JRE/lib/PA_RISC/native_threads/libjava.sl /home/ora817/JRE/lib/PA_RISC/native_threads/libjava.sl => /home/ora817/JRE/lib/PA_RISC/native_threads/libjava.sl [...] All of this mess is necessary because of weakness of shl_load(3X), explained in this document and in some discussion forums at HP.com site. I have learned, that HP issued patch PHSS_24304 for HP-UX 11.11 and PHSS_24303 for HP-UX 11.00, which introduced variable LD_PRELOAD. I haven't tried it yet, but it seems promising that it would allow you to completely avoid building your own Perl binary, as it would be enough to set LD_PRELOAD to libjava.sl (for example) and all 'Cannot load XXXlibrary' during building of DBD::Oracle should be gone. The documentation says, that setting this variable should have the same effect as linking binary with this library. Also please note, that this variable is used only when binary is not setuid nor setgid binary (for obvious security reasons). It seems, that the best way to find out if you already have this patch applied, is to check if 'man 5 dld.sl' says anything about LD_PRELOAD environment variable. Best regards, Waldemar Zurowski Authors Note: Search for references to LD_PRELOAD else where in this document. Using LD_PRELOAD is probably a fragile solution at best. Better to do what Waldemar actually did, which is to include libjava in the extra link options. =head2 Appendix B (64 bit build with /usr/bin/cc -- bundled C compiler) Gram M. Ludlow writes: I recently had a problem with Oracle 9 64-bit on HPUX 11i. We have another application that required SH_LIBARY_PATH to point to the 64-bit libraries, which "broke" the Oraperl module. So I did some research and successfully recompiled and re-installed with the most recent versions of everything (perl, DBI, DBD) that works with 64-bit shared libraries. This is the error we were getting (basically) "/usr/lib/dld.sl: Bad magic number for shared library: /ora1/app/oracle/product/9.2.0.1.0/lib32" Here is my step-by-step instructions, pretty much what you have but streamlined for this particular case. Required software: HPUX 11.11 (11i) PA-RISC perl 5.8.4 source DBI-1.42 source DBD-Oracle-1.16 source Oracle 9.2.0.1.0 installation =over =item Step 1: Compiling Perl This compiles PERL using the default HPUX cc compiler. The important things to note here are the configure parameters. the only non-default option to take is to add "+z" to the additional cc flags step. gunzip perl-5.8.4.tar.gz tar -xf perl-5.8.4.tar cd perl-5.8.4 ./Configure -Ubincompat5005 -Duselargefiles -A prepend:libswanted='cl pthread ' -Duse64bitall Any additional cc flags? Add +z to beginning of list, include all other options. make; make test 98% of tests should succeed. If less, something is wrong. =item Step 2: DBI gunzip DBI-1.42.tar.gz tar -xvf DBI-1.42.tar cd DBI-1.42 perl Makefile.PL make;make test make install =item Step 3: Install DBD-Oracle First, set the following environment variables specific you your Oracle installation: export ORACLE_USERID=user/pass export ORACLE_HOME=/oracle/product/9.2.0.1.0 export ORACLE_SID=orap1 Then unpack and build: gunzip DBD-Oracle-1.16.tar.gz tar -xvf DBD-Oracle-1.16.tar cd DBD-Oracle-1.16 perl Makefile.PL -l make;make test make install =back Note from H.Merijn Brand: In more recent perl distributions using HP C-ANSI-C should "just work" (TM), provided your C compiler can be found and used, your database is up and running, and your environment variables are set as noted. Example is for a 64bit build, as Oracle ships Oracle 9 and up for HP-UX only in 64bit builds. gzip -d offsets in the Position Independent Code, where -fpic (+z) only allows small offsets. I suspect that your hint about adding -lcl and -lpthread were crucial, but (after doing so) I never encountered any problems that were related to them. One thing that I did was create a shell script to set some variables, as the initial environment for root on the target system didn't work very well. Here is that script, trimmed to remove a bunch of echo statements, etc.: # ------------------------------------------------------------------- # root.env - sets some environment variables the way I want them... # # Mike Schuh, June 2002, July 2002 export CC=/usr/local/bin/gcc export INSTALL=./install-sh . appl_setup DDD export ORACLE_SID="SSS" export ORACLE_USERID="XXX/YYY" export PATH=/usr/local/bin:/usr/sbin:/usr/bin:/usr/ccs/bin:/opt/perl5/bin:/usr/c ontrib/bin:/opt/nettladm/bin:/opt/fc/bin:/opt/fcms/bin:/opt/pd/bin:/usr/bin/X11: /usr/contrib/bin/X11:/opt/hparray/bin:/opt/resmon/bin:/usr/sbin/diag/contrib:/op t/pred/bin:/opt/gnome/bin:/sbin # end of root.env The appl_setup sets some Oracle variables (specific to our installation), which I then override for the database that I am working on. The script (which I source) also uses some variables specific to other applications (e.g., Tivoli), mostly to unclutter my debugging. The INSTALL variable is related to building libgdbm. =head2 http://www.mail-archive.com/dbi-users@perl.org/msg18687.html Garry Ferguson's notes on a successful build using perl 5.8.0, DBI-1.38 and DBD-Oracle-1.14 on HPUX 11.0 ( an L2000 machine ) with Oracle 9.0.1 =head2 http://www.sas.com/service/techsup/unotes/SN/001/001875.html This is a note from the SAS support people documenting the LhtStrInsert() and LhtStrCreate() undefined symbols errors, and how to fix them in the Oracle makefiles. =head1 Appendix D (Why Dynamic Linking) Some one posted to the DBI email list the following question: What are the advantages of building a dynamically linked version? Being able to use threads? Or something besides that? The answer is there are too many to count, but here are several big ones: =over =item 1 Much smaller executables Only the code referenced gets loaded... this means faster execution times, and less machine resources (VM) used) =item 2 Modular addition and updating of modules. This is HUGE. One does not relink B one changes or updates a module. =item 3 It eliminates Dynaloader warning (multiply defined). This occurs with the static build when Perl is run with -w. I fixed this by removing -w from my #! lines, converting the pragam "use warnings;". However, it was annoying, since all my scripts had -w in the #! line. =item 4 It's the default build Since almost every OS now supports dynamic linking, I believe that static linking is NOT getting the same level of vetting it maybe used to. Dynamicly linking is what you get by default, so its way better tested. =item 5 It's required for Apache and mod_perl. =back =head1 Appendix E (WebLogic Driver for Oracle with the Oracle8i Server Lob Bug) Michael Fox reported a bug when you are using DBD-Oracle-1.18 or later and when using older Oracle versions. The bug will result in an error report 'Failed to load Oracle extension and/or shared libraries'. This problem occurs if you use the WebLogic Driver for Oracle with the Oracle8i Server - Enterprise Edition 8.1.7 and the corresponding Oracle Call Interface (OCI). This problem occurs only in Oracle 8.1.7; it is fixed in Oracle 9i. This link details the problem =head1 http://e-docs.bea.com/platform/suppconfigs/configs70/hptru64unix51_alpha/70sp1.html#88784 The solution from this page is below; To work around this problem, complete the following procedure: =over =item 1 Log in to your Oracle account: su - oracle =item 2 In a text editor, open the following file: $ORACLE_HOME/rdbms/admin/shrept.lst =item 3 Add the following line: rdbms:OCILobLocatorAssign =item 4 (optional) Add the names of any other missing functions needed by applications, other than WebLogic Server 7.0, that you want to execute. Note: The OCILobLocatorAssign function is not the only missing function that WebLogic Server 7.0 should be able to call, but it is the only missing function that WebLogic Server 7.0 requires. Other functions that WebLogic Server should be able to call, such as OCIEnvCreate and OCIerminate, are also missing. If these functions are required by other applications that you plan to run, you must add them to your environment by specifying them, too, in $ORACLE_HOME/rdbms/admin/shrept.lst. =item 5 Rebuild the shared client library: $ cd $ORACLE_HOME/rdbms/lib $ make -f ins_rdbms.mk client_sharedlib The make command updates the following files in /opt/oracle/product/8.1.7/lib: clntsh.map ldap.def libclntsh.so libclntsh.so.8.0 libclntst8.a network.def plsql.def precomp.def rdbms.def Because OCILobLocatorAssign is now visible in libclntsh.so, WebLogic Server can call it. =back =head1 AUTHORS =over 4 =item * Tim Bunce =item * John Scoles =item * Yanick Champoux =item * Martin J. Evans =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 1994 by Tim Bunce. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBD-Oracle-1.74/lib/DBD/Oracle/Troubleshooting/Aix.pod0000644000175000017500000002201412326332111021530 0ustar yanickyanick#PODNAME: DBD::Oracle::Troubleshooting::Aix #ABSTRACT: Tips and Hints to Troubleshoot DBD::Oracle on AIX __END__ =pod =encoding UTF-8 =head1 NAME DBD::Oracle::Troubleshooting::Aix - Tips and Hints to Troubleshoot DBD::Oracle on AIX =head1 VERSION version 1.74 =head1 Using Visual Age 7 C Compiler Oracle 9i is only certified as a 64-bit application on AIX 5L (5.1,5.2,5.3) with 32-bit support; in other words, there is no 9i "32-bit" Oracle client Oracle 10g is certified as both a 64-bit application and a 32-bit Oracle client This information only pertains to deploying: the DBI (version 1.48) and DBD-Oracle (version 1.16): on AIX 5.3 using Oracle 9i (9.2.0.1/9.2.0.5) using the existing Perl 5.8.2 (no custom-built Perl) which is 32-bit using Visual Age 7.0 C/C++ compiler Install the DBI (required for the DBD-Oracle install - no issues here) Untar the DBD-Oracle bundle Run Makefile.PL $ perl Makefile.PL Edit Makefile with following commands: 1,$s?/lib/ ?/lib32/ ?g 1,$s?-q64??g 1,$s?/lib/sysliblist?/lib32/sysliblist?g Now perform normal commands to perform the testing/making: $ make $ make test $ make install I've tested the basics of the DBD-Oracle and it seems fully functional. Stephen de Vries =head1 Using gcc C Compiler DBD::Oracle with gcc and Oracle Instant Client on AIX -------------------------------------------------------------------------------------- Nathan Vonnahme Dec 15 2005, 4:28 pm Newsgroups: perl.dbi.users See: http://groups.google.com/group/perl.dbi.users/msg/0bd9097f80f2c8a9 [ with updates 1/31/2006 - DBD::Oracle 1.17 doesn't need makefile hacking to work with instantclient on AIX ] Yes! It eluded me last year but I finally got DBD::Oracle working on an AIX machine using gcc. Here's the short version: First I had to recompile perl with gcc, using sh Configure -de -Dcc=gcc This apparently built a 32 bit perl, someday I will try getting it to go 64 bit. I was then able to install and build DBI 1.50 with the CPAN shell. I downloaded the base and sdk packages of the Oracle Instant Client for AIX -- first I tried the 64 bit but that didn't work with my 32 bit perl -- the 32 bit version (still at 10.1.0.3) did the trick. I unzipped them and moved the dir to /usr/local/oracle/instantclient10_1 and made a symlink without the version at /usr/local/oracle/instantclient , then set: export ORACLE_HOME=/usr/local/oracle/instantclient export LIBPATH=$ORACLE_HOME Oracle wasn't providing the sqlplus package for 32 bit AIX so I explicitly told Makefile.PL the version: perl Makefile.PL -V 10.1 make My test databases were on other machines so I set these environment variables to get the tests to run: export ORACLE_DSN=DBI:Oracle://host/dbinstance export ORACLE_USERID="user/password" make test make install NOTE: I have an older full version of Oracle on this machine, and the ORACLE_HOME environment variable is normally set to point to that, so my perl scripts that use DBD::Oracle have to make sure to first set $ENV{ORACLE_HOME}='/usr/local/oracle/instantclient'; -------------------------------------------------------------------------------------- The following setup worked to build on AIX 5.2: gcc-3.3.2 (32-bit) (configure opts [ --with-ld=/usr/ccs/bin/ld --with-as=/usr/ccs/bin/as]) Oracle-9.2.0 ( full install w/32bit support) perl-5.8.3 (built with above gcc/latest stable as of March 2004) Followed the directions from Rafael's email below, only set ORACLE_HOME, (and the appropriate test environmentals). 1) build perl-5.8.3 with gcc 2) install DBI 3) ORACLE_HOME="your oracle home" ORACLE_USERID.. ORACLE_SID .. (I ignored ORACCENV, didn't use it.) 4) install DBD::Oracle, after perl Makefile.PL, edit the created Makefile, changing references to Oracle's ../lib to ../lib32. and change crt0_64.o to crt0_r.o. Remove the -q32 and/or -q64 options from the list of libraries to link with. 5) make should be clean, make test should pass. This setup worked with 8.1.7 w/32 bit support, and with 9.2.0 w/ 32-bit support. --Adrian Terranova =head1 Using xlc_r C Compiler From: Rafael Caceres Date: 22 Jul 2003 10:05:20 -0500 The following sequence worked for me on AIX 5.1: -use Perl 5.8.0 (the latest stable from CPAN) -use the xlc_r version of IBM's compiler and build a 32 bit Perl (which xlc_r will do by default). All tests should be successful. -get and install DBI -get DBD::Oracle. Edit the Makefile.PL or Makefile for DBD::Oracle, changing references to Oracle's ../lib to ../lib32. and change crt0_64.o to crt0_r.o. Remove the -q32 and/or -q64 options from the list of libraries to link with. Do the make and make test. -Set up the environment for making DBD::Oracle: ORACLE_HOME="your oracle home" ORACCENV = "xlc_r" ORACLE_USERID.. ORACLE_SID .. -Run make, all tests should be successfull -against Oracle 9.x at least. You should have no problems with Oracle 8.1.7, but accessing Oracle 7.x or previous is not possible (you'll core dump, or simply hang). The same goes for a Linux build or a Digital build, regarding access of different Oracle versions. Rafael Caceres > I don't believe I compiled Oracle. During the installation it was linked > but I am not sure it was compiled > > I used a xlc compiler to compile PERL. > Got this message in the Perl Makefile.PL output > > Warning: You will may need to rebuild perl using the xlc_r compiler. > You may also need do: ORACCENV='cc=xlc_r'; export ORACCENV > Also see the README about the -p option > > this probably means I need to rebuild PERL with xlc_r?? > > thanx > > Mike Paladino > Database Administrator From: Rafael Caceres > > Make sure you use the same compiler to build Oracle and Perl. We have > used xlc_r on Aix 5.1 with no problems. Your Perl build is 32 bit, so > when building DBD::Oracle, you should use the 32bit libraries (change > references to .../oracle/lib to .../oracle/lib32 in your Makefile). > Remove the references to the -q64 or -q32 parameters for ld in Makefile, > as they shouldn't be there. > > Rafael Caceres From: "cartman ltd" Subject: Tip for DBI and DBD::Oracle on AIX 5.1 and Oracle 9.2 Date: Mon, 11 Aug 2003 18:15:38 +0000 Message-ID: Here is a tip for compiling DBD::Oracle as a 32 bit application on AIX 5.1 64 bit and Oracle 9.2 64 bit without editing any makefiles. I hope people find this useful: First, the versions of products I used: DBI version 1.32 DBD::Oracle version 1.14 Oracle 9.2.0.2 - default 64 bit application with 32 bit libraries AIX 5.1 ML03 - 64 bit kernel - ships with Perl as a 32 bit application. VisualAge C/C++ 5.0.2 Basically DBD must be compiled as 32 bit to link with Perl's 32 bit libraries. gunzip -c DBD-Oracle-1.14.tar.gz | tar xvf  cd DBD-Oracle-1.14 perl Makefile.PL -m $ORACLE_HOME/rdbms/demo/demo_rdbms32.mk make NB: I think there is a bug in the Oracle 9.2.0.3 file $ORACLE_HOME/rdbms/lib/env_rdbms.mk I corrected this (before running the above commands) by replacing the invalid linker option LDFLAGS32=-q32 with LDFLAGS32=-b32 Have fun: KC. -------------------------------------------------------------------------------------- Date: Wed, 30 Jun 2004 23:34:24 -0500 From: "SCHULTZ, DARYLE (SBCSI)" Got it to work. Using dbd 1.16 Perl 5.8.4 built like this, with Visual Age 6.0: config_args='-Dcc=xlc_r -Dusenm -Dprefix=/appl/datasync/work/perl5 -Dusethreads -Duse64bitall -des' ============================================== Used DBI 1.42 ============================================= Added this to top of Oracle.h: #define A_OSF #include ======================= Set LIBPATH to point to 64bit Oracle libs first. export LIBPATH=$ORACLE_HOME/lib:$ORACLE_HOME/lib32:/usr/lib Use: perl Makefile.PL -nob Change all references in Makefile of LD_RUN_PATH to be LIBPATH. Change nothing else, left all flags in Makefile, including -q64. Passed make, and all tests. -------------------------------------------------------------------------------------- =head1 AUTHORS =over 4 =item * Tim Bunce =item * John Scoles =item * Yanick Champoux =item * Martin J. Evans =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 1994 by Tim Bunce. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBD-Oracle-1.74/lib/DBD/Oracle/Troubleshooting/Sun.pod0000644000175000017500000000306312326332111021557 0ustar yanickyanick#PODNAME: DBD::Oracle::Troubleshooting::Sun #ABSTRACT: Tips and Hints to Troubleshoot DBD::Oracle on Sun __END__ =pod =encoding UTF-8 =head1 NAME DBD::Oracle::Troubleshooting::Sun - Tips and Hints to Troubleshoot DBD::Oracle on Sun =head1 VERSION version 1.74 =head1 General Info If you get this on a Solaris 9 and 10 box "Outofmemory! Callback called exit. END failed--call queue aborted." The solution may be as simple as not having you "ORACLE_HOME" Defined in the environment. It seems that having it defined will prevent the error. =head1 Setting library load path for instant client libraries Usually you set LD_LIBRARY_PATH to point to the location of your Oracle Instant Client (you need to do this when building DBD::Oracle). However, afterwards it can be a pain to keep ensuring this is set and changing LD_LIBRARY_PATH in your Perl script does not work (needs to be done beforehand) as the dynamic linker caches its value. An alternative under newer versions of Solaris is: root> crle -u -l /youroracledir/lib/instantclient_11_2 however, make sure you check the crle options as you may need to set the architecture etc as well. =head1 AUTHORS =over 4 =item * Tim Bunce =item * John Scoles =item * Yanick Champoux =item * Martin J. Evans =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 1994 by Tim Bunce. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBD-Oracle-1.74/lib/DBD/Oracle/Troubleshooting/Macos.pod0000644000175000017500000005260112326332111022056 0ustar yanickyanick#PODNAME: DBD::Oracle::Troubleshooting::Macos #ABSTRACT: Tips and Hints to Troubleshoot DBD::Oracle on MacOs __END__ =pod =encoding UTF-8 =head1 NAME DBD::Oracle::Troubleshooting::Macos - Tips and Hints to Troubleshoot DBD::Oracle on MacOs =head1 VERSION version 1.74 =head1 General Info These instructions allow for the compilation and successful testing of DBD::Oracle on MacOS X 10.2.4 and higher, using Oracle 9iR2 DR (Release 9.2.0.1.0) or the 10g Instant Client release (10.1.0.3 at the time of writing). MacOS X DBD::Oracle has been tested (and used) under Jaguar (10.2.x), Panther (10.3.x), Snow Leopard (10.6.x), Lion (10.7.x). Jaguar comes with a Perl version of 5.6.0., which I can report to work with DBD::Oracle 1.14 and higher once you take certain steps (see below). You may want to install a later perl, e.g., Perl 5.8.x. Please refer to: Installing Perl 5.8 on Jaguar http://developer.apple.com/internet/macosx/perl.html for Perl 5.8.0 installation instructions. DBD::Oracle is likely to not install out of the box on MacOS X 10.2. nor on 10.3. Manual but different changes will most likely be required on both versions. The key problem on 10.2. (Jaguar) is a symbol clash (caused by a function poll() named identically) between the IO library in at least Perl 5.6.0 (which is the version that comes with 10.2) and the Oracle client library in 9iR2 developer's release for MacOS X. The symptom is that your build appears to compile fine but then fails in the link stage. If you are running a (possibly self-installed) version of Perl other than 5.6.0, there's a chance that you are not affected by the symbol clash. So, try to build first without any special measures, and only resort to the instructions below if your build fails in the link stage with a duplicate symbol error. Note: if it fails to even compile, solve that problem first since it is not due to the symbol clash. The key problem on 10.3 (Panther) is that the default perl that comes with the system is compiled with multi-threading turned on, which at least with the 9iR2 developer's release exposes a memory leak. Your DBD::Oracle build will compile, test, and install fine, but if you execute the same prepared statement multiple times, the process will quickly run up hundreds of megabytes of RAM, and depending on how much memory you have it will die sooner or later. Oracle recently released an "Instant Client" for MacOSX 10.3 (Panther), which as far as I can attest has none of the problems above. Since it is also a very compact download (actually, a series of downloads) I highly recommend you install and use the Instant Client if you are on 10.3 (Panther) and you do not intend to run the Oracle database server on your MacOSX box. See below (Instructions for 10.3.x) for details. =head1 Instructions for 10.7.x (Lion) Perl on Lion and later is built with 64-bit support, and therefore requires the 64-bit Instant Client. As of this writing, only Instant Client 11.2 (64-bit) actually works. The 64-bit Instant Client 10.2 is L. We therefore recommend the 11.2 client. If you must Instant Client 10.2, you may need to recompile Perl with 32-bit support. Either way, setup and configuration is the same: =over =item * Download and install the basic, sqlplus, and sdk instantclient libraries and install them in a central location, such as F. L =item * Create a symlink from F to F: cd /usr/oracle_instantclient/ ln -s libclntsh.dylib.* libclntsh.dylib ln -s libocci.dylib.* libocci.dylib =item * Update your environment to point to the libraries: export ORACLE_HOME=/usr/oracle_instantclient export DYLD_LIBRARY_PATH=$DYLD_LIBRARY_PATH:/usr/oracle_instantclient =item * You should now be able to install DBD::Oracle from CPAN: cpan DBD::Oracle =back =head1 Instructions for 10.6.x (Snow Leopard) These are taken from a stackoverflow answer by "nickisfat" who gave his/her permission for its inclusion here. You can see the original question and answers at http://stackoverflow.com/questions/5964999. Getting a mac install of perl to play nicely with oracle is a bit of a pain - once it's running it is fantastic, getting it running is a little frustrating.. The below has worked for me on a few different intel macs, there could well be superfluous steps in there and it is likely not going to be the same for other platforms. This will require use of shell, the root user and a bit of CPANing - nothing too onerous First off create a directory for the oracle pap - libraries, instant client etc sudo mkdir /usr/oracle_instantClient64 Download and extract all 64 bit instant client packages from oracle to the above directory Create a symlink within that directory for one of the files in there sudo cd /usr/oracle_instantClient64 sudo ln -s /usr/oracle_instantClient64/libclntsh.dylib.10.1 libclntsh.dylib The following dir is hardcoded into the oracle instant client - god knows why - so need to create and symlink it sudo mkdir -p /b/227/rdbms/ sudo cd /b/227/rdbms/ sudo ln -s /usr/oracle_instantClient64/ lib Need to add a couple of environment variables, so edit /etc/profile and add them so they exist for all users: export ORACLE_HOME=/usr/oracle_instantClient64 export DYLD_LIBRARY_PATH=/usr/oracle_instantClient64 Now try and install DBD::Oracle through CPAN - this will fail, but it means any dependencies will be downloaded and it retrieves the module for us sudo perl -MCPAN -e shell install DBD::Oracle When this fails exit CPAN and head to your .cpan/build dir - if you used automatic config of CPAN it'll be cd ~/.cpan/build if you didn't auto configure you can find your build directory with the following command in CPAN o conf build_dir Once in the build dir look for the DBD::Oracle dir which has just been created (it'll be called something like DBD-Oracle-1.28-?) and cd into it. Now we need to switch to the root user. Root isn't enabled as default in osx - for details on enabling see this post on the apple website Once logged in as root we need to set the above environment variables for root: export ORACLE_HOME=/usr/oracle_instantClient64 export DYLD_LIBRARY_PATH=/usr/oracle_instantClient64 Now while still logged in as root we need to run the makefile for the module, then make, then install perl Makefile.pl make install Assuming that all worked without error log out of root: we're DBD'd up! If this didn't work it's time to bust out google on whatever errors you're seeing Now just to install the DBI module sudo perl -MCPAN -e shell install DBI Now you're all set - enjoy your perly oracley new life =head1 Instructions for 10.2.x (Jaguar) 1) Install Oracle exactly per Oracle documentation. If you change install locations, then you'll need to modify paths accordingly. 2) There are two ways to remedy the symbol clash. Either edit the symbol table of the Oracle client library $ORACLE_HOME/lib/libclntsh.dylib.9.0 such that the symbol _poll is no longer exported. Alternatively, download, patch, and re-install the perl IO modules. I could not successfully repeat the report for the former, but I did succeed by doing the latter. Instructions for both follow nonetheless. 2a) SKIP IF YOU WANT TO OR HAVE SUCCESSFULLY TRIED 2b). Make a backup copy of the $ORACLE_HOME/lib/libclntsh.dylib.9.0 file, or the file this name points to, since we're about to modify that library. Note that the ".9.0" suffix of the file name is version dependent, and that you want to work with the file pointed to through one or a series of symbolic links rather than any of the symbolic links (e.g., one will be called libclntsh.dylib). As user 'oracle' execute the following command to fix namespace collisions in Oracle's dynamic libraries. nmedit -R ./hints/macos_lib.syms $ORACLE_HOME/lib/libclntsh.dylib.9.0 *** Recall the above caveats regarding the file name. The problem with this is that the version of nm that comes with Jaguar doesn't support the -R flag. I'd be grateful to anyone who can suggest how to edit the symbol table of libraries on MacOS X. 2b) SKIP IF YOU WANT TO OR HAVE SUCCESSFULLY TRIED 2a). In this variant, we will patch the Perl IO modules to change the name of the poll() function, as that is where it is defined. In this case, we do not need to do anything with the Oracle libraries. Follow these steps: - Download the module IO (IO.pm) from CPAN and unpack it. Check the documentation as to whether the version is compatible with your version of Perl; I used v1.20 with Perl 5.6.0 and had success. - The files IO.xs, poll.c, and poll.h need to be patched. Apply the following patches, e.g., by cutting and pasting the marked section into a file perlio.patch and using that file as input for patch: $ patch -p0 < perlio.patch The patch will basically rename the C implementation of poll() to io_poll(). The other patches were necessary to make v1.20 compile with Perl 5.6.0; they may not be necessary with other versions of IO and Perl, respectively. +=+=+=+=+=+=+= Cut after this line diff -c ../IO-orig/IO-1.20/IO.xs ./IO.xs *** ../IO-orig/IO-1.20/IO.xs Mon Jul 13 23:36:24 1998 --- ./IO.xs Sat May 10 15:20:02 2003 *************** *** 205,211 **** ST(0) = sv_2mortal(newSVpv((char*)&pos, sizeof(Fpos_t))); } else { ! ST(0) = &sv_undef; errno = EINVAL; } --- 205,211 ---- ST(0) = sv_2mortal(newSVpv((char*)&pos, sizeof(Fpos_t))); } else { ! ST(0) = &PL_sv_undef; errno = EINVAL; } *************** *** 249,255 **** SvREFCNT_dec(gv); /* undo increment in newRV() */ } else { ! ST(0) = &sv_undef; SvREFCNT_dec(gv); } --- 249,255 ---- SvREFCNT_dec(gv); /* undo increment in newRV() */ } else { ! ST(0) = &PL_sv_undef; SvREFCNT_dec(gv); } *************** *** 272,278 **** i++; fds[j].revents = 0; } ! if((ret = poll(fds,nfd,timeout)) >= 0) { for(i=1, j=0 ; j < nfd ; j++) { sv_setiv(ST(i), fds[j].fd); i++; sv_setiv(ST(i), fds[j].revents); i++; --- 272,278 ---- i++; fds[j].revents = 0; } ! if((ret = io_poll(fds,nfd,timeout)) >= 0) { for(i=1, j=0 ; j < nfd ; j++) { sv_setiv(ST(i), fds[j].fd); i++; sv_setiv(ST(i), fds[j].revents); i++; diff -c ../IO-orig/IO-1.20/poll.c ./poll.c *** ../IO-orig/IO-1.20/poll.c Wed Mar 18 21:34:00 1998 --- ./poll.c Sat May 10 14:28:22 2003 *************** *** 35,41 **** # define POLL_EVENTS_MASK (POLL_CAN_READ | POLL_CAN_WRITE | POLL_HAS_EXCP) int ! poll(fds, nfds, timeout) struct pollfd *fds; unsigned long nfds; int timeout; --- 35,41 ---- # define POLL_EVENTS_MASK (POLL_CAN_READ | POLL_CAN_WRITE | POLL_HAS_EXCP) int ! io_poll(fds, nfds, timeout) struct pollfd *fds; unsigned long nfds; int timeout; diff -c ../IO-orig/IO-1.20/poll.h ./poll.h *** ../IO-orig/IO-1.20/poll.h Wed Apr 15 20:33:02 1998 --- ./poll.h Sat May 10 14:29:11 2003 *************** *** 44,50 **** #define POLLHUP 0x0010 #define POLLNVAL 0x0020 ! int poll _((struct pollfd *, unsigned long, int)); #ifndef HAS_POLL # define HAS_POLL --- 44,50 ---- #define POLLHUP 0x0010 #define POLLNVAL 0x0020 ! int io_poll _((struct pollfd *, unsigned long, int)); #ifndef HAS_POLL # define HAS_POLL +=+=+=+=+=+=+= Cut to the previous line - compile and install as you usually would, making sure that existing but conflicting modules get removed: $ perl Makefile.PL $ make $ make test $ make install UNINST=1 - You are done. Continue with 3). 3) Install the module DBI as per its instructions, if you haven't already done so. 4) Install the DBD::Oracle module. $ perl Makefile.PL $ make $ make test $ make install =head1 Instructions for 10.3.x (Panther) I highly recommend you install and use the Oracle 10g Instant Client for MacOSX 10.3. Compared to traditional Oracle client installations it is a very compact download, and it has the memory leak problem fixed. As an added benefit, you will be able to seamlessly connect to 10g databases. Even if you do want to run the database server included in the 9iR2 Developer's Release, I'd still use the Instant Client for compiling OCI applications or drivers like DBD::Oracle. If you still decide to use the full 9iR2 DR client, and if all you use DBD::Oracle for on MacOSX is development and test scripts that don't involve running the same query multiple times or many queries within the same perl process, then note that the memory leak will most likely never affect you in a serious way. In this case you may not need to bother and instead just go ahead, build and install DBD::Oracle straightforwardly without any special measures. That said, here are the details. 0) (If you decided for the 9iR2 DR client, skip to 1.) If you decided to use the 10g Instant Client, make sure you download and install all parts. (Given that this is perl land you may not need the JDBC driver, but why bother sorting out the 25% you may or may not ever need.) Follow the Oracle instructions and copy the contents of each part into the same destination directory. Change to this destination directory and create a symlink lib pointing to '.' (without the quotes): $ cd $ ln -s lib . Also, set the environment variable ORACLE_HOME to the path to your instantclient destination directory. Makefile.PL needs it. Now return to your DBD::Oracle download. If the version is 1.16 or less you will need to patch Makefile.PL; in later versions this may be fixed already. Apply the following patch, e.g., by cutting and pasting into a file Makefile.PL.patch and then executing $ patch -p0 < Makefile.PL.patch Here is the patch: +=+=+=+=+=+=+= Cut after this line *** Makefile.PL.orig Fri Oct 22 02:07:04 2004 --- Makefile.PL Fri May 13 14:28:53 2005 *************** *** 1252,1257 **** --- 1252,1258 ---- print "Found $dir/$_\n" if $::opt_d; }, "$OH/rdbms", "$OH/plsql", # oratypes.h sometimes here (eg HPUX 11.23 Itanium Oracle 9.2.0) + "$OH/sdk", # Oracle Instant Client default location (10g) ); @h_dir = keys %h_dir; print "Found header files in @h_dir.\n" if @h_dir; *************** *** 1286,1292 **** --- 1287,1297 ---- open FH, ">define.sql" or warn "Can't create define.sql: $!"; print FH "DEFINE _SQLPLUS_RELEASE\nQUIT\n"; close FH; + # we need to temporarily disable login sql scripts + my $sqlpath = $ENV{SQLPATH}; + delete $ENV{SQLPATH}; my $sqlplus_release = `$sqlplus_exe -S /nolog \@define.sql 2>&1`; + $ENV{SQLPATH} = $sqlpath if $sqlpath; unlink "define.sql"; print $sqlplus_release; if ($sqlplus_release =~ /^DEFINE _SQLPLUS_RELEASE = "(\d?\d)(\d\d)(\d\d)(\d\d)(\d\d)"/) { +=+=+=+=+=+=+= Cut to the previous line The first hunk allows Makefile.PL to find the header files which are in a subdirectory sdk, and the second temporarily disables any global and local login.sql scripts which may make the sqlplus call fail. If you don't have a local login.sql script you will most likely be fine without the second hunk. Now run Makefile.PL and make sure you provide the -l flag: $ perl Makefile.PL -l If you receive some ugly error message stating that some *.mk file couldn't be found you forgot to add the -l flag. The continue the standard build process by running make. In DBD::Oracle versions 1.16 and earlier this will end in an error due to a failed execution of nmedit -R. Ignore this error. Move on to running the tests, making sure the test scripts can log in to your database (e.g., by setting ORACLE_USERID). Note that by default the Instant Client does not have a network/admin/tnsnames.ora installed. Either install a suitable one, or point TNS_ADMIN to the directory where you keep your tnsnames.ora, or include the full SQLNET connection string in ORACLE_USERID. All three options are documented by Oracle in the README_IC.htm file that comes with the Instant Client, so be sure you read it if you don't understand what I'm writing here. All tests should succeed. Complete by make install. You are done! Skip the other steps below, they do NOT apply to the Instant Client. (Although of course you may still install a later version of perl if you have the need.) 1) Until the reason for the memory leak has been found and fixed, you need to remove the condition that exposes it. Apparently, this is multi-threading being enabled in Perl. The Perl 5.8.1RC3 that comes with Panther was compiled with multi-threading enabled, and AFAIK it cannot be turned off at runtime. Note that the problem is independent of whether you run multiple concurrent threads or not. Therefore, the solution is to build your own perl. I leave it up to you whether you want to replace the system perl or not. At least Perl 5.8.x comes with instructions as to how to replace the system perl on MacOS X, and what the caveats and risks are. I used 5.8.4, installed in /usr/local, and it worked perfectly fine. The key when configuring your custom build of perl is to disable multi-threading (usethreads, useithreads, and usemultiplicity options). More precisely, do not enable them, as they are disabled by default, at least up to version 5.8.5. You can check whether threads are enabled or not by passing -V to ther Perl interpreter: $ /path/to/your/perl -V | grep usethreads You need to see a line saying, among other things, usethreads=undef. If you see usethreads=define then multi-threading is enabled. 2) If you choose not to replace the system perl, make sure that when you build DBI and DBD::Oracle you provide the full path to your own perl when running Makefile.PL, like so (assuming you installed in /usr/local, which is the default): $ /usr/local/bin/perl Makefile.PL Also, every time you run a DBD::Oracle script, you must use the full path too, unless your custom-built perl comes before the system perl in the PATH environment. The easiest way to ensure you are using the right perl is to uninstall DBI from the system perl if you did install it under that as well. 3) Continue with 3) as in instructions for Jaguar (making path substitutions for perl as discussed in 2). ====================================================================== If you have any problems then follow the instructions in the README. Please post details of any problems (or changes you needed to make) to dbi-users@perl.org and CC them to brooksch@mac.com on MacOSX specific problems. Rewrite of part of this readme, Panther instructions, and the Perl IO patch is credit to Hilmar Lapp, hlapp at gmx.net. Earlier and original instructions thanks to: Andy Lester Steve Sapovits Tom Mornini Date: Tue, 15 Apr 2003 16:02:17 +1000 Subject: Compilation bug in DBI on OSX with threaded Perl 5.8.0 From: Danial Pearce In regards to a previous message on this list: http://archive.develooper.com/dbi-users@perl.org/msg16365.html I have some more info: I have compiled and installed Perl just fine with threads enabled: ./Configure -de -Dusethreads -Dprefix=/usr make make test sudo make install I have then successfully installed Apache and mod_perl as well. When I try to compile and install DBI, I get a bus error, just like the people on this list have previously discussed on the thread above. If I unpack the DBI, and run perl Makefile.pl, then alter the created Makefile so that it uses gcc2 rather than just "cc" then it compiles, installs and runs just fine. The issue here is that Apple have just recently release 10.2.4, which updates /usr/bin/{gcc3,gcc2,g++3,g++2} and /usr/bin/cc is a symlink to /usr/bin/gcc3, so compilation of DBI under Apple's gcc3 does not work. It works find with gcc2 however. I had the same problem with DBD::Pg, and was able to compile and install that using the same fix. I am unsure if this is a problem with Apple's version of gcc, or a problem with the DBI/DBD code itself. Given that all my other open source applications are compiling and installing fine, I am thinking there isn't anything Apple are going to do about it. cheers Danial =head1 AUTHORS =over 4 =item * Tim Bunce =item * John Scoles =item * Yanick Champoux =item * Martin J. Evans =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 1994 by Tim Bunce. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBD-Oracle-1.74/lib/DBD/Oracle/Troubleshooting/Linux.pod0000644000175000017500000001265412326332111022117 0ustar yanickyanick#PODNAME: DBD::Oracle::Troubleshooting::Linux #ABSTRACT: Tips and Hints to Troubleshoot DBD::Oracle on Linux __END__ =pod =encoding UTF-8 =head1 NAME DBD::Oracle::Troubleshooting::Linux - Tips and Hints to Troubleshoot DBD::Oracle on Linux =head1 VERSION version 1.74 =head1 SELinux and httpd If SELinux is running, it can prevents DBD::Oracle running in an Apache process to load shared libraries it requires (libclntsh.so or libnnz12.so). A typical symptom is a line like the following in the Apache error logs: [Tue Apr 17 13:22:45 2012] [error] Can't load '.../DBD/Oracle/Oracle.so' for module DBD::Oracle: libnnz11.so: cannot enable executable stack as shared object requires: Permission denied at .../DynaLoader.pm line 190.\n at .../startup.pl line 17\nCompilation failed in require at ... The fix: /usr/sbin/setsebool -P httpd_execmem =head1 Installing with Instantclient .rpm files. Nothing special with this you just have to set up you permissions as follows; 1) Have permission for RWE on '/usr/lib/oracle/10.2.0.3/client/' or the other directory where you RPMed to 2) Set export ORACLE_HOME=/usr/lib/oracle/10.2.0.3/client 3) Set export LD_LIBRARY_PATH=$ORACLE_HOME/lib 4) If you plan to use tnsnames to connect to remote servers and your tnsnames.ora file is not in $ORACLE_HOME/network/admin, you will need to Export TNS_ADMIN=dir to point DBD::Oracle to where your tnsnames.ora file is =head1 undefined symbol: __cmpdi2 comes up when Oracle isn't properly linked to the libgcc.a library. In version 8, this was corrected by changing the SYSLIBS entry in $ORACLE_HOME/bin/genclntsh to include "-L/usr/lib/gcc-lib/i386-redhat-linux/3.2 -lgcc". I had tried this with no success as when this program was then run, the error "unable to find libgcc" was generated. Of course, this was the library I was trying to describe! It turns out that now it is necessary to edit the same file and append "`gcc -print-libgcc-file-name`" (including the backquotes!). If you do this and then run "genclntsh", the libclntsh is properly generated and the linkage with DBD::Oracle proceeds properly. =head1 cc1: invalid option `tune=pentium4'" error If you get the above it seems that either your Perl or OS where compiled with a different version of GCC or the GCC that is on your system is very old. No real problem with the above however you will have to 1) run Perl Makefile.PL 2) edit the Makefile and remove the offending '-mtune=pentium4' text 3) save and exit 4) do the make install and it should work fine for you =head1 Oracle 9i Lite The advice is to use the regular Oracle9i not the lite version. Another great source of help was: http://www.puschitz.com/InstallingOracle9i.html just getting 9i and 9i lite installed. I use fvwm2(nvidia X driver) as a window manager which does not work with the 9i install program, works fine with the default Gnomish(nv X driver), it could have been the X driver too. With Redhat9 it is REAL important to set LD_ASSUME_KERNEL to 2.4.1. I didn't try this but it may be possible to install what is needed by only downloading the first disk saving some 1.3GB of download fun. I installed a custom install from the client group. The packages I installed are the Programmers section and sqlplus. I noticed that the Pro*C when on as a result of the checking the Programmers section I assume. Once Oracle was installed properly the DBD::Oracle install went as smooth as just about every other CPAN module. =head1 Oracle 10g Instantclient The Makefile.PL will now work for Oracle 10g Instantclient. To have both the Compile and the test.pl to work you must first have the LD_LIBRARY_PATH correctly set to your "instantclient" directory. (http://www.oracle.com/technology/tech/oci/instantclient/instantclient.html) The present version of the make creates a link on your "instantclient" directory as follows "ln -s libclntsh.so.10.1 libclntsh.so". It is needed for both the makefile creation and the compile but is not need for the test.pl. It should be removed after the compile. If the Makefile.PL or make fails try creating this link directly in your "instantclient" directory. =head1 Oracle Database 10g Express Edition 10.2 To get 10Xe to compile correctly I had to add $ORACLE_HOME/lib to the LD_LIBRARY_PATH as you would for an install against 10g Standard Edition, Standard Edition One, or Enterprise Edition =head1 UTF8 bug in Oracle 9.2.0.5.0 and 9.2.0.7.0 DBD::Oracle seems to hit some sort of bug with the above two versions of DB. The bug seems to hit when you when the Oracle database charset: US7ASCII and the Oracle nchar charset: AL16UTF16 and it has also been reported when the Oracle database charset: WE8ISO8850P1 Oracle nchar charset: AL32UTF16. So far there is no patch for this but here are some workarounds use DBD::Oracle qw( SQLCS_IMPLICIT SQLCS_NCHAR ); ... $sth->bind_param(1, $value, { ora_csform => SQLCS_NCHAR }); or this way $dbh->{ora_ph_csform} = SQLCS_NCHAR; # default for all future placeholders or this way utf8::downgrade($parameter, 1); =head1 AUTHORS =over 4 =item * Tim Bunce =item * John Scoles =item * Yanick Champoux =item * Martin J. Evans =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 1994 by Tim Bunce. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBD-Oracle-1.74/lib/DBD/Oracle/Troubleshooting/Cygwin.pod0000644000175000017500000000460612326332111022256 0ustar yanickyanick#PODNAME: DBD::Oracle::Troubleshooting::Cygwin #ABSTRACT: Tips and Hints to Troubleshoot DBD::Oracle on Cygwin __END__ =pod =encoding UTF-8 =head1 NAME DBD::Oracle::Troubleshooting::Cygwin - Tips and Hints to Troubleshoot DBD::Oracle on Cygwin =head1 VERSION version 1.74 =head1 General Info Makefile.PL should find and make use of OCI include files, but you have to build an import library for OCI.DLL and put it somewhere in library search path. one of the possible ways to do this is issuing command dlltool --input-def oci.def --output-lib liboci.a in the directory where you unpacked DBD::Oracle distribution archive. this will create import library for Oracle 8.0.4. Note: make clean removes '*.a' files, so put a copy in a safe place. =head1 Compiling DBD::Oracle using the Oracle Instant Client, Cygwin Perl and gcc =over =item 1 Download these two packages from Oracle's Instant Client for Windows site (http://www.oracle.com/technology/software/tech/oci/instantclient/htdocs/winsoft.html): Instant Client Package - Basic: All files required to run OCI, OCCI, and JDBC-OCI applications Instant Client Package - SDK: Additional header files and an example makefile for developing Oracle applications with Instant Client (I usually just use the latest version of the client) =item 2 Unpack both into C:\oracle\instantclient_11_1 =item 3 Download and unpack DBD::Oracle from CPAN to some place with no spaces in the path (I used /tmp/DBD-Oracle) and cd to it. =item 4 Set up some environment variables (it didn't work until I got the DSN right): ORACLE_DSN=DBI:Oracle:host=oraclehost;sid=oracledb1 ORACLE_USERID=username/password =item 5 perl Makefile.PL make make test make install =back Note, the TNS Names stuff doesn't always seem to work with the instant client so Perl scripts need to explicitly use host/sid in the DSN, like this: my $dbh = DBI->connect('dbi:Oracle:host=oraclehost;sid=oracledb1', 'username', 'password'); =head1 AUTHORS =over 4 =item * Tim Bunce =item * John Scoles =item * Yanick Champoux =item * Martin J. Evans =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 1994 by Tim Bunce. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBD-Oracle-1.74/lib/DBD/Oracle/Troubleshooting/Win64.pod0000644000175000017500000001777212326332111021735 0ustar yanickyanick#PODNAME: DBD::Oracle::Troubleshooting::Win64 #ABSTRACT: Tips and Hints to Troubleshoot DBD::Oracle on Win64 __END__ =pod =encoding UTF-8 =head1 NAME DBD::Oracle::Troubleshooting::Win64 - Tips and Hints to Troubleshoot DBD::Oracle on Win64 =head1 VERSION version 1.74 =head1 DBD::Oracle and Windows 64bit I have successfully compiled and installed DBD::Oracle on Windows 2008 server 64bit operating system today. I used the latest version of DBD::Oracle 1.24 version 11.2.0.1.0 for 64bit windows of Oracle's Instant Client Package - Basic along with the Instant Client Package - SQL*Plus and finally the Instant Client Package - SDK. To get it to Make and compile correctly I had to download Microsoft's Visual Studio Ultimate which should contain all the files you need. It is rather portly at 2+gb so you might want to grab lunch while you are downloading it. After all the above downloading DBB::Oracle installed right out of the box. All one has to do is select 'Start Menu->All Programs->Microsoft Visual Studio 2010->Visual Studio Tools->Visual Studio x64 Win64 Command Prompt (2010)' which will open a good old 'dos' window. At this point CD to the directory where you downloaded DBD::Oracle c:\DBD-Oracle> then set your 'ORACLE_HOME to the Instant Client directory c:\DBD-Oracle>set ORACLE_HOME=c:\IC_11 you should also set your NLS like this c:\DBD-Oracle>set NLS_LANG=.WE8ISO8859P15 Once the above setting are done do a c:\DBD-Oracle>perl Makefile.PL and then a c:\DBD-Oracle>nmake install Which will produce a whole of warnings (the make you can ignore them for now as they do not seem to effect DBD::Oracle at all) and near the end it should output something like this; Generating code Finished generating code if exist blib\arch\auto\DBD\Oracle\Oracle.dll.manifest mt -nologo -manifest blib\arch\auto\DBD\Oracle\Oracle.dll.manifest -outputresource:blib\arch\auto \DBD\Oracle\Oracle.dll;2 if exist blib\arch\auto\DBD\Oracle\Oracle.dll.manifest del blib\arch\auto\DBD\Oracle\Oracle.dll.manifest C:\Perl64\bin\perl.exe -MExtUtils::Command -e "chmod" -- 755 blib\arch\auto\DBD\Oracle\Oracle.dll C:\Perl64\bin\perl.exe -MExtUtils::Command -e "cp" -- Oracle.bs blib\arch\auto\DBD\Oracle\Oracle.bs C:\Perl64\bin\perl.exe -MExtUtils::Command -e "chmod" -- 644 blib\arch\auto\DBD\Oracle\Oracle.bs C:\Perl64\bin\perl.exe "-Iblib\arch" "-Iblib\lib" ora_explain.PL ora_explain Extracted ora_explain from ora_explain.PL with variable substitutions. C:\Perl64\bin\perl.exe -MExtUtils::Command -e "cp" -- ora_explain blib\script\ora_explain pl2bat.bat blib\script\ora_explain At this point you are all done. Well almost It is important that you test your code before you install but you will have to set a few things up to get it to fully test correctly You will need a TNSNAMES.ORA file that points to a valid DB in the Instant Client Directory Next you will need to set the ORACLE_USER_ID to a valid user c:\DBD-Oracle>set ORACLE_USER_ID=system/system@XE You will have to set up TNS_ADMIN to point to the Instant Client Directory c:\DBD-Oracle>set TNS_ADMIN=c:\IC_11 Most importantly you will have to add the Instant Client directory to your path like this c:\DBD-Oracle>path = c:\IC_11;%path% If you do not do this step you will run into the dreaded Can't load 'C:/Perl/lib/auto/DBD/Oracle/Oracle.dll' for module DBD::Oracle: load_file:%1 is not a valid Win32 application at C:/Perl/lib/DynaLoader.pm line 202. Error later on after the compile when you try to use DBD::Oracle. What is actually going on is that Perl cannot find oci.dll (or one of the other .dlls it needs to run) the 'C:/Perl/lib/auto/DBD/Oracle/Oracle.dll' and the DynaLoader error are just a false trails. For more info on this check out this page Oracle Troubleshooter' by Alexander Foken. It is rather dated but the facts of why perl did not find a dll are still valid. now you can do this c:\DBD-Oracle>nmake test and all the tests should run and it will report Finally simple do a c:\DBD-Oracle>nmake install and you are all set That is about it. At this point you might want to add the Instant Client directory permanently to your path so you will not run into the Dynaloader error again. In general compiling DBD:Oracle for 64 bit machines has been a hit or miss operation. The main thing to remember is you will have to compile using 32 bit Perl and compile DBD::Oracle against a 32bit client which sort of defeats the purpose of having a 64bit box. So until 64bit Perl comes out we will be posing in this README any success stories we have come across -------- Original Message -------- From: Alex Buttery, OCA, MCTS Director, Database Architecture and Operations Impact Rx, Inc. I needed to get perl working on a 64-bit Windows Server so I got creative. Since I was unable to build DBD::Oracle on the Windows Server (even with Visual Studio 6 installed), I decided that I would try another approach. Here are the steps I took to get it working (yes, this is a hack and I'm not even sure that it does not violate someone's license agreements but I'm not going to be asking anyone else to support this configuration). Step 1: Install 32-bit Perl 5.8.8 from Activestate on the Server to the C: drive. Step 2: Install the 32-bit Oracle client on the server (I'm assuming the 64-bit client has already been installed and is working) to the c:\oracle\product\10.2.0\client32 directory in the OraHome_Client32 Home. Step 3: Locate Oracle.dll in the new Oracle Home directory, it should be located somewhere close to c:\oracle\product\10.2.0\client32\perl\site\5.8.3\MSWin32-x86-multi-thread\auto\DBD\Oracle. Step 4: Locate Oracle.dll in the Perl 5.8.8 directory. (C:\Perl) It should be somewhere close to c:\Perl\site\lib\auto\DBD\Oracle. Step 5: Copy the contents of the Oracle directory found in Step 3 to the Perl directory found in Step 4. Step 6: Copy GetInfo.pm from C:\oracle\product\10.2.0\client32\perl\site\5.8.3\lib\MSWin32-x86-multi-thread\DBD\Oracle to C:\Perl\site\lib\DBD\Oracle Step 7: Locate Oracle.pm in the new Oracle Home directory, it should be located somewhere close to c:\oracle\product\10.2.0\client32\perl\site\5.8.3\MSWin32-x86-multi-thread\auto\DBD. Step 8: Locate Oracle.pm in the Perl 5.8.8 directory. (C:\Perl) It should be somewhere close to c:\Perl\site\lib\auto\DBD. Step 9: Copy Oracle.pm from the Oracle directory found in Step 7 to the Perl directory found in Step 8. Step 10: Set up required ODBC connections using the 32-bit ODBC applet (odbcad32.exe) located in the C:\Windows\SysWOW64 directory. Note: The ODBC applet in the Administrative Tools menu points to the odbcad32.exe located in the C:\Windows\system32 directory and is actually the 64 bit version of the ODBC applet This cannot be used by Perl Step 11: Create batch scripts to run Perl programs and include the following SET statements to point Perl to the correct Oracle Home: SET ORACLE_HOME=c:\oracle\product\10.2.0\client32 <== 32-bit Oracle Home SET ORACLE_SID=xyz123 <== SID of Production Database SET NLS_LANG=.WE8ISO8859P1 <== Default Language from Database (preceding "." Is required) SET PATH=%ORACLE_HOME%\bin;%PATH% <== Add 32-bit Oracle Home to beginning of default PATH =head1 AUTHORS =over 4 =item * Tim Bunce =item * John Scoles =item * Yanick Champoux =item * Martin J. Evans =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 1994 by Tim Bunce. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBD-Oracle-1.74/lib/DBD/Oracle/Troubleshooting.pod0000644000175000017500000001152312326332111021012 0ustar yanickyanick#PODNAME: DBD::Oracle::Troubleshooting #ABSTRACT: Tips and Hints to Troubleshoot DBD::Oracle __END__ =pod =encoding UTF-8 =head1 NAME DBD::Oracle::Troubleshooting - Tips and Hints to Troubleshoot DBD::Oracle =head1 VERSION version 1.74 =head1 CONNECTING TO ORACLE If you are reading this it is assumed that you have successfully installed DBD::Oracle and you are having some problems connecting to Oracle. First off you will have to tell DBD::Oracle where the binaries reside for the Oracle client it was compiled against. This is the case when you encounter a DBI connect('','system',...) failed: ERROR OCIEnvNlsCreate. error in Linux or in Windows when you get OCI.DLL not found The solution to this problem in the case of Linux is to ensure your 'ORACLE_HOME' (or LD_LIBRARY_PATH for InstantClient) environment variable points to the correct directory. export ORACLE_HOME=/app/oracle/product/xx.x.x For Windows the solution is to add this value to you PATH PATH=c:\app\oracle\product\xx.x.x;%PATH% If you get past this stage and get a ORA-12154: TNS:could not resolve the connect identifier specified error then the most likely cause is DBD::ORACLE cannot find your .ORA (F, F, F) files. This can be solved by setting the TNS_ADMIN environment variable to the directory where these files can be found. If you get to this stage and you have either one of the following errors; ORA-12560: TNS:protocol adapter error ORA-12162: TNS:net service name is incorrectly specified usually means that DBD::Oracle can find the listener but the it cannot connect to the DB because the listener cannot find the DB you asked for. =head2 Oracle utilities If you are still having problems connecting then the Oracle adapters utility may offer some help. Run these two commands: $ORACLE_HOME/bin/adapters $ORACLE_HOME/bin/adapters $ORACLE_HOME/bin/sqlplus and check the output. The "Protocol Adapters" should include at least "IPC Protocol Adapter" and "TCP/IP Protocol Adapter". If it generates any errors which look relevant then please talk to your Oracle technical support (and not the dbi-users mailing list). =head2 Connecting using a bequeather If you are using a bequeather to connect to a server on the same host as the client, you might have to add bequeath_detach = yes to your sqlnet.ora file or you won't be able to safely use fork/system functions in Perl. See the discussion at L and L for more gory details. =head1 USING THE LONG TYPES Some examples related to the use of LONG types are available in the C directory of the distribution. =head1 Can't find I I is the shared library composed of all the other Oracle libs you used to have to statically link. libclntsh.so should be in I<$ORACLE_HOME/lib>. If it's missing, try running I<$ORACLE_HOME/lib/genclntsh.sh> and it should create it. Never copy I to a different machine or Oracle version. If DBD::Oracle was built on a machine with a different path to I then you'll need to set an environment variable, typically I, to include the directory containing I. I is typically ignored if the script is running set-uid (which is common in some httpd/CGI configurations). In this case either rebuild with I set to include the path to I or create a symbolic link so that I is available via the same path as it was when the module was built. (On Solaris the command "ldd -s Oracle.so" can be used to see how the linker is searching for it.) =head1 Miscellaneous =head2 Crash with an open connection and Module::Runtime in mod_perl2 See RT 72989 (https://rt.cpan.org/Ticket/Display.html?id=72989) Apache2 MPM Prefork with mod_perl2 will crash if Module::Runtime is loaded, and an Oracle connection is opened through PerlRequire (before forking). It looks like this was fixed in 0.012 of Module::Runtime. =head2 bin_param_inout swapping return values See RT 71819 (https://rt.cpan.org/Ticket/Display.html?id=71819) It seems that in some older versions of Oracle Instant Client (certainly 10.2.0.4.0) when output parameters are bound with lengths greater than 3584 the output parameters can be returned in the wrong placeholders. It is reported fixed in Instant Client 11.2.0.2.0. =head1 AUTHORS =over 4 =item * Tim Bunce =item * John Scoles =item * Yanick Champoux =item * Martin J. Evans =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 1994 by Tim Bunce. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBD-Oracle-1.74/lib/DBD/Oracle/Object.pm0000644000175000017500000000203412326332111016660 0ustar yanickyanickpackage DBD::Oracle::Object; $DBD::Oracle::Object::VERSION = '1.74'; BEGIN { $DBD::Oracle::Object::AUTHORITY = 'cpan:PYTHIAN'; } # ABSTRACT: Wrapper for Oracle objects use strict; use warnings; sub type_name { shift->{type_name} } sub attributes { @{shift->{attributes}} } sub attr_hash { my $self = shift; return $self->{attr_hash} ||= { $self->attributes }; } sub attr { my $self = shift; if (@_) { my $key = shift; return $self->attr_hash->{$key}; } return $self->attr_hash; } 1; __END__ =pod =encoding UTF-8 =head1 NAME DBD::Oracle::Object - Wrapper for Oracle objects =head1 VERSION version 1.74 =head1 AUTHORS =over 4 =item * Tim Bunce =item * John Scoles =item * Yanick Champoux =item * Martin J. Evans =back =head1 COPYRIGHT AND LICENSE This software is copyright (c) 1994 by Tim Bunce. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut DBD-Oracle-1.74/oci.def0000644000175000017500000001407212326332111014007 0ustar yanickyanick; this file was produced from Oracle 8.0.4 OCI.DLL by pexports program ; written by Anders Norlander ; http://www.acc.umu.se/~anorland/gnu-win32/index.html ; ; to make liboci.a run ; dlltool --input-def oci.def --output-lib liboci.a ; LIBRARY OCI.dll EXPORTS OCILobGetChunkSize OCINlsCharSetIdToName OCIAQDeq OCIAQEnq OCIAttrGet OCIAttrSet OCIBindArrayOfStruct OCIBindByName OCIBindByPos OCIBindDynamic OCIBindObject OCIBreak OCICacheFlush OCICacheFlushRefresh OCICacheFree OCICacheGetObjects OCICacheRefresh OCICacheRegister OCICacheUnmark OCICacheUnpin OCICollAppend OCICollAssign OCICollAssignElem OCICollGetElem OCICollMax OCICollSize OCICollTrim OCIDBStartup OCIDBShutdown OCIDateAddDays OCIDateAddMonths OCIDateAssign OCIDateCheck OCIDateCompare OCIDateDaysBetween OCIDateFromText OCIDateLastDay OCIDateNextDay OCIDateSysDate OCIDateToText OCIDateZoneToZone OCIDefineArrayOfStruct OCIDefineByPos OCIDefineDynamic OCIDefineObject OCIDescribeAny OCIDescriptorAlloc OCIDescriptorFree OCIDurationBegin OCIDurationEnd OCIDurationGetParent OCIEnvInit OCIErrorGet OCIHandleAlloc OCIHandleFree OCIInitialize OCIIterCreate OCIIterDelete OCIIterGetCurrent OCIIterInit OCIIterNext OCIIterPrev OCILdaToSvcCtx OCILobAppend OCILobAssign OCILobCharSetForm OCILobCharSetId OCILobCopy OCILobDisableBuffering OCILobEnableBuffering OCILobErase OCILobFileClose OCILobFileCloseAll OCILobFileExists OCILobFileGetName OCILobFileIsOpen OCILobFileOpen OCILobFileSetName OCILobFlushBuffer OCILobGetLength OCILobIsEqual OCILobLoadFromFile OCILobLocatorIsInit OCILobRead OCILobTrim OCILobWrite OCILobWriteAppend OCILogoff OCILogon OCINumberAbs OCINumberAdd OCINumberArcCos OCINumberArcSin OCINumberArcTan OCINumberArcTan2 OCINumberAssign OCINumberCeil OCINumberCmp OCINumberCos OCINumberDiv OCINumberExp OCINumberFloor OCINumberFromInt OCINumberFromReal OCINumberFromText OCINumberHypCos OCINumberHypSin OCINumberHypTan OCINumberIntPower OCINumberIsZero OCINumberLn OCINumberLog OCINumberMod OCINumberMul OCINumberNeg OCINumberPower OCINumberRound OCINumberSetZero OCINumberSin OCINumberSqrt OCINumberSub OCINumberTan OCINumberToInt OCINumberToReal OCINumberToText OCINumberTrunc OCIObjectAlwaysLatest OCIObjectArrayPin OCIObjectCopy OCIObjectExists OCIObjectFlush OCIObjectFlushRefresh OCIObjectFree OCIObjectGetAttr OCIObjectGetInd OCIObjectGetObjectRef OCIObjectGetProperty OCIObjectGetTypeRef OCIObjectIsDirtied OCIObjectIsDirty OCIObjectIsLoaded OCIObjectIsLocked OCIObjectLock OCIObjectMarkDelete OCIObjectMarkDeleteByRef OCIObjectMarkUpdate OCIObjectNew OCIObjectNotAlwaysLatest OCIObjectPin OCIObjectPinCountReset OCIObjectPinTable OCIObjectRefresh OCIObjectSetAttr OCIObjectUnmark OCIObjectUnmarkByRef OCIObjectUnpin OCIParamGet OCIParamSet OCIPasswordChange OCIRawAllocSize OCIRawAssignBytes OCIRawAssignRaw OCIRawPtr OCIRawResize OCIRawSize OCIRefAssign OCIRefClear OCIRefFromHex OCIRefHexSize OCIRefIsEqual OCIRefIsNull OCIRefToHex OCIResultSetToStmt OCISecurityAbortIdentity OCISecurityClosePersona OCISecurityCloseWallet OCISecurityCreateIdentity OCISecurityCreatePersona OCISecurityCreateWallet OCISecurityDeEnvelope OCISecurityDecrypt OCISecurityDestroyWallet OCISecurityEncrypt OCISecurityEncryptExpansion OCISecurityEnvelope OCISecurityFreeIdentity OCISecurityGetIdentity OCISecurityGetProtection OCISecurityHash OCISecurityHashExpansion OCISecurityInitBlock OCISecurityInitialize OCISecurityKeyedHash OCISecurityKeyedHashExpansion OCISecurityOpenPersona OCISecurityOpenWallet OCISecurityPKDecrypt OCISecurityPKEncryptExpansion OCISecurityPurgeBlock OCISecurityRandomBytes OCISecurityRandomNumber OCISecurityRemoveIdentity OCISecurityRemovePersona OCISecurityReuseBlock OCISecuritySeedRandom OCISecuritySetBlock OCISecuritySetProtection OCISecuritySign OCISecuritySignDetExpansion OCISecuritySignDetached OCISecuritySignExpansion OCISecurityStorePersona OCISecurityStoreTrustedIdentity OCISecurityTerminate OCISecurityValidate OCISecurityVerify OCISecurityVerifyDetached OCISecurity_PKEncrypt OCIServerAttach OCIServerDetach OCIServerVersion OCIServerRelease OCISessionBegin OCISessionEnd OCIStmtBindByName OCIStmtBindByPos OCIStmtExecute OCIStmtFetch OCIStmtFetch2 OCIStmtGetBindInfo OCIStmtGetPieceInfo OCIStmtPrepare OCIStmtSetPieceInfo OCIStringAllocSize OCIStringAssign OCIStringAssignText OCIStringPtr OCIStringResize OCIStringSize OCISvcCtxToLda OCITableDelete OCITableExists OCITableFirst OCITableLast OCITableNext OCITablePrev OCITableSize OCITransCommit OCITransDetach OCITransForget OCITransPrepare OCITransRollback OCITransStart OCITypeArrayByName OCITypeArrayByRef OCITypeAttrByName OCITypeAttrNext OCITypeAttrs OCITypeByName OCITypeByRef OCITypeCollElem OCITypeCollExtTypeCode OCITypeCollSize OCITypeCollTypeCode OCITypeElemCharSetForm OCITypeElemCharSetID OCITypeElemDefaultValue OCITypeElemExtTypeCode OCITypeElemFlags OCITypeElemLength OCITypeElemName OCITypeElemNumPrec OCITypeElemNumScale OCITypeElemParamMode OCITypeElemParameterizedType OCITypeElemType OCITypeElemTypeCode OCITypeIterFree OCITypeIterNew OCITypeIterSet OCITypeMethodByName OCITypeMethodEncap OCITypeMethodFlags OCITypeMethodMap OCITypeMethodName OCITypeMethodNext OCITypeMethodOrder OCITypeMethodOverload OCITypeMethodParams OCITypeMethods OCITypeName OCITypeParamByName OCITypeParamByPos OCITypeParamPos OCITypeResult OCITypeSchema OCITypeTypeCode OCITypeVTInit OCITypeVTInsert OCITypeVTSelect OCITypeVersion obindps obndra obndrn obndrv obreak ocan ocibre ocibrn ocibrv ociclo ocicof ocicom ocidefn ocidfn ocidsc ociepacm ocieperr ociepgoe ociepmsg ocierr ociexe ociexn ocifet ocilof ocilon ociope ocirlo ocirol ocisq3 oclose ocof ocom ocon odefin odefinps odescr odessp odsc oerhms oermsg oexec oexfet oexn ofen ofetch oflng ogetpi ognfd olog ologof ologon olon oname onbclr onbset onbtst oopen oopt oparse opinit orlon orol ortgcty osetpi osql3 OCINlsEnvironmentVariableGet OCIEnvNlsCreate OCINlsCharSetNameToId OCILobIsTemporary OCILobFreeTemporary OCILobLocatorAssign OCILobCreateTemporary OCIXMLTypeCreateFromSrc OCIDateTimeToText OCIIntervalToText OCIDateTimeGetTimeZoneOffset OCIPing OCISessionRelease OCISessionPoolDestroy OCISessionPoolCreate OCISessionGet OCISessionPoolDestroy DBD-Oracle-1.74/Makefile.PL0000755000175000017500000021163712326332111014540 0ustar yanickyanick## Makefile.PL for DBD::Oracle - see README file for more information. # Copyright (c) 1994-2006 Tim Bunce. Ireland. # Copyright (c) 2006-2008 John Scoles (The Pythian Group). Canada. use 5.6.0; use strict; use warnings; use ExtUtils::MakeMaker 5.16, qw(&WriteMakefile $Verbose); use Getopt::Long; use Config; use Cwd; use File::Find; use Pod::Usage; # DBI must be installed before we can build a DBD. # For those not using Dynamic loading this means building a # new static perl in the DBI directory by saying 'make perl' # and then using _that_ perl to make this one. use DBI 1.51; use DBI::DBD; # DBD creation tools # Some MakeMaker's forged some FileHandle methods require FileHandle unless defined &FileHandle::new; BEGIN { return unless $^O eq 'VMS'; eval q{ use vmsish; use VMS::Filespec; 1; } or die $@; } my $dbi_arch_dir = dbd_dbi_arch_dir(); my $so = $Config{so}; # typically 'so', 'dylib' on Darwin/OSX my $osvers = $Config{osvers}; $osvers =~ s/^\s*(\d+\.\d+).*/$1/; # drop sub-sub-version: 2.5.1 -> 2.5 my $exe_ext = ($^O eq 'VMS') ? '.pl' : ''; my $BELL = "\a"; # put this here as it might change $| = 1; my %opts = ( NAME => 'DBD::Oracle', VERSION_FROM => 'lib/DBD/Oracle.pm', PREREQ_PM => { "Test::Simple" => 0.90, # actually Test::More pkg in T::S dist "DBI" => 1.51}, OBJECT => '$(O_FILES)', DEFINE => '', DIR => [], clean => { FILES => 'xstmp.c Oracle.xsi dll.base dll.exp sqlnet.log libOracle.def mk.pm DBD_ORA_OBJ.*' }, dist => { DIST_DEFAULT => 'clean distcheck disttest tardist', PREOP => '$(MAKE) -f Makefile.old distdir', COMPRESS => 'gzip -v9', SUFFIX => 'gz', }, META_MERGE => { configure_requires => { "DBI" => '1.51' }, build_requires => {"DBI" => '1.51', "ExtUtils::MakeMaker" => 0, "Test::Simple" => '0.90'}, resources => { bugtracker => { mailto => 'bug-dbd-oracle at rt.cpan.org', web => 'http://rt.cpan.org/Public/Dist/Display.html?Name=DBD-Oracle', }, homepage => 'http://search.cpan.org/dist/DBD-Oracle', repository => { type => 'git', url => 'git://github.com/yanick/DBD-Oracle.git', web => 'http://github.com/yanick/DBD-Oracle/tree', }, }, }, ); my $eumm = $ExtUtils::MakeMaker::VERSION; $eumm =~ tr/_//d; if ($eumm >= 5.43) { $opts{AUTHOR} = 'Tim Bunce (dbi-users@perl.org)'; $opts{ABSTRACT_FROM} = 'lib/DBD/Oracle.pm'; $opts{PREREQ_PM} = { DBI => 1.51 }; $opts{CAPI} = 'TRUE' if $Config{archname} =~ /-object\b/i; } $opts{LICENSE} = 'perl' if $eumm >= 6.3002; $opts{CCFLAGS} = "-P $Config{ccflags}" if $Config{cc} eq 'bcc32'; # force C++ $opts{LINKTYPE} = 'static' if $Config{dlsrc} =~ /dl_none/; my(@MK, %MK, $MK_TEXT, %MK_expanding); # parsed macros from Oracle's makefiles my %mk_target_deps; my %mk_target_rules; =head1 OPTIONS =over =item -b Try to use Oracle's own 'build' rule. Defaults to true. =item -r With I<-b>, use this names build rule (eg -r=build64). =item -m Path to 'oracle.mk' =item -h Path to oracle header files. =item -p Alter preference for oracle.mk. =item -n Oracle .mk macro name to use for library list to link with. =item -c Don't encourage use of shared library. =item -l Try direct-link to libclntsh. =item -g Enable debugging (-g for compiler and linker). =item -s Find a symbol in oracle libs, Don't build a Makefile. =item -S Find a symbol in oracle & system libs, Don't build a Makefile. =item -v Be more verbose. =item -d Much more verbose for debugging. =item -f Include text of oracle's .mk file within generated Makefile. =item -F Force - ignore errors. =item -W Just write a basic default Makefile (won't build). =item -w Enable many gcc compiler warnings. =item -V Force assumption of specified Oracle version If == 8 then we don't use the new OCI_INIT code and we force our emulation of OCILobWriteAppend. =back =cut # Options (rarely needed) # to turn off an option prefix with 'no', ie 'perl Makefile.PL -nob' #$::opt_ic10 = 1; # Build for Oracle 10g instantclient $::opt_b = 1; # try to use Oracle's own 'build' rule $::opt_r = ''; # With -b above, use this names build rule (eg -r=build64) $::opt_m = ''; # path to oracle.mk file to read $::opt_h = ''; # path to oracle header files $::opt_p = ''; # alter preference for oracle.mk $::opt_n = ''; # Oracle .mk macro name to use for library list to link with $::opt_c = 0; # don't encourage use of shared library $::opt_l = 0; # try direct-link to libclntsh $::opt_g = ''; # enable debugging (-g for compiler and linker) $::opt_s = ''; # Find a symbol in oracle libs, Don't build a Makefile $::opt_S = ''; # Find a symbol in oracle & system libs, Don't build a Makefile $::opt_v = 0; # be more verbose $::opt_d = 0; # much more verbose for debugging $::opt_f = 0; # include text of oracle's .mk file within generated Makefile $::opt_F = 0; # force - ignore errors $::opt_W = 0; # just write a basic default Makefile (won't build) $::opt_w = 0; # enable many gcc compiler warnings $::opt_V = 0; # force assumption of specified Oracle version # If == 8 then we don't use the new OCI_INIT code # and we force our emulation of OCILobWriteAppend Getopt::Long::config( qw( no_ignore_case ) ); GetOptions(qw(b! r=s v! d! g! p! l! c! f! F! W! w! m=s h=s n=s s=s S=s V=s )) or die pod2usage( -verbose => 99, -sections => [ 'OPTIONS' ] ); $::opt_g &&= '-g'; # convert to actual string $::opt_v = 1 if $::opt_d; $Verbose = 1 if $::opt_v; my $is_developer = (-d ".svn" && -f "MANIFEST.SKIP"); if ($::opt_W) { open MK_PM, ">/dev/null" or die "Unable to create 'mk.pm': $!"; exit WriteMakefile( dbd_edit_mm_attribs(\%opts) ) } # --- Introduction print qq{ Configuring DBD::Oracle for perl $] on $^O ($Config{archname}) Remember to actually *READ* the README file! Especially if you have any problems. } unless $::opt_s; # --- Where is Oracle installed... my $ORACLE_ENV = ($^O eq 'VMS') ? 'ORA_ROOT' : 'ORACLE_HOME'; my $OH = $ENV{$ORACLE_ENV} || ''; $OH = win32_oracle_home($OH) if ($^O eq 'MSWin32') or ($^O =~ /cygwin/i); $OH = unixify $OH if $^O eq 'VMS'; $OH =~ s:/$::; if (!$OH) { $OH = find_oracle_home() || die qq{ The $ORACLE_ENV environment variable is not set and I couldn\'t guess it. It must be set to hold the path to an Oracle installation directory on this machine (or a machine with a compatible architecture). See the appropriate README file for your OS for more information. ABORTED! \n}; $ENV{$ORACLE_ENV} = $OH; print "\n"; print "WARNING: Setting $ORACLE_ENV env var to $OH for you.\a\n"; print "WARNING: If these tests fail you may have to set ORACLE_HOME yourself!\n"; sleep 5; } -l $OH and $OH = Cwd::abs_path ($OH); # Oracle really dislikes symbolic links die qq{ The $ORACLE_ENV environment variable value ($OH) is not valid. It must be set to hold the path to an Oracle installation directory on this machine (or a machine with a compatible architecture). For an Instant Client install, the directory should include an sdk subdirectory. See the appropriate README file for your OS for more information. ABORTED! } unless (-d $OH and $^O eq 'VMS') or -d "$OH/sdk/." # Instant Client with SDK or -d "$OH/lib/." # normal Oracle installation or glob("$OH/libclntsh.$so*") # pre-sdk instant client or rpm or -e "$OH/oci.dll"; # Windows Instant Client print "Installing on a $^O, Ver#$osvers\n"; print "Using Oracle in $OH\n"; # $client_version => Major.Minor, $client_version_full => Major.Minor.X.Y.Z my ($client_version, $client_version_full) = get_client_version($::opt_V); die "DBD::Oracle no longer supports Oracle client versions before 9.2 \n Try a version before 1.25 for 9 and 1.18 for 8!" if $client_version < 9; check_macos_symbol_table(); symbol_search() if $::opt_s or $::opt_S; # --- How shall we link with Oracle? Let me count the ways... my $mkfile; # primary .mk file to use my @mkfiles; # $mkfile plus any files it 'includes' my $linkwith = ""; my $linkwith_msg = ""; my $need_ldlp_env; if ($^O eq 'VMS') { my $OCIINCLUDE = join " ", vmsify("$OH/rdbms/"), vmsify("$OH/rdbms/public"), vmsify("$OH/rdbms/demo/"), vmsify("$OH/rdbms/demo/oci_demo/"), vmsify("$OH/netconfig/demo/"); # eg nzt.h in 8.1.7 on VMS $opts{INC} = "$OCIINCLUDE $dbi_arch_dir"; $opts{OBJECT} = 'oracle.obj dbdimp.obj oci7.obj oci8.obj' if $] < 5.005; unless ($ENV{PERL_ENV_TABLES}) { print qq{ The logical PERL_ENV_TABLES is not set. This may mean that some of the UTF functionallity tests may fail, and that some logicals may be set in the Oracle Table. To ensure that testing the package only sets logicals in your process table, please set this logical: \$ DEFINE PERL_ENV_TABLES LNM\$PROCESS \a\n}; sleep 3; } } elsif (($^O eq 'MSWin32') or ($^O =~ /cygwin/i)) { my $OCIDIR = ""; find( sub { print "Found $_ directory\n" if /^OCI\d*$/i; $OCIDIR = $_ if /^OCI\d*$/i && $OCIDIR lt $_; $File::Find::prune = 1 if -d $_ && $_ !~ /^\./; }, $OH ); $OCIDIR = 'sdk' if !$OCIDIR && -d "$OH/sdk"; # Instant Client SDK die "OCI directory not found, please install OCI in $OH" if ! $OCIDIR; print "Using OCI directory '$OCIDIR'\n"; if ($Config{cc} =~ /gcc/i) { system("dlltool --input-def oci.def --output-lib liboci.a") if ! -f "liboci.a"; die "Could not find or create liboci.a. See README.wingcc.txt\n" if ! -f "liboci.a"; my $pwd = cwd(); $opts{LIBS} = [ "-L$pwd -loci" ]; } else { my %OCILIB; my $oci_compiler_dir; my @oci_compiler_dirs = map { -d "$OH/$OCIDIR/lib/$_" ? "$OH/$OCIDIR/lib/$_": () } $Config{cc} eq 'bcc32' ? qw(BORLAND BC) : qw(MSVC); find( sub { $File::Find::prune = 1 if -d $_ && $_ !~ /^\./; return unless /^(OCI|ORA).*\.LIB$/i; ($oci_compiler_dir = $File::Find::dir) =~ s:^.*/::; print "Found $OCIDIR/lib/$oci_compiler_dir/$_ library\n"; $OCILIB{uc($_)} = $_; }, @oci_compiler_dirs ); # sort the version numbered libs into assending order my @OCILIB = sort grep { /(OCI|ORA)\d\d+\./i } keys %OCILIB; # prefer the non-versioned library if present push @OCILIB, "OCI.LIB" if $OCILIB{'OCI.LIB'}; my $OCILIB = pop @OCILIB || ''; $OCILIB =~ s/\.LIB$//i; die qq{ Unable to find required Oracle OCI files for the build. Please check that you have your OCI installed in your oracle home ($OH) directory and that it has the following files (and probably more): $OH\\$OCIDIR\\include\\oratypes.h $OH\\$OCIDIR\\lib\\$oci_compiler_dir\\$OCILIB.lib Please install OCI or send comments back to dbi-users\@perl.org if you have an OCI directory other than $OCIDIR. Alternatively, if you\'re using ActiveState perl on Windows try ppm install ftp://ftp.esoftmatic.com/outgoing/DBI/5.8.3/DBI.ppd ppm install ftp://ftp.esoftmatic.com/outgoing/DBI/5.8.3/DBD-Oracle.ppd } unless (-e "$OH/$OCIDIR/include/oratypes.h" && -e "$OH/$OCIDIR/lib/$oci_compiler_dir/$OCILIB.lib") or $::opt_F; print "Using $OCIDIR/lib/$oci_compiler_dir/$OCILIB.lib\n"; $opts{LIBS} = [ "-L$OH/$OCIDIR/LIB/$oci_compiler_dir $OCILIB" ]; }; my $OCIINCLUDE = "-I$OH/$OCIDIR/include -I$OH/rdbms/demo"; $opts{INC} = "$OCIINCLUDE -I$dbi_arch_dir"; } # --- UNIX Variants --- elsif ($::opt_l and # use -l to enable this direct-link approach @_=grep { m:/lib(cl(ie)?ntsh|oracle).\w+$:o } <$OH/lib/lib*> ) { # --- the simple modern way --- foreach(@_) { s:\Q$OH/lib/::g } print "Found direct-link candidates: @_\n"; my $lib = ("@_" =~ m:lib(cl(ie)?ntsh)\.:) ? $1 : "oracle"; my $syslibs = read_sysliblist(); print "Oracle sysliblist: $syslibs\n"; my $libdir = ora_libdir(); $opts{dynamic_lib} = { OTHERLDFLAGS => "$::opt_g" }; my @h_dirs = find_headers(); if ($client_version_full =~ /^8.0.6/ && $^O eq 'hpux') { $linkwith_msg = "-lextp -l$lib."; $opts{LIBS} = [ "-L$OH/$libdir -lextp -l$lib $syslibs" ]; push @h_dirs, "$OH/network/public"; } else { $linkwith_msg = "-l$lib."; $opts{LIBS} = [ "-L$OH/$libdir -l$lib $syslibs" ]; } my $inc = join " ", map { "-I$_" } @h_dirs; $opts{INC} = "$inc -I$dbi_arch_dir"; check_ldlibpthname(); } # --- special case for Oracle 10g instant client (note lack of ../lib/...) elsif (my @libclntsh = glob("$OH/libclntsh.$so*")) { print "Looks like an Instant Client installation, okay\n"; # the libclntsh.$so (without version suffix) may be missing # we need it to link to so try to create it eval { print "You don't have a libclntsh.$so file, only @libclntsh\n"; my $libclntsh_v = (grep { /\d$/ } sort @libclntsh)[0]; # tacky but sufficient print "So I'm going to create a $OH/libclntsh.$so symlink to $libclntsh_v\n"; symlink($libclntsh_v, "$OH/libclntsh.$so") or warn "Can't create symlink $OH/libclntsh.$so to $libclntsh_v: $!\n"; } unless -e "$OH/libclntsh.$so"; check_ldlibpthname($OH); my $syslibs = read_sysliblist(); print "Oracle sysliblist: $syslibs\n"; $opts{dynamic_lib} = { OTHERLDFLAGS => "$::opt_g" }; my $lib = "clntsh"; $linkwith_msg = "-l$lib."; $opts{LIBS} = [ "-L$OH -l$lib $syslibs" ]; my $inc = join " ", map { "-I$_" } find_headers(); $opts{INC} = "$inc -I$dbi_arch_dir"; } elsif ($mkfile = find_mkfile() and $mkfile =~ /\bdemo_xe.mk$/) { # Oracle XE print "Looks like Oracle XE ($mkfile)\n"; fetch_oci_macros($mkfile); $MK{CCINCLUDES} = '-I$(ICINCHOME)'; # undo odd refinition in demo_xe.mk # From linux Oracle XE (10.2.0): # ICINCHOME=$(ORACLE_HOME)/rdbms/public/ # ICLIBHOME=$(ORACLE_HOME)/lib/ # ICLIBPATH=-L$(ICLIBHOME) # THREADLIBS=-lpthread [initially -lthread then redefined] # CCLIB=$(ICLIBPATH) -lclntsh $(THREADLIBS) # CCINCLUDES = -I$(ICINCHOME) [see above] # CCFLAGS=$(CCINCLUDES) -DLINUX -D_GNU_SOURCE -D_REENTRANT -g [initially without -DLINUX -D_GNU_SOURCE] my $cclib = expand_mkvars($MK{CCLIB}, 0, 1); my $ccflags = expand_mkvars($MK{CCFLAGS}, 0, 1); $linkwith_msg = "$cclib"; $opts{LIBS} = [ $cclib ]; $opts{INC} = "-I$dbi_arch_dir $ccflags"; $opts{dynamic_lib} = { OTHERLDFLAGS => "$::opt_g" }; check_ldlibpthname(); } else { # --- trawl the guts of Oracle's make files looking the how it wants to link #Lincoln: pick the right library path check_ldlibpthname(); my $libdir = ora_libdir(); my @ora_libs = <$OH/$libdir/lib*>; if (@ora_libs < 6) { # just a helpful hint warn "\nYou don't seem to have many Oracle libraries installed. If the" ."\nbuild fails you probably need to install more Oracle software.\n\n"; sleep 6; } # can we give the shared library a helping hand? my @shared = grep { m:/lib(cl(ie)?ntsh|oracle).\w+$:o } @ora_libs; # show original value of ORA_CLIENT_LIB if defined ... print "\$ORA_CLIENT_LIB=$ENV{ORA_CLIENT_LIB}\n" if defined $ENV{ORA_CLIENT_LIB}; # ... before we then set it how it probably should be set # XXX but we still need to write it into the generated Makefile. $ENV{ORA_CLIENT_LIB} = 'shared' if !defined $ENV{ORA_CLIENT_LIB} && ($opts{LINKTYPE}||'') ne 'static' && @shared && !$::opt_c; my $linkvia = fetch_oci_macros($mkfile) if -f $mkfile; my $libhome = expand_mkvars($MK{LIBHOME}, 0, 1) || "$OH/lib"; $linkwith = expand_mkvars($linkvia, 0, 1); #now use logic based of oracle version $linkwith =~ s!/lib\b!/$libdir!g; $libhome =~ s!/lib\b!/$libdir!g; #print "linkwith=$linkwith\n"; my @build_rules = grep { $mk_target_rules{$_} } qw(build build64 build32); my $build_target = "build"; if (@build_rules && $::opt_b) { print "\n"; $build_target = "build32" if $mk_target_rules{build32}; $build_target = "build64" if $mk_target_rules{build64} && perl_is_64bit(); $build_target = $::opt_r if $::opt_r; print "Attempting to discover Oracle OCI $build_target rules\n"; # create dummy C file to keep 'make $mkfile' happy my $DBD_ORA_OBJ = 'DBD_ORA_OBJ'; open DBD_ORA_C, ">$DBD_ORA_OBJ.c" or die "Can't create temporary $DBD_ORA_OBJ.c file in current directory: $!\n"; print DBD_ORA_C "int main() { return 1; }\n"; close DBD_ORA_C; sleep 2; # system("make $DBD_ORA_OBJ.o CC='$Config{cc}'"); # make a valid .o file. my $make = "$Config{make} -f $mkfile $build_target" ." ECHODO=echo ECHO=echo GENCLNTSH='echo genclntsh' CC=true" ." OPTIMIZE= CCFLAGS=" ." EXE=DBD_ORA_EXE OBJS=$DBD_ORA_OBJ.o"; print "by executing: [$make]\n"; my @cmds = `$make 2>&1`; chomp @cmds; print "returned:\n[".join("]\n[",@cmds)."]\n" if $::opt_v; warn "WARNING: Oracle build rule discovery failed ($?)\n" if $?; warn "Add path to $Config{make} command into your PATH environment variable.\n" if $? && "@cmds" =~ /make.*not found/; # hint my @filtered_cmds; while (my $line = shift @cmds) { # join lines split with \'s while ($line =~ s/\\$/ /) { $line .= shift @cmds; } # remove any echo's as the following line should be the result of the echo next if $line =~ /^\s*\S*echo\s+/; next if $line =~ /^\s*\S*make\s+/; # remove recursive calls to make next if $line =~ /^\s*\S*make(\[\d\])?:/; # remove message rom "make:" or "make[x]:" next if $line =~ /^\s*$/; # remove any blank lines push @filtered_cmds, $line; } print "reduced to:\n[".join("]\n[",@filtered_cmds)."]\n" if $::opt_v && "@filtered_cmds" ne "@cmds"; @cmds = @filtered_cmds; my @prolog; push @prolog, shift @cmds while @cmds && $cmds[0] !~ /DBD_ORA_EXE/; print "Oracle oci build prolog:\n \t[", join("]\n\t[", @prolog), "]\n" if @prolog; print "Oracle oci build command:\n\t[", join("]\n\t[", @cmds ), "]\n"; if (@cmds == 1 && (my $build = shift @cmds) =~ /DBD_ORA_EXE/) { $build =~ s/\s*true\s+//; # remove dummy compiler $build =~ s/$DBD_ORA_OBJ.o//; # remove dummy object file $build =~ s/\S+\s+DBD_ORA_EXE//; # remove dummy exe file and preceding flag $build =~ s/-o build\S*//; # remove -o target that confuses gcc at least on Sun $linkwith = $build; # delete problematic crt?.o on solaris $linkwith = del_crtobj($linkwith, 1) if $^O eq 'solaris'; } else { print "WARNING: Unable to interpret Oracle build commands from $mkfile.\a\n"; print "(Will continue by using fallback approach.)\n"; print "Please report this to dbi-users\@perl.org. See README for what to include.\n"; sleep 2; $::opt_b = 0; } unlink "$DBD_ORA_OBJ.c", "$DBD_ORA_OBJ.o" unless $^O eq 'darwin'; # why? print "\n"; } else { print "WARNING: Oracle $mkfile doesn't define a 'build' rule.\n" if $::opt_b; $::opt_b = 0; print "\n"; print "WARNING: I will now try to guess how to build and link DBD::Oracle for you.$BELL\n"; print " This kind of guess work is very error prone and Oracle-version sensitive.\n"; print " It is possible that it won't be supported in future versions of DBD::Oracle.\n"; print " *PLEASE* notify dbi-users about exactly _why_ you had to build it this way.\n"; print "\n"; sleep 6; } $linkwith =~ s/-Y P,/-YP,/g if $Config{gccversion}; $linkwith =~ s:-R /:-R/:g if $^O eq 'solaris'; # modifications (mostly) by Lincoln Baxter if ( ($^O eq 'hpux') && ($osvers > 10) && ( $Config{'cc'} eq 'cc' or $Config{'gccversion'}) ) { # these get dragged in from demo_rdbms.mk where Oracle uses them # the linker bitches about them not being valid options # in this context # (on my system, using gcc, the flags can't be removed entirely; # instead, they have to be converted to the ld-compatible equivs. # -- Sweth () if ( $Config{'cc'} eq 'cc' ) { $linkwith =~ s/-Wl,\+[sn]//g; } elsif ( $Config{'gccversion'} ) { $linkwith =~ s/-Wl,(\+[sn])/$1/g; }; # Oracle 8.0.5 drags in these which also cause link errors: # this produces a good link with the 32bit version of oracle # (64bit version of 8.0.5 fails to link # someone else will have to hack that one out) $linkwith =~ s/\+D[AS]2\.0[W]* / /g; #Lincoln: pick the right library path my $libdir = ora_libdir(); $linkwith =~ s!/lib\b!/$libdir!g; # A number of folks have had to add this library to resolve # undefined symbol errors reported at runtime by ld.sl (the # library loader) libqsmashr defines LhrStringInsert()... # other libraries may have to be added (Lincoln Baxter ) # we check for the library's existence first... (8.0.5 does not have it) if ( -r "$OH/$libdir/libqsmashr.sl" ) { $linkwith =~ s/$/ -lqsmashr/ if ( $linkwith !~ m/-lqsmshr/ ); } if ( ($Config{'libswanted'} !~ m/\bcl\b/) or $Config{'libswanted'} !~ m/\bpthread\b/ ) { print "WARNING: Oracle is built with multi-threading libraries\n" . " You will most likely need to rebuild perl from sources\n" . " with the following libraries: -lcl -lpthread\n" ; } if ( $osvers >= 11 and $linkwith =~ m/-lcl\b/ && $linkwith =~ m/-l:libcl.a/ ) { # from h.m.brand@hccnet.nl print "WARNING: Stripping -lcl from the link flags, because it\n", " seems to conflict with -l:libcl.a\n" ; $linkwith =~ s/\s*-lcl\b//g; } # Lincoln: Jay Strauss's Oracle 8.1.6 fix... I did this manually # when I still had 8.1.6 to deal with (its in the README): # # Jay: 8.1.6 gets Unresolved symbols on LhtStrInsert # $linkwith =~ s/$/ -lclntsh/ if ( $linkwith !~ = m/-lclntsh/ ); # Tim - Not to be disobedient but at this point of the code # $client_version_full = 0, so I can't do Oracle version 8.1.6 logic # So it seems easier to modify if I do it like below rather than above # obviously its your choice # # Lincoln: I don't see how the code above could work if $inspdver{RDMS} == 0 # so I will add this Jays prefered way but inside a test like that # above... if he tests this and it works great... if someone else is # has a problem it is easy to comment out the test. I like Jay's test # for existence first... And I added an addition test of $OH to see # if it looks like 8.1.6 (just incase Jay was right). # # Jay: Add Librarys where one gets Unresolved symbols # if ( ( $osvers >= 11 and $client_version_full =~ /^8\.1\.6/ ) or ( $osvers >= 11 and $OH =~ m,/8\.1\.6, ) ) { my @extraLib = qw[libqsmashr.sl libclntsh.sl]; foreach my $extraLib (@extraLib) { if (-r "$OH/lib/$extraLib") { $extraLib =~ s/^lib([^\.]+).*$/\-l$1/; $linkwith =~ s/$/ $extraLib/ if ( $linkwith !~ m/$extraLib/ ); } } } if ($osvers >= 11 and $linkwith =~ m/-l:libcl.a/) { print "WARNING: stripping -l:libcl.a from liblist (conflict with ld looking for shared libs)\n"; $linkwith =~ s/\s*-l:libcl.a\b//g; } #lincoln: this is bringing back everything we thought we removed... (like libcl.a) # I wonder if this should targetted less specifically than only HPUX 11 # For now this should be relatively safe... if ( $osvers >= 11 and $linkwith =~ s/(`cat[^`]+sysliblist`)//g ) { print "WARNING: Stripped $1 \n", " from link command, because it contains libraries not \n", " compiled with +z or +Z (PIC) causing link to fail.\n", " Furthermore, we should have already grabbed these libraries\n";; } my $ccf = join " ", map { $_ || '' } @Config{qw(ccflags ccldflags cccdlflags)}; if ($Config{cc} =~ /gcc/i) { print "WARNING: perl was not built with -fpic or -fPIC in compiler flags.\n", " You may need to rebuild perl from sources.\n", " See instructions in README.hpux.txt\n" unless $ccf =~ m/-fpic\b/i; } else { print "WARNING: perl was not built with +z or +Z in compiler flags.\n", " You may need to rebuild perl from sources.\n", " See instructions in README.hpux.txt\n" unless $ccf =~ m/\+[zZ]/; } } if ($::opt_b) { # The simple approach $opts{dynamic_lib} = { OTHERLDFLAGS => "$::opt_g $linkwith" }; $linkwith_msg = "OTHERLDFLAGS = $linkwith [from '$build_target' rule]"; } else { # the not-so-simple approach! # get a cut down $linkwith to pass to MakeMaker liblist my $linkwith_s = expand_mkvars($linkwith, 1, 1); # convert "/full/path/libFOO.a" into "-L/full/path -lFOO" # to cater for lack of smarts in MakeMaker / Liblist # which ignores /foo/bar.a entries! my $lib_ext_re = "(a|$Config{dlext}|$Config{so})"; $linkwith_s =~ s!(\S+)/lib(\w+)\.($lib_ext_re)\b!-L$1 -l$2!g; # Platform specific fix-ups: # delete problematic crt?.o on solaris $linkwith_s = del_crtobj($linkwith_s) if $^O eq 'solaris'; $linkwith_s =~ s/-l:lib(\w+)\.sl\b/-l$1/g; # for hp-ux # this kind of stuff should be in a ./hints/* file: $linkwith_s .= " -lc" if $Config{osname} eq 'dynixptx' or $Config{archname} =~ /-pc-sco3\.2v5/; if ($^O eq 'solaris' and $linkwith_s =~ /-lthread/ and $osvers >= 2.3 and $osvers <= 2.6 ) { print "WARNING: Solaris 2.5 bug #1224467 may cause '_rmutex_unlock' error.\n"; print "Deleting -lthread from link list as a possible workround ($osvers).\n"; $linkwith_s =~ s/\s*-lthread\b/ /g; } # extract object files, keep for use later my @linkwith_o; push @linkwith_o, $1 while $linkwith_s =~ s/(\S+\.[oa])\b//; # also extract AIX .exp files since they confuse MakeMaker push @linkwith_o, $1 while $linkwith_s =~ s/(-bI:\S+\.exp)\b//; $linkwith_msg = "@linkwith_o $linkwith_s [from $linkvia]"; $opts{LIBS} = [ "-L$libhome $linkwith_s" ]; $opts{dynamic_lib} = { OTHERLDFLAGS => "$::opt_g @linkwith_o \$(COMPOBJS)" }; } my $OCIINCLUDE = expand_mkvars($MK{INCLUDE} || '', 0, 0); my @h_dirs = find_headers(); my $inc = join " ", map { "-I$_" } @h_dirs; $opts{INC} = "$inc $OCIINCLUDE -I$dbi_arch_dir"; } # --- Handle special cases --- if ($::opt_g && $^O eq "MSWin32" && $Config::Config{cc} eq "cl") { $opts{LDDLFLAGS} = $Config::Config{lddlflags} . ' -debug' } $opts{DEFINE} .= ' -Wall -Wno-comment' if $Config{gccversion}; $opts{DEFINE} .= ' -Xa' if $Config{cc} eq 'clcc'; # CenterLine CC $opts{DEFINE} .= ' -DUTF8_SUPPORT' if ($] >= 5.006); # Use OCIEnvNlsCreate if available for best unicode behaviour #$opts{DEFINE} .= ' -DNEW_OCI_INIT' if $client_version >= 9.2; $opts{DEFINE} .= ($^O ne 'VMS') ? " -DORA_OCI_VERSION=\\\"$client_version_full\\\"" : " -DORA_OCI_VERSION=\"$client_version_full\""; # force additional special behavior for oci 8. For now, this means # emulating OciLobWriteAppend # use this if, for some reason the default handling for this function # doesn't work or you are building a binary release for distribution # to machines with older client libraries. print "\nclient_version=$client_version\n\n"; $opts{DEFINE} .= " -DORA_OCI_102" if ($::opt_V && $client_version == 10.2) or ( $client_version >= 10.2); $opts{DEFINE} .= " -DORA_OCI_112" if ($::opt_V && $client_version == 11.2) or ( $client_version >= 11.2); print "\nDEFINE=$opts{DEFINE}\n\n"; # OCIStmntFetch2() is a feature of OCI 9.0.0 $opts{DEFINE} .= " -DUSE_ORA_OCI_STMNT_FETCH " if ( $client_version < 9.0 ); # Set some private WriteMakefile options if this is 'me' :-) if ($is_developer){ # a reasonable guess $BELL = "" if ($ENV{LOGNAME}||'') eq 'timbo'; $::opt_g = '-g'; if ($Config{gccversion}) { $opts{DEFINE} .= ' -Wall -Wcast-align -Wpointer-arith'; $opts{DEFINE} .= ' -Wbad-function-cast -Wcast-qual'; #$opts{DEFINE} .= ' -Wconversion'; # very noisy so remove to see what people say $opts{DEFINE} .= ' -Wimplicit -Wimplicit-int -Wimplicit-function-declaration -Werror-implicit-function-declaration -Wimport -Winline -Wlong-long -Wmissing-braces -Wmissing-format-attribute -Wmissing-noreturn -Wmultichar -Wpacked -Wparentheses -Wpointer-arith -Wreturn-type -Wsequence-point -Wsign-compare -Wswitch -Wtrigraphs -Wundef -Wuninitialized -Wunreachable-code -Wunused -Wunused-function -Wunused-label -Wunused-parameter -Wunused-value -Wunused-variable -Wwrite-strings -Wbad-function-cast -Wmissing-declarations -Wnested-externs' if $::opt_w; } $opts{dynamic_lib}->{OTHERLDFLAGS} .= " $::opt_g"; } # HP-UX 9 cannot link a non-PIC object file into a shared library. # Since the # .a libs that Oracle supplies contain non-PIC object # files, we sadly have to build static on HP-UX 9 :( if ($^O eq 'hpux') { if ($osvers < 10) { print "WARNING: Forced to build static not dynamic on $^O $osvers.$BELL\n"; $opts{LINKTYPE} = 'static'; } else { print "WARNING: If you have trouble, see README.hpux.txt...\n" ." you may have to build your own perl, or go hunting for libraries\n"; } print "WARNING: If you have trouble, try perl Makefile.PL -l\n" unless $::opt_l; sleep 5; $opts{DEFINE} .= ' $(HP64DEFINES)' if ($Config{archname} =~ /-thread\b/i and perl_is_64bit()); # linker doesn't understand +DD64 flag Weiguo Sun $opts{dynamic_lib}->{OTHERLDFLAGS} =~ s/\+DD64\b// if $opts{dynamic_lib}->{OTHERLDFLAGS}; # see also const_cccmd for -Aa to -Ae flag change } # --- check for Test::Harness bug print "\nChecking for functioning wait.ph\n"; eval { package WAIT; local $^W = 0; require 'wait.ph' }; if (!$@ && !defined(&WAIT::WCOREDUMP)) { print "You have a wait.ph file generated by perl h2ph utility.\n"; print "(I found it at $INC{'wait.ph'})\n"; print "It does not define a WCOREDUMP function. That's probably an error.\n"; print "If a DBD::Oracle test fails then you will probably see a message\n"; print "from Test::Harness about WCOREDUMP being undefined. You can either ignore\n"; print "it or try to fix your wait.ph file. The message DOES NOT reflect the\n"; print "cause of the test failure, it's just a problem interpreting the failure.\n"; } print "\n"; # --- display summary information # log key platform information to help others help you quickly if needed print "\n"; print "System: perl$] @Config{qw(myuname)}\n"; print "Compiler: @Config{qw(cc optimize ccflags)}\n"; print "Linker: ". (find_bin('ld')||"not found") ."\n" unless $^O eq 'VMS'; print "Sysliblist: ".read_sysliblist()."\n"; print "Oracle makefiles would have used these definitions but we override them:\n" if $MK{CFLAGS} || $MK{LDFLAGS} || $MK{LDSTRING}; print " CC: $MK{CC}\n" if $MK{CC}; print " CFLAGS: $MK{CFLAGS}\n" if $MK{CFLAGS}; print " [".mkvar('CFLAGS',0,1,0). "]\n" if $MK{CFLAGS}; print " CLIBS: $MK{CLIBS}\n" if $MK{CLIBS}; print " [".mkvar('CLIBS',0,1,0). "]\n" if $MK{CLIBS}; if ($mk_target_rules{build} && !$::opt_b) { my $rules = join "\n", '', @{ $mk_target_rules{build} }; $rules = expand_mkvars($rules, 0, 0, 1, 1) if $rules =~ /^\s*\$\(\w+\)\s*$/; print " build: $rules\n"; print " [".expand_mkvars($rules,0,1,0). "]\n"; } print " LDFLAGS: $MK{LDFLAGS}\n" if $MK{LDFLAGS}; print " [".mkvar('LDFLAGS',0,1,0). "]\n" if $MK{LDFLAGS}; print " LDSTRING: $MK{LDSTRING}\n" if $MK{LDSTRING}; print " [".mkvar('LDSTRING',0,1,0)."]\n" if $MK{LDSTRING}; print "Linking with $linkwith_msg\n" if $linkwith_msg; print "\n"; # --- display extra notes and warnings if ($^O eq 'aix' and $osvers >= 4 and $Config{cc} ne 'xlc_r') { print "\n"; print "WARNING: You will may need to rebuild perl using the xlc_r compiler.\a\n"; print " The important thing is that perl and DBD::Oracle be built with the same compiler.\n"; print " You may also need to: ORACCENV='cc=xlc_r'; export ORACCENV\n"; print " Also see README.aix for gcc instructions and read about the -p option.\n"; sleep 5; } if ($Config{archname} !~ /-thread\b/i) { print "\n"; print "WARNING: If you have problems you may need to rebuild perl with threading enabled.$BELL\n"; sleep 5; } if ($Config{usemymalloc} eq 'y') { print "\n"; print "WARNING: If you have problems you may need to rebuild perl with -Uusemymalloc.$BELL\n"; sleep 5; } print "WARNING: Your GNU C compiler is very old. Please upgrade.\n" if ($Config{gccversion} and $Config{gccversion} =~ m/^(1|2\.[1-5])/); if ($opts{LINKTYPE} && $opts{LINKTYPE} eq 'static') { print "** Note: DBD::Oracle will be built *into* a NEW perl binary. You MUST use that new perl.\n"; print " See README and Makefile.PL for more information.$BELL\n"; } # --- write the name file etc --- # create this before WriteMakefile so MakeMaker knows it's here open(MK_PM, ">mk.pm") or die "Unable to create mk.pm: $!"; WriteMakefile( dbd_edit_mm_attribs(\%opts) ); check_security() unless $^O eq 'VMS' or $^O eq 'MSWin32' or $^O =~ /cygwin/i; print "\n"; print "*** If you have problems...\n"; print " read all the log printed above, and the README and README.help.txt files.\n"; print " (Of course, you have read README by now anyway, haven't you?)\n\n"; vms_logical_names_sanity_check(); exit 0; # === utility functions ================================ sub vms_logical_names_sanity_check { return unless $^O eq 'VMS'; unless ( $ENV{PERL_ENV_TABLES} ) { # perl_env_tables not set report print <<'END_TXT'; The logical PERL_ENV_TABLES is not set. This means that any logical names set when testing the package will be set in the first logical name table that occurs in the LNM$FILE_DEV list. Please read the Readme.VMS file for further information. END_TXT return; } return if grep { $ENV{$_} eq 'LNM$JOB' } grep { /^PERL_ENV_TABLES;\d+$/ } keys %ENV; # perl_env_tables set but the element we want is missing print <<'END_TXT'; The logical PERL_ENV_TABLES is set, but without LNM$JOB. Testing the package can fail because of inability to correctly translate SYS$SCRATCH for temporary storage, as SYS$SCRATCH is set at the JOB level. To ensure that testing the package correctly translates SYS$SCRATCH, please ensure that LNM$JOB is part of PERL_ENV_TABLES like this: $ DEFINE PERL_ENV_TABLES LNM$PROCESS, LNM$JOB , CRTL_ENV END_TXT } sub find_oracle_home { print "Trying to find an ORACLE_HOME\n"; my @path = split /\Q$Config{path_sep}/, $ENV{PATH}; print "using PATH @path\n" if $::opt_v; # instant client has libclntsh in same dir as sqlplus my @oh = grep { (glob("$_/libclntsh.$so*"))[0] } @path; if (!@oh) { # failing that, try LD_LIBRARY_PATH or equiv my (undef, undef, @ldlibpth) = ldlibpth_info(1); print "using ldlib @ldlibpth\n" if $::opt_v; @oh = grep { (glob("$_/libclntsh.$so*"))[0] } @ldlibpth; # for instant client @oh may be actual ORACLE_HOME # but for non-IC ORACLE_HOME may be dir above a /lib* s:/lib\w*/?$:: for @oh; # remove possible trailing lib dir } if (!@oh) { # else try the traditional kind of install # this should work for non-instant-client installs ($OH/bin & $OH/lib*) @oh = grep { (glob("$_/../lib*/libclntsh.$so*"))[0] } @path; s:/[^/]/?$:: for @oh; } print "Found @oh\n" if @oh; return $oh[0]; } sub win32_oracle_home { my $oh = shift; my ($req_ok, $hkey, $Val, $Keys); my $default_home; if ( ! $oh ) { if ( $Config{osname} eq "MSWin32") { # Win32::TieRegistry is prefered, but it requires Win32API::Registry # which is not available in mingw or cygwin eval { require Win32::TieRegistry; $Win32::TieRegistry::Registry->Delimiter("/"); $hkey = $Win32::TieRegistry::Registry->{"LMachine/SOFTWARE/Oracle/"} and $req_ok = 1; }; eval { # older name of Win32::TieRegistry require Tie::Registry; $Tie::Registry::Registry->Delimiter("/"); $hkey = $Tie::Registry::Registry->{"LMachine/SOFTWARE/Oracle/"} and $req_ok = 1; } unless $req_ok; eval { $default_home = $hkey->{ORACLE_HOME} || ''; }; eval { $Val = sub { # Return value my ($hkey) = @_; return $hkey->{ORACLE_HOME} || ''; }; $Keys = sub { # Return list of sub-folder keys my ($hkey) = @_; # MAC: %$hkey and related method calls don't work under # perl5db, so don't try single stepping through here return map {m:/$: ? $hkey->{$_} : ()} keys %$hkey; }; } if $hkey; } # Win32::Registry imports some symbols into main:: # this is not commonly wanted, so try this as a last resort # MAC: it is available under mingw and might be available under cygwin # If cygwin doesn't have it, move the rest inside the other if block eval { require Win32::Registry; $main::HKEY_LOCAL_MACHINE->Open('SOFTWARE\\ORACLE', $hkey); my $dummy = $main::HKEY_LOCAL_MACHINE; # avoid single use complaint eval { my $hval; $hkey->GetValues($hval); $default_home = $hval->{ORACLE_HOME}[2] || ''; }; $Val = sub { # Return value my ($hkey) = @_; my $hval; $hkey->GetValues($hval); return $hval->{ORACLE_HOME}[2] || ''; }; $Keys = sub { # Return list of sub-folder keys my ($hkey) = @_; my @hkey; $hkey->GetKeys(\@hkey); @hkey = map { $hkey->Open($_, $_); $_ } @hkey; return @hkey; }; } unless $req_ok; # Workaround Win32::TieRegistry FETCH error during global destruction. undef $Win32::TieRegistry::Registry if $Win32::TieRegistry::Registry; # Look for ORACLE_HOME in all ORACLE sub-folders, use last one found # before 8.1.5, there should be only one eval { my ($oh1, %oh); my @hkey = ($hkey); # JLU: December 5, 2002: if the "default" home is set and has # an OCI directory, then use it. if ($default_home && -d $default_home && -d $default_home . "/oci") { $oh = $default_home; } else { # use previous logic if default home doesn't have OCI # directory while (@hkey) { $hkey = shift @hkey; $oh = $oh1, $oh{$oh1} = 1 if ($oh1 = &$Val($hkey)) && -d $oh1; push @hkey, &$Keys($hkey); } if (1 < keys %oh) { # JLU: 8/21/01 Oracle's default home is the first one in # the path, at least with 8i print "\n\007Multiple Oracle homes: ", join(" ", sort keys %oh), "\n\n"; my @path = split(";", $ENV{PATH}); my $dir; foreach $dir (@path) { # the path will be c:\path\to\home\bin, so remove \bin if it's there. $dir =~ s/\\bin$//; if (defined($oh{$dir})) { print "$dir is first in the PATH, so we'll use that as Oracle's default home.\n\n"; $oh = $dir; last; } } } } } if defined $Keys; } $oh =~ s:\\:/:g if $oh; return $oh } sub read_sysliblist { my $syslibs = (-f "$OH/lib/sysliblist") ? read_file("$OH/lib/sysliblist") : (-f "$OH/rdbms/lib/sysliblist") ? read_file("$OH/rdbms/lib/sysliblist") : ''; if ($^O eq "hpux") { $syslibs =~ s/-l:lib(\w+).(sl|a)\b/-l$1/g; $syslibs =~ s/\s*-ldld\b//g; $linkwith =~ m/-lcl\b/ or $syslibs =~ s/\s*-lcl\b//g; } return $syslibs; } sub perl_is_64bit { return defined $Config{use64bitall} ; } sub ora_libdir { my $libdir = 'lib' ; if ( $client_version >= 9 ) { $libdir = 'lib32' if ! perl_is_64bit() and -d "$OH/lib32"; } else { $libdir = 'lib64' if perl_is_64bit() and -d "$OH/lib64"; } return $libdir; } sub del_crtobj { my $orig = shift; my $verbose = shift || $::opt_v; my $str = $orig; # E.g. for changing the COMPOBJS line (and sometimes LDSTRING) # old: COMPOBJS=$(COMPOBJ)/crti.o $(COMPOBJ)/crt1.o $(COMPOBJ)/__fstd.o # new: COMPOBJS=$(COMPOBJ)/__fstd.o my @del; push @del, $1 while $str =~ s:([^\s=]*\bcrt[1in]\.o)\b::; if ($orig ne $str) { print "Deleted @del from link args.\n" if $verbose; print "del_crtobj: $orig\n : $str\n@del\n" if $::opt_v; } return $str; } sub find_mkfile { my @mk_oci32 = ( 'rdbms/demo/demo_xe.mk', 'rdbms/demo/demo_rdbms32.mk', 'rdbms/demo/demo_rdbms.mk', 'rdbms/lib/ins_rdbms.mk' #Oracle 11 full client ); my @mk_oci64 = ( 'rdbms/demo/demo_xe.mk', 'rdbms/lib/oracle.mk', 'rdbms/demo/oracle.mk', 'rdbms/demo/demo_rdbms.mk', 'rdbms/demo/demo_rdbms64.mk', 'rdbms/lib/ins_rdbms.mk' #Oracle 11 full client ); my @mk_oci = perl_is_64bit() ? @mk_oci64 : @mk_oci32; # Add build.mk from /usr/share/oracle based on the oracle home location if # oracle home is under /usr/lib/oracle (Linux RPM install). # The 11g instant client only contains build.mk located in # /usr/share/oracle/ push @mk_oci, "/usr/share/oracle/$1/demo.mk" if ($OH =~ m|^/usr/lib/oracle/(.*)|); my @mkplaces = ($::opt_p) ? (@mk_oci) : (@mk_oci); if ($::opt_m) { $::opt_m = cwd()."/$::opt_m" unless $::opt_m =~ m:^/:; die "-m $::opt_m: not found" unless -f $::opt_m; unshift @mkplaces, $::opt_m; } my $mkfile; foreach my $place (@mkplaces) { $place = "$OH/$place" unless $place =~ m:^[/\.]:; # abs or relative path next unless -f $place; $mkfile ||= $place; # use first one found print "Found $place\n"; } die qq{ Unable to locate an oracle.mk or other suitable *.mk file in your Oracle installation. (I looked in @mkplaces under $OH) The oracle.mk (or demo_rdbms.mk) file is part of the Oracle RDBMS product. You need to build DBD::Oracle on a system which has one of these Oracle components installed. (Other *.mk files such as the env_*.mk files will not work.) Alternatively you can use Oracle Instant Client. In the unlikely event that a suitable *.mk file is installed somewhere non-standard you can specify where it is using the -m option: perl Makefile.PL -m /path/to/your.mk See the appropriate README file for your OS for more information and some alternatives. } unless ($^O eq 'MSWin32') || ($^O eq 'VMS') || ($mkfile && -f $mkfile) || $::opt_F; print "Using $mkfile\n"; return $mkfile; } sub fetch_oci_macros { my $file = shift; # Read $file makefile, extract macro definitions from it # and store them in $MK, @MK and %MK. # Don't include the following definitions in the generated # makefile (note that %MK stills gets these values). my @edit = qw( SHELL CC CPP CFLAGS CCFLAGS OPTIMIZE ASFLAGS RCC LD LDFLAGS AR AS CHMOD ECHO EXE OBJS PERL OBJ_EXT LIB_EXT VERSION ); my %edit; @edit{@edit} = ('$_ = ""') x @edit; $edit{ORA_NLS} = $edit{ORA_NLS33} = $edit{ORA_NLS32} = q{ print "Deleting $_\n", " because it is not already set in the environment\n", " and it can cause ORA-01019 errors.\n"; $_ = ''; } unless $ENV{ORA_NLS} || $ENV{ORA_NLS33} || $ENV{ORA_NLS32} || 1; # Old problem? Let's try without it for a while $edit{COMPOBJS} = q{ # Firstly a Solaris specific edit: $_ = del_crtobj($_) if $^O eq 'solaris'; # Delete any object files in COMPOBJS that don't actually exist my $of; foreach $of (split(/=|\s+/)) { next if !$of or $of eq "COMPOBJS"; my $obj = expand_mkvars($of,0,0); next if -e $obj; print "Deleting $of from COMPOBJS because $obj doesn't exist.\n"; s:\Q$of::; } }; # deal with (some subversions) of Oracle8.0.3's incompatible use of OBJ_EXT my $incompat_ext = ($MK{OBJ_EXT} && $MK{OBJ_EXT} !~ /^\./); warn "OBJ_EXT correction enabled ($MK{OBJ_EXT})\n" if $incompat_ext; # Don't include compiler options for these compilers my @ignore_def = qw( BUILD_CCC296 BUILD_ICC ); my %ignore_def; @ignore_def{@ignore_def} = ('1') x @ignore_def; my $mkver = 0; my $lastline = ''; my @lines = read_inc_file($file); for(1; $_ = shift(@lines); $lastline = $_){ # Join split lines but retain backwack and newlines: $_ .= shift @lines while(m/\\[\r\n]+$/); chomp; push @MK, '' if $_ eq '' and $lastline ne ''; # squeeze multiple blank lines next unless $_; if ($incompat_ext) { s/\.(\$\(OBJ_EXT\))/$1/g; s/\.(\$\(LIB_EXT\))/$1/g; } # skip compiler options for undesirable compilers m/^ifdef (\w+)/ and do { if ($ignore_def{$1}) { $_ = shift @lines until m/^endif/; next; } }; if (m!^([-\w/+.\$()\s]+)\s*:+\s*([^=]*)!) { # skip targets my @tgts = split(/ /, $1); # multiple target names in Oracle9i's demo_rdbms.mk for (@tgts) { $mk_target_deps{$_} = $2 || '' } my @rules; while (@lines && $lines[0] =~ m!^\t! && chomp $lines[0]) { my $tmp_line = shift @lines; while($tmp_line =~ m!\\$!) { # continuations! $tmp_line =~ s/\s+\\$/ /; $tmp_line .= shift @lines; chomp($tmp_line); } push @rules, $tmp_line; #print "target @tgts => $mk_target_deps{$tgt} => @{$mk_target_rules{$tgt}}\n"; } for (@tgts) { push @{ $mk_target_rules{$_} ||= [] }, @rules } next; } next if m!^\t!; # skip target build rules next if m/^\s*\.SUFFIXES/; unless($MK{mkver}) { # still want to get version number my $line = $_; $line =~ s/[\\\r\n]/ /g; $MK{mkver} = $mkver = $1 if $line =~ m/\$Header:.*?\.mk.+(\d+\.\d+)/; } # We always store values into %MK before checking %edit # %edit can edit this in addition to $_ if needed. my $name; if (m/^\s*(\w+)\s*(\+?)=\s*/) { $name = $1; my $append = $2; my $value = $'; $value =~ s/^\@`/`/; if ($append) { my $expanded = expand_mkvars($value, 0, 1); print "Appending '$expanded' to $name\n" if $::opt_v; $value = $MK{$name} ? "$MK{$name} $expanded" : $expanded; } elsif ($MK{$name} && $MK{$name} ne $value) { print "$name macro redefined by Oracle\n from $MK{$name}\n to $value\n" if $::opt_d; } $MK{$name} = $value; $MK{$name} =~ s/^([^#]*)#.*/$1/; # remove comments if (exists $edit{$name}) { my $pre = $_; eval $edit{$name}; # execute code to edit $_ print "Edit $name ($edit{$name}) failed: $@\n" if $@; if ($_ ne $pre and $::opt_v) { $_ ? print "Edited $name definition\n from: $pre\n to: $_\n" : print "Deleted $name definition: $pre\n"; } } } push(@MK, $_); } # --- now decide what to link with --- my $linkvia; if ($::opt_n) { $linkvia = "\$($::opt_n)" if $MK{$::opt_n}; warn "Can't use '$::opt_n': not defined by .mk files\n" unless $linkvia; } # modern Oracle .mk files define OCISTATICLIBS and OCISHAREDLIBS if (!$linkvia && ($MK{OCISHAREDLIBS} || $MK{OCISTATICLIBS})) { $linkvia = ''; if ($MK{OCISTATICLIBS} && ( ($opts{LINKTYPE}||'') eq 'static' || "@ARGV" =~ m/\bLINKTYPE=static\b/ || $::opt_c) ) { $linkvia .= '$(DEF_ON) ' if $MK{DEF_ON}; $linkvia .= '$(SSCOREED) ' if $MK{SSCOREED}; $linkvia .= '$(OCISTATICLIBS)'; } else { $linkvia .= '$(SSDBED) ' if $MK{SSDBED}; $linkvia .= '$(DEF_OPT) ' if $MK{DEF_OPT}; if ($client_version_full =~ /^8\.0\./ and $^O eq 'dec_osf' and $osvers >= 4.0) { $linkvia .= '$(SCOREPT) $(NAETAB) $(NAEDHS) $(LLIBRDBMS_CLT) $(LLIBMM) '; $linkvia .= '$(NETLIBS) $(CORELIBS) $(LLIBCOMMON) $(LLIBEPC) '; $need_ldlp_env = "LD_LIBRARY_PATH"; } $linkvia .= '$(OCISHAREDLIBS)'; } } $linkvia = '$(LIBCLNTSH)' if !$linkvia && $MK{LIBCLNTSH}; # The oracle.mk file tends to define OCILDLIBS $linkvia = '$(OCILDLIBS)' if !$linkvia && $MK{OCILDLIBS}; # Now we get into strange land of twisty turny macros if (!$linkvia && $MK{PROLDLIBS}) { # Oracle 7.3.x # XXX tweak for threaded perl? - use PROLLSsharedthread if ($MK{PROLDLIBS} =~ /thread/i && $MK{PROLLSshared}) { $linkvia = '$(PROLLSshared)'; } else { $linkvia = '$(PROLDLIBS)'; } } elsif (!$linkvia && int($mkver) == 1) { if ($MK{LLIBOCIC}) { $linkvia = '$(LLIBOCIC) $(TTLIBS)'; } else { print "WARNING: Guessing what to link with.\n"; $linkvia = '-locic $(TTLIBS)'; # XXX GUESS HACK } } elsif (!$linkvia && $MK{CCLIB}) { # Oracle XE $linkvia = '$(CCLIB)'; } unless ($linkvia){ die "ERROR parsing $file: Unable to determine what to link with.\n" ."Please send me copies of these files (one per mail message):\n@mkfiles\n"; } $MK_TEXT = join("\n", @MK); return $linkvia; } sub read_inc_file { my $file = shift; my $fh; unless ($fh = new FileHandle "<$file") { # Workaround more oracle bungling (Oracle 7.3.2/Solaris x86) my $alt; ($alt = $file) =~ s/\.dk\.mk$/\.mk/; $fh = new FileHandle "<$alt"; die "Unable to read $file: $!" unless $fh; } print "Reading $file\n"; my @lines; push(@mkfiles, $file); while(<$fh>) { # soak up while looking for include directives push(@lines, $_), next unless /^\s*include\s+(.*?)\s*$/m; my $inc_file = $1; # deal with "include $(ORACLE_HOME)/..." # (can't use expand_mkvars() here) $inc_file =~ s/\$\((ORACLE_HOME|ORACLE_ROOT)\)/$ENV{$ORACLE_ENV}/og; push(@lines, read_inc_file($inc_file)); } print "Read a total of ".@lines." lines from $file (including inclusions)\n" if $::opt_v; return @lines; } my %expand_shellescape; sub expand_shellescape { my($orig, $level) = @_; my $cmd = $orig; my $debug = $::opt_d || $::opt_v; print "Evaluating `$orig`\n" if $debug && !$expand_shellescape{$orig}; # ensure we have no $(...) vars left - strip out undefined ones: $cmd =~ s/\$[({](\w+)[})]/mkvar("$1", 1, 0, $level+1)/ge; print " expanded `$cmd`\n" if $debug and $cmd ne $orig; my $result = `$cmd`; $result =~ s/\s+$/ /; # newlines etc to single space print " returned '$result'\n" if $debug && !$expand_shellescape{$orig}; $expand_shellescape{$orig} = $result; $result; } sub expand_mkvars { my ($string, $strip, $backtick, $level, $maxlevel) = @_; return if(!defined $string); $level ||= 1; local($_) = $string; print "$level Expanding $_\n" if $::opt_d; # handle whizzo AIX make feature used by Oracle s/\$[({] (\w+) \? ([^(]*?) : ([^(]*?) [})]/ my ($vname, $vT, $vF) = ($1,$2,$3); $MK{$vname} = (mkvar($vname, 1, $backtick, $level+1)) ? $vT : $vF /xge; # can recurse s/\$[({] (\w+) [})]/ mkvar("$1", $strip, $backtick, $level+1, $maxlevel) /xge; # can recurse s/`(.*?[^\\])`/expand_shellescape("$1", $level+1)/esg if $backtick; # can recurse s/\s*\\\n\s*/ /g; # merge continuations s/\s+/ /g; # shrink whitespace print "$level Expanded $string\n to $_\n\n" if $::opt_d and $_ ne $string; $_; } sub mkvar { my($var, $strip, $backtick, $level, $maxlevel) = @_; my $default = $strip ? '' : "\$($var)"; print "$level Variable: $var\n" if $::opt_d; return '$(LIBHOME)' if $var eq 'LIBHOME' && !$strip; # gets noisy return $ENV{$ORACLE_ENV} if $var eq 'ORACLE_HOME'; my $val = $MK{$var}; if (!defined $val and exists $ENV{$var}) { $val = $ENV{$var}; print "Using value of $var from environment: $val\n" unless $var eq 'LD_LIBRARY_PATH'; } return $default unless defined $val; if ($MK_expanding{$var}) { print "Definition of \$($var) includes \$($var).\n"; return "\$($var)"; } local($MK_expanding{$var}) = 1; return $val if $maxlevel && $level >= $maxlevel; return expand_mkvars($val, $strip, $backtick, $level+1, $maxlevel); # can recurse } sub read_file { my $file = shift; unless (open(ROL, "<$file")) { warn "WARNING: Unable to open $file: $!\n"; return ""; } my $text = join "", ; $text =~ s/\n+/ /g; close ROL; return $text; } sub find_bin{ my $bin = shift; my $path_sep = $Config{path_sep}; foreach (split(/\Q$path_sep/, $ENV{PATH})){ return "$_/$bin" if -x "$_/$bin"; { # let's try harder # see rt#84530 for why we don't go straight for it use filetest 'access'; return "$_/$bin" if -x "$_/$bin"; } } return undef; } sub find_headers { # compensate for case where final .0 isn't in the install directory name (my $client_version_trim = $client_version_full) =~ s/\.0$//; my @try = grep { -d $_ } ( # search the ORACLE_HOME we're using first # --- Traditional full-install locations "$OH/rdbms/public", # prefer public over others "$OH/rdbms", "$OH/plsql", # oratypes.h sometimes here (eg HPUX 11.23 Itanium Oracle 9.2.0), # --- Oracle SDK Instant Client locations "$OH/sdk/include", # --- Oracle RPM Instant Client locations map { ( $_, $_."64" ) } map { ( $_, "/usr$_" ) } map { "/include/oracle/$_/client" } $client_version, $client_version_trim, $client_version_full, #"/include/oracle/$client_version_full/client", # Instant Client for RedHat FC3 #"/include/oracle/$client_version_trim/client", # Instant Client for RedHat FC3 #"/usr/include/oracle/$client_version/client64", # Instant Client 11.1 and up #"/usr/include/oracle/$client_version/client", # Instant Client 11.1 and up #"/usr/include/oracle/$client_version_full/client64", # Instant Client 64 #"/usr/include/oracle/$client_version_full/client", # Instant Client for RedHat FC4 #"/usr/include/oracle/$client_version_trim/client64", # Instant Client 64 #"/usr/include/oracle/$client_version_trim/client", # Instant Client for RedHat FC4 ); # Add /usr/include/oracle based on the oracle home location if oracle home is under # /usr/lib/oracle ( Linux RPM install ). The 11g instant client reports # client_version as 11.1.0.6 from sqlplus, but installs under 11.1.0.1. push @try, "/usr/include/oracle/$1" if ($OH =~ m|^/usr/lib/oracle/(.*)|); unshift @try, $::opt_h if $::opt_h; @try = grep { -d $_ } @try; my %h_file; if (@try) { find( sub { return unless /^o(ci.{3,4}|ratypes)\.h$/i; my $dir = $File::Find::dir; $h_file{$_} ||= $dir; # record first one found print "Found $dir/$_\n" if $::opt_d; }, @try); } my %h_dir = reverse %h_file; # distinct first found dirs my @h_dir = keys %h_dir; print "Found header files in @h_dir.\n" if @h_dir; if (!$h_file{'oratypes.h'} || !$h_file{'ocidfn.h'}) { print "\n\n*********************************************************\n"; print "I can't find the header files I need in your Oracle installation.\n"; print "You probably need to install some more Oracle components.\n"; print "For Instant Client that means the SDK package.\n"; print "I'll keep going, but the compile will probably fail.\n"; print "See the appropriate README file for your OS for more information.$BELL\n"; print "*********************************************************\n\n"; sleep 5; } return @h_dir; } sub get_client_version { my ($force_version) = @_; my $client_version_full = ''; my $sqlplus_exe = ($^O eq 'Win32' || $^O eq 'MSWin32' || $^O eq 'cygwin') ? "sqlplus.exe" : "sqlplus"; # When building under Cygwin, ORACLE_HOME must be a native Windows # path so Oracle itself can use it, but it needs to be translated # to a Cygwin path so it can be joined into the PATH. # Otherwise, the colon in the drive specification (e.g. "c:") is # treated as a separator. my $OH_path = $OH; chomp($OH_path = `/usr/bin/cygpath -u $OH_path`) if $^O eq 'cygwin' && $OH; # if we have an ORACLE_HOME then prepend it to the PATH local $ENV{PATH} = join $Config{path_sep}, "$OH_path/bin", $OH_path, $ENV{PATH} if $OH; print "PATH=$ENV{PATH}\n" if $::opt_v; if (find_bin($sqlplus_exe)) { local $ENV{SQLPATH} = ""; # avoid $SQLPATH/login.sql causing sqlplus to hang # Try to use the _SQLPLUS_RELEASE predefined variable from sqlplus # Documented in the SQL*Plus reference guide: # http://download-west.oracle.com/docs/cd/B12037_01/server.101/b12170/ch13.htm#i2675128 # Output is in the following format: # DEFINE _SQLPLUS_RELEASE = "902000400" (CHAR) Representing 9.2.0.4.0 # DEFINE _SQLPLUS_RELEASE = "1001000200" (CHAR) Representing 10.1.0.2.0 open FH, ">define.sql" or warn "Can't create define.sql: $!"; print FH "DEFINE _SQLPLUS_RELEASE\nQUIT\n"; close FH; my $sqlplus_release = `$sqlplus_exe -S /nolog \@define.sql 2>&1`; if ($sqlplus_release =~ /(SP2-0750)|(SP2-0642)/) { my $x = $ENV{ORACLE_HOME}; delete $ENV{ORACLE_HOME}; $sqlplus_release = `$sqlplus_exe -S /nolog \@define.sql 2>&1`; $ENV{ORACLE_HOME} = $x; } unlink "define.sql"; print $sqlplus_release; # the _SQLPLUS_RELEASE may not be on first line: if ($sqlplus_release =~ /DEFINE _SQLPLUS_RELEASE = "(\d?\d)(\d\d)(\d\d)(\d\d)(\d\d)"/) { $client_version_full = sprintf("%d.%d.%d.%d", $1, $2, $3, $4); } else { my $ldlib_note = ($Config{ldlibpthname}) ? "Specifically, your $Config{ldlibpthname} environment variable" : "Many systems need an environment variable (such as LD_LIBRARY_PATH, DYLD_LIBRARY_PATH)"; warn qq{ If sqlplus failed due to a linker/symbol/relocation/library error or similar problem then it's likely that you've not configured your environment correctly. $ldlib_note set to include the directory containing the Oracle libraries. \a\n}; sleep 5; } } else { warn "Can't find sqlplus. Pity, it would have helped.\n"; } if (!$client_version_full && $OH && open INST, "<$OH/install/unix.rgs") { local $/ = undef; =~ m/^(rdbms|sql\*plus)\s+([\d.]+)/m; $client_version_full = $2 if $2; close INST; } if (!$client_version_full && $OH && -x "$OH/orainst/inspdver" ) { open INST, "$OH/orainst/inspdver |"; # client only install does not have this my @inspdver = ; close INST; foreach (@inspdver) { $client_version_full = $1 if m/^(\d+\.\d+\.\d+)\S*\s+.*RDBMS/; next unless $::opt_v or m/RDBMS/i or m/PL.SQL/i or m/Precomp/i or m/Pro\*C/i; print $_; } } if (!$client_version_full) { print "I'm having trouble finding your Oracle version number... trying harder\n" unless $force_version; if ( $OH =~ m![^\d\.]((?:8|9|1\d)\.\d+\.\d+(\.\d+)?)! ) { #decode it from $OH if possible $client_version_full = $1; } elsif ( "$OH/" =~ m!\D(8|9|10)(\d)(\d?)\D!) { # scary but handy $client_version_full = join ".", $1, $2, ($3||'0'); } elsif ( "$OH/" =~ m!/10g!) { # scary but handy $client_version_full = "10.0.0.0"; } } if ($force_version && $force_version ne $client_version_full) { print "Forcing Oracle version to be treated as $force_version\n"; $client_version_full = $force_version; } if ($client_version_full && $client_version_full !~ m/^(7|8|9|1\d)\.\d+/ ) { print "Oracle version seems to be $client_version_full but that looks wrong so I'll ignore it.\n"; $client_version_full = ""; } if (!$client_version_full) { $client_version_full = "8.0.0.0"; print qq{ WARNING: I could not determine Oracle client version so I\'ll just default to version $client_version_full. Some features of DBD::Oracle may not work. Oracle version based logic in Makefile.PL may produce erroneous results. You can use "perl Makefile.PL -V X.Y.Z" to specify a your client version.\n }; sleep 5; } # hack up a simple floating point form of the version: 8.1.6.2 => 8.1 ($client_version = $client_version_full) =~ s/^(\d+\.\d+).*/$1/; print "Oracle version $client_version_full ($client_version)\n"; return $client_version unless wantarray; return ($client_version, $client_version_full); } sub symbol_search { $::opt_s ||= $::opt_S; print "Searching for symbol '$::opt_s' in $OH ...\n"; my $dlext = $Config{dlext}; system(qq{ cd $OH; for i in lib/*.[ao] lib/*.$dlext */lib/*.[ao]; do echo " searching oracle \$i ..."; PATH=/usr/ccs/bin:\$PATH nm \$i | grep $::opt_s; done }); if ($::opt_S) { my @libpth = split ' ', $Config{libpth}; print "Searching for symbol '$::opt_s' in @libpth ...\n"; @libpth = map { ("$_/lib*.$dlext", "$_/lib*.a") } @libpth; system(qq{ cd $OH; for i in @libpth; do echo " searching \$i ..."; PATH=/usr/ccs/bin:\$PATH nm \$i | grep $::opt_s; done }); } print "Search done.\n"; print "(Please only include the 'interesting' parts when mailing.)\n"; exit; } # ===================================================================== { package MY; # SUPER needs package context, $self is not sufficient use strict; use Config; sub libscan { my($self, $path) = @_; return '' if $path =~ m/\.pl$/; $path; } sub post_initialize { my $self = shift; print "\nNote: \$ORACLE_HOME/lib must be added to your $need_ldlp_env environment variable\n", "before running \"make test\" and whenever DBD::Oracle is used.\n\n" if $need_ldlp_env && ($ENV{$need_ldlp_env}||'') !~ m:\Q$OH/lib\b:; eval { # This chunk is for Oracle::OCI require Data::Dumper; print main::MK_PM Data::Dumper->Purity(1)->Terse(0)->Indent(1)->Useqq(1) ->Dump([\%opts, $self], [qw(dbd_oracle_mm_opts dbd_oracle_mm_self)]); }; if ($@) { warn "Can't dump config to mk.pm so you won't be able to build Oracle::OCI later if you wanted to: $@\n"; print main::MK_PM qq{die "You need to reinstall DBD::Oracle after installing Data::Dumper\n"; }; } close main::MK_PM or die "Error closing mk.pm: $!\n"; foreach (qw(mk.pm Oracle.h dbdimp.h ocitrace.h)) { $self->{PM}->{$_} = '$(INST_ARCHAUTODIR)/'.$_; } # Add $linkwith to EXTRALIBS for those doing static linking $self->{EXTRALIBS} .= " -L\$(LIBHOME)"; $self->{EXTRALIBS} .= " $linkwith" if $linkwith; ''; } sub postamble { return main::dbd_postamble(@_); } sub const_loadlibs { my $self = shift; # ExtUtils::MM_Unix v1.50 (invoked by ExtUtils::MakeMaker) # requires that $self->{LD_RUN_PATH} be defined and not be # an empty string for Makefile to specify its use during the # build. This is required by both SUPER::const_loadlibs # and SUPER::dynamic_lib. hence it is best if we define # or modify $self->{LD_RUN_PATH} here *before* calling # SUPER::const_loadlibs. # edit LD_RUN_PATH ... my ($ldrp) = $self->{LD_RUN_PATH}; # remove redundant /lib or /usr/lib as it can cause problems $ldrp =~ s!:(/usr)?/lib$!! if $ldrp; # if it's empty then set it manually #Lincoln: if pick the right library path my $libdir = main::ora_libdir(); $ldrp ||= "$OH/$libdir:$OH/rdbms/$libdir"; $self->{LD_RUN_PATH} = $ldrp; local($_) = $self->SUPER::const_loadlibs(@_); print "Ignoring LD_RUN_PATH='$ENV{LD_RUN_PATH}' in environment\n" if $ENV{LD_RUN_PATH}; print "LD_RUN_PATH=$ldrp\n"; return $_; } sub post_constants { my $self = shift; return '' unless $::opt_f; # Oracle Definitions, based on $(ORACLE_HOME)/proc/lib/proc.mk ' ################################################################### # ORACLE_HOME = '.$OH.' # The following text has been extracted from '.join("\n#\t", '', @mkfiles).' '.$MK_TEXT.' # End of extract from '."@mkfiles".' # ################################################################### '; } sub const_cccmd { my ($self) = shift; print "Using DBD::Oracle $self->{VERSION}.\n"; local($_) = $self->SUPER::const_cccmd(@_); # If perl Makefile.PL *-g* then switch on debugging if ($::opt_g) { if ($^O eq "MSWin32" and $Config::Config{cc} eq 'cl') { s/\s-/ -Zi -/; s/-O1//; } else { s/\s-O\d?\b//; # delete optimise option s/\s-/ -g -/; # add -g option } } # are we using the non-bundled hpux compiler? if ($^O eq "hpux" and $Config::Config{ccflags} =~ /-Aa\b/) { print "Changing -Aa to -Ae for HP-UX in ccmd.\n" if s/-Aa\b/-Ae/g; # allow "long long" in oratypes.h } $_; } sub cflags { my ($self) = shift; local($_) = $self->SUPER::cflags(@_); # If perl Makefile.PL *-g* then switch on debugging if ($::opt_g) { if ($^O eq "MSWin32" and $Config::Config{cc} eq 'cl') { s/\s-/ -Zi -/; s/-O1//; } else { s/\s-O\d?\b//; # delete optimise option s/\s-/ -g -/; # add -g option } } # are we using the non-bundled hpux compiler? if ($^O eq "hpux" and $Config::Config{ccflags} =~ /-Aa\b/) { print "Changing -Aa to -Ae for HP-UX in cflags.\n" if s/-Aa\b/-Ae/g; # allow "long long" in oratypes.h } $_; } sub dynamic_lib { my($self) = shift; unless ($^O eq 'VMS') { my $m = $self->SUPER::dynamic_lib(@_); if ($^O eq 'darwin') { $m = "NMEDIT = nmedit\n" . $m . "\t\$(NMEDIT) -R ./hints/macos_bundle.syms \$(INST_DYNAMIC) || true\n"; } elsif (($^O eq 'hpux') and ($osvers <11)) { $m =~ s/LD_RUN_PATH=(\S+)\s+(\S+)/$2 -Wl,+b $1/; } return ($m); } # special code for VMS only my(%attribs) = @_; return '' unless $self->needs_linking(); #might be because of a subdir return '' unless $self->has_link_code(); my $OtherText; my($otherldflags) = $attribs{OTHERLDFLAGS} || ""; my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || ""; my @m; push @m, "OTHERLDFLAGS = $otherldflags\n"; push @m, "INST_DYNAMIC_DEP = $inst_dynamic_dep\n"; if ($] < 5.00450) { push @m, ' $(INST_DYNAMIC) : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt rtls.opt $(INST_ARCHAUTODIR).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP) $(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR) $(NOECHO) If F$TrnLNm("PerlShr").eqs."" Then Define/NoLog/User PerlShr Sys$Share:PerlShr.',$Config::Config{'dlext'},' Lnproc $(MMS$TARGET)$(OTHERLDFLAGS) $(BASEEXT).opt/Option,rtls.opt/Option,$(PERL_INC)perlshr_attr.opt/Option i '; } else { push @m, ' $(INST_DYNAMIC) : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt $(INST_ARCHAUTODIR).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP) $(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR) $(NOECHO) If F$TrnLNm("PerlShr").eqs."" Then Define/NoLog/User PerlShr Sys$Share:PerlShr.',$Config::Config{'dlext'},' Lnproc $(MMS$TARGET)$(OTHERLDFLAGS) $(BASEEXT).opt/Option,$(PERL_INC)perlshr_attr.opt/Option i '; } push @m, $self->dir_target('$(INST_ARCHAUTODIR)'); join('',@m); } } sub ldlibpth_info { my $verbose = shift; my ($ldlibpthname, $val); if ($^O eq "hpux") { # hpux is odd again: can use two env vars my @envs = grep { $ENV{$_} } qw( LD_LIBRARY_PATH SHLIB_PATH ); $ldlibpthname = join "/", @envs; $val = join $Config{path_sep}, @ENV{@envs} } else { $ldlibpthname = $Config{ldlibpthname} or return; $val = $ENV{$ldlibpthname} || ''; } print "Your $ldlibpthname env var is set to '$val'\n" if $verbose; return ( $ldlibpthname, $val, split /\Q$Config{path_sep}/, $val ); } sub check_ldlibpthname { my $libdir = shift || join '/', $OH, ora_libdir(); $libdir =~ s:[\\/]$::; # cut final / or \ my ($ldlibpthname, $val, @dirs) = ldlibpth_info(1); my $warn_name = $ldlibpthname; return 1 if grep { s:[\\/]$::; $_ eq $libdir } @dirs; # on solaris, it can be under LD_LIBRARY_PATH_(32|64) if ( $^O eq 'solaris' ) { my $ld_library_path_name = 'LD_LIBRARY_PATH_' . ( perl_is_64bit() ? '64' : '32' ); $warn_name .= " or $ld_library_path_name"; my @dirs = split quotemeta($Config{path_sep}), $ENV{$ld_library_path_name}; s#[\\/]$## for @dirs; # cut potential final / or \ return if grep { $_ eq $libdir } @dirs; } warn "WARNING: Your $warn_name env var doesn't include '$libdir' but probably needs to.\n"; } sub check_security { # check for the SUID/SGID bits on ORACLE_HOME/bin/oratclsh # if set, this allows a user to fork a root shell! # Get the octal portion of perms that indicates # SUID and SGID, and warn if either is set my @files = map { ($_,$_.'0') } qw( oratclsh lsnrctl oemevent onrsd osslogin tnslsnr tnsping trcasst trcroute cmctl cmadmin cmgw names namesctl otrccref otrcfmt otrcrep otrccol ); my @bad; foreach (@files) { my $file = "$ENV{ORACLE_HOME}/bin/$_"; my ($mode) = (stat($file))[2]; next unless defined $mode; push @bad, $file if ($mode & 04000 and $mode & 00111) or ($mode & 02000 and $mode & 00111); } return unless @bad; print "\n"; warn "*** WARNING - YOUR ORACLE INSTALLATION HAS A SECURITY PROBLEM.$BELL\n"; warn " Read the README.sec.txt file for more information and patch details.$BELL\n"; warn " This is just a warning. It does not affect DBD::Oracle in any way.\n\n"; sleep 6; } sub check_macos_symbol_table { # Check for symbol table problem in libclntsh.dylib.9.0 on MacOS X return unless $^O eq 'darwin'; my $oracle_lib = "$OH/lib/libclntsh.dylib"; return unless -f $oracle_lib; open my $nm_fh, '-|', "nm $oracle_lib" or die "couldn't run 'nm $oracle_lib': $!"; while ( <$nm_fh> ) { return if /^\s+U _(dlsym|dlclose)/; } warn <<"END_WARNING"; WARNING: symbol table may need modification in Oracle library: $oracle_lib If the build fails in the linking stage, manual modification is required - see README.macosx.txt END_WARNING return; } __END__ DBD-Oracle-1.74/MANIFEST0000644000175000017500000000321112326332111013677 0ustar yanickyanickCONTRIBUTING.mkd CONTRIBUTORS Changes INSTALL LICENSE MANIFEST META.json META.yml Makefile.PL Oracle.h Oracle.xs README README.help.txt README.mkdn Todo dbdimp.c dbdimp.h dbivport.h examples/README examples/bind.pl examples/commit.pl examples/curref.pl examples/ex.pl examples/inserting_longs.pl examples/japh examples/mktable.pl examples/ora_explain.pl examples/oradump.pl examples/proc.pl examples/read_long_via_blob_read.pl examples/sql examples/tabinfo.pl hints/dgux.pl hints/macos_bundle.syms hints/macos_lib.syms hints/macos_syms.pl hints/svr4.pl lib/DBD/Oracle.pm lib/DBD/Oracle/GetInfo.pm lib/DBD/Oracle/Object.pm lib/DBD/Oracle/Troubleshooting.pod lib/DBD/Oracle/Troubleshooting/Aix.pod lib/DBD/Oracle/Troubleshooting/Cygwin.pod lib/DBD/Oracle/Troubleshooting/Hpux.pod lib/DBD/Oracle/Troubleshooting/Linux.pod lib/DBD/Oracle/Troubleshooting/Macos.pod lib/DBD/Oracle/Troubleshooting/Sun.pod lib/DBD/Oracle/Troubleshooting/Vms.pod lib/DBD/Oracle/Troubleshooting/Win32.pod lib/DBD/Oracle/Troubleshooting/Win64.pod mkta.pl oci.def oci8.c ocitrace.h t/000-report-versions-tiny.t t/00versions.t t/01base.t t/10general.t t/12impdata.t t/14threads.t t/15nls.t t/20select.t t/21nchar.t t/22nchar_al32utf8.t t/22nchar_utf8.t t/23wide_db.t t/23wide_db_8bit.t t/23wide_db_al32utf8.t t/24implicit_utf8.t t/25plsql.t t/26exe_array.t t/28array_bind.t t/30long.t t/31lob.t t/31lob_extended.t t/32xmltype.t t/34pres_lobs.t t/36lob_leak.t t/38taf.t t/39attr.t t/40ph_type.t t/50cursor.t t/51scroll.t t/55nested.t t/56embbeded.t t/58object.t t/60reauth.t t/70meta.t t/80ora_charset.t t/lib/ExecuteArray.pm t/nchar_test_lib.pl t/rt13865.t t/rt74753-utf8-encoded.t t/rt85886.t typemap DBD-Oracle-1.74/ocitrace.h0000644000175000017500000007040712326332111014523 0ustar yanickyanick#ifndef DBD_OCI_TRACEON /* OCI functions "wrapped" to produce tracefile dumps (may be handy when giving diagnostic info to Oracle Support, or just learning about OCI) Macros are named "_log" as a mnemonic that they log to the tracefile if needed Macros named "_log_stat" return status in last parameter. */ #define DBD_OCI_TRACEON(h) (DBIc_DBISTATE(h)->debug >= 6 || dbd_verbose >= 6) #define DBD_OCI_TRACEFP(h) (DBIc_LOGPIO(h)) #define OciTp ("\tOCI") /* OCI Trace Prefix */ #define OciTstr(s) ((s) ? (text*)(s) : (text*)"") #define ul_t(v) ((unsigned long)(v)) #define pul_t(v) ((unsigned long *)(v)) #define sl_t(v) ((signed long)(v)) #define psl_t(v) ((signed long *)(v)) /* XXX TO DO 1. Add parenthesis around all macro args. (or do item 4 below case-by-case) DMG: Partly done, sort of. At least the types all match the doc'd casts, anyway. 2. #define a set of OciTxxx macros for different types of parameters that would allow a: casting to be hidden b: casting easily changed on different platforms (64bit etc) c: mapping of some type values to strings, d: return pointed-to value instead of pointer where applicable How to output arguments that are handles to opaque entities (OCIEnv*, etc)? Output of pointer address is a quick n' dirty way of identifying any number of handles that may be allocated.... yuck... It sure would be nice to give something more mnemonic! (and meaningful!) XXX Turn pointers into variable names by adding a prefix letter and, where appropriate an &, thus: "...,&p%ld,...", If done well the log will read like a compilable program. */ #define OCIServerRelease_log_stat(impdbh,sc,errhp,b,bl,ht,ver,stat) \ stat =OCIServerRelease(sc,errhp,b,bl,ht,ver);\ (DBD_OCI_TRACEON(impdbh)) \ ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \ "%sOCIServerRelease(%p)=%s\n",\ OciTp, sc,oci_status_name(stat)),stat \ : stat #define OCISessionRelease_log_stat(impdbh,svchp, errhp,stat) \ stat =OCISessionRelease(svchp, errhp, NULL, (ub4)0, OCI_DEFAULT);\ (DBD_OCI_TRACEON(impdbh)) \ ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \ "%sOCISessionRelease(svchp=%p)=%s\n",\ OciTp, svchp,oci_status_name(stat)),stat \ : stat #define OCISessionPoolDestroy_log_stat(impdbh, ph, errhp,stat ) \ stat =OCISessionPoolDestroy(ph, errhp,OCI_DEFAULT);\ (DBD_OCI_TRACEON(impdbh)) \ ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \ "%sOCISessionPoolDestroy(ph=%p)=%s\n",\ OciTp, ph,oci_status_name(stat)),stat \ : stat #define OCISessionGet_log_stat(impdbh,envhp, errhp, sh, ah,pn,pnl,stat) \ stat =OCISessionGet(envhp, errhp, sh, ah,pn,pnl,NULL,0, NULL, NULL, NULL, OCI_SESSGET_SPOOL);\ (DBD_OCI_TRACEON(impdbh)) \ ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \ "%sOCISessionGet(envhp=%p,sh=%p,ah=%p,pn=%p,pnl=%d)=%s\n",\ OciTp, envhp,sh,ah,pn,pnl,oci_status_name(stat)),stat \ : stat #define OCISessionPoolCreate_log_stat(impdbh,envhp,errhp,ph,pn,pnl,dbn,dbl,sn,sm,si,un,unl,pw,pwl,stat) \ stat =OCISessionPoolCreate(envhp,errhp,ph,pn,pnl,dbn,dbl,sn,sm,si,un,unl,pw,pwl,OCI_DEFAULT);\ (DBD_OCI_TRACEON(impdbh)) \ ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \ "%sOCISessionPoolCreate(envhp=%p,ph=%p,pn=%p,pnl=%p,min=%d,max=%d,incr=%d, un=%s,unl=%d,pw=%s,pwl=%d)=%s\n",\ OciTp, envhp,ph,pn,pnl,sn,sm,si,un,unl,pw,pwl,oci_status_name(stat)),stat \ : stat #if defined(ORA_OCI_102) #define OCIPing_log_stat(impdbh,sc,errhp,stat) \ stat =OCIPing(sc,errhp,OCI_DEFAULT);\ (DBD_OCI_TRACEON(impdbh)) \ ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \ "%sOCIPing(%p)=%s\n",\ OciTp, sc,oci_status_name(stat)),stat \ : stat #endif #define OCIServerVersion_log_stat(impdbh,sc,errhp,b,bl,ht,stat) \ stat =OCIServerVersion(sc,errhp,b,bl,ht);\ (DBD_OCI_TRACEON(impdbh)) \ ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \ "%sOCIServerVersion_log_stat(%p,%s)=%s\n",\ OciTp, sc,b,oci_status_name(stat)),stat \ : stat #define OCIStmtGetPieceInfo_log_stat(impsth,stmhp,errhp,hdlptr,hdltyp,in_out,iter,idx,piece,stat) \ stat =OCIStmtGetPieceInfo(stmhp,errhp,hdlptr,hdltyp,in_out,iter,idx,piece);\ (DBD_OCI_TRACEON(impsth)) \ ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \ "%sOCIStmtGetPieceInfo_log_stat(%p,%p,%u)=%s\n",\ OciTp, (void*)errhp,fbh,*piece,oci_status_name(stat)),stat \ : stat #define OCIStmtSetPieceInfo_log_stat(impsth,ptr,errhp,buf,blen,p,indp,rc,stat) \ stat =OCIStmtSetPieceInfo(ptr,OCI_HTYPE_DEFINE,errhp, buf, blen, p,indp,rc);\ (DBD_OCI_TRACEON(impsth)) \ ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \ "%sOCIStmtSetPieceInfo_log_stat(%p,%p,%d,%p)=%s\n",\ OciTp, (void*)errhp,fbh,piece,blen,oci_status_name(stat)),stat \ : stat #define OCIDefineDynamic_log_stat(impsth,defnp,errhp,fbh,stat) \ stat =OCIDefineDynamic(defnp,errhp,fbh,(OCICallbackDefine) presist_lob_fetch_cbk );\ (DBD_OCI_TRACEON(impsth)) \ ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \ "%sOCIDefineDynamic_log_stat(%p,%p,%p)=%s\n",\ OciTp, (void*)defnp, (void*)errhp,fbh,oci_status_name(stat)),stat \ : stat #define OCIXMLTypeCreateFromSrc_log_stat(impdbh,svchp,errhp,duration,src_type,src_ptr,ind,xml,stat) \ stat =OCIXMLTypeCreateFromSrc (svchp,errhp,duration,(ub1)src_type,(dvoid *)src_ptr,(sb4)ind, xml);\ (DBD_OCI_TRACEON(impdbh)) \ ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \ "%sOCIXMLTypeCreateFromSrc_log_stat(%p,%p,%d,%d,%p,%d,%p)=%s\n",\ OciTp, (void*)svchp,(void*)errhp, duration, src_type, src_ptr, ind, xml, oci_status_name(stat)),stat \ : stat #define OCILobFileIsOpen_log_stat(impdbh,envhp,errhp,loc,is_open,stat) \ stat = OCILobFileIsOpen(envhp,errhp,loc,is_open);\ (DBD_OCI_TRACEON(impdbh)) \ ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \ "%sOCILobFileIsOpen_log_stat(%p,%p,%p,%p,%d)=%s\n",\ OciTp, (void*)envhp, (void*)errhp, loc, is_open, *is_open,oci_status_name(stat)),stat : stat #define OCILobLocatorIsInit_log_stat(impdbh,envhp,errhp,loc,is_initp,stat) \ stat =OCILobLocatorIsInit (envhp,errhp,loc,is_initp );\ (DBD_OCI_TRACEON(impdbh)) \ ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \ "%sOCILobLocatorIsInit_log_stat(%p,%p,%p,%d)=%s\n",\ OciTp, (void*)envhp, (void*)errhp,loc,*is_initp,oci_status_name(stat)),stat \ : stat #define OCIObjectPin_log_stat(impsth,envhp,errhp,or,ot,stat) \ stat = OCIObjectPin(envhp,errhp,or,(OCIComplexObject *)0,OCI_PIN_LATEST,OCI_DURATION_TRANS,OCI_LOCK_NONE,ot);\ (DBD_OCI_TRACEON(impsth)) \ ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \ "%sObjectPin_log_stat(%p,%p,%p,%p)=%s\n",\ OciTp, (void*)envhp, (void*)errhp,or,ot,oci_status_name(stat)),stat \ : stat /* #define OCICollGetElem_log_stat(envhp,errhp,v,i,ex,e,ne,stat)\ stat = OCICollGetElem(envhp,errhp, v,i,ex,e,ne);\ (DBD_OCI_TRACEON) \ ? PerlIO_printf(DBD_OCI_TRACEFP,\ "%sOCICollGetElem_log_stat(%p,%p,%d,%d,%d,%d,%d)=%s\n",\ OciTp, (void*)envhp, (void*)errhp,v,i,ex,e,ne,oci_status_name(stat)),stat \ : stat */ /* #define OCITableFirst_log_stat(envhp,errhp,v,i,stat)\ stat = OCITableFirst(envhp,errhp,v,i);\ (DBD_OCI_TRACEON) \ ? PerlIO_printf(DBD_OCI_TRACEFP,\ "%sOCITableFirst_log_stat(%p,%p,%d,%d)=%s\n",\ OciTp, (void*)envhp, (void*)errhp,v,i,oci_status_name(stat)),stat \ : stat */ #define OCIObjectGetAttr_log_stat(impsth,envhp,errhp,instance,nullstruct,tdo,names,lengths,namecount,indexes,indexcount,attrnullstatus,attrnullstruct,attrvalue, attrtdo, stat) \ stat = OCIObjectGetAttr(envhp,errhp,instance,nullstruct,tdo,names,lengths,namecount,indexes,indexcount,attrnullstatus,attrnullstruct,attrvalue,attrtdo); \ (DBD_OCI_TRACEON(impsth)) \ ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \ "%sOCIObjectGetAttr_log_stat(%p,%p,%p,%p,%p,%p,%p,%d,%p,%d,%p,%p,%p,%p)=%s\n",\ OciTp, (void*)envhp,(void*)errhp,instance,nullstruct,tdo,names,lengths,namecount,indexes,indexcount,attrnullstatus,attrnullstruct,attrvalue,attrtdo,oci_status_name(stat)),stat \ : stat #define OCIIntervalToText_log_stat(impsth,envhp,errhp,di,sb,ln,sl,stat) \ stat = OCIIntervalToText(envhp,errhp, *(OCIInterval**)di,3,3,sb,ln,sl);\ (DBD_OCI_TRACEON(impsth)) \ ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \ "%sOCIIntervalToText(%p,%p,%p,%s)=%s\n",\ OciTp, (void*)errhp, di,sl,sb,oci_status_name(stat)),stat \ : stat #define OCIDateTimeToText_log_stat(impsth,envhp,errhp,d,sl,sb,stat) \ stat = OCIDateTimeToText(envhp,errhp, *(OCIDateTime**)d,(CONST text*) 0,(ub1) 0,6, (CONST text*) 0, (ub4) 0,(ub4 *)sl,sb );\ (DBD_OCI_TRACEON(impsth)) \ ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \ "%sOCIDateTimeToText(%p,%p,%p,%s)=%s\n",\ OciTp, (void*)errhp, d,sl,sb,oci_status_name(stat)),stat \ : stat #define OCIDateToText_log_stat(impsth,errhp,d,sl,sb,stat) \ stat = OCIDateToText(errhp, (CONST OCIDate *) d,(CONST text*) 0,(ub1) 0, (CONST text*) 0, (ub4) 0,(ub4 *)sl,sb );\ (DBD_OCI_TRACEON(impsth)) \ ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \ "%sDateToText_log_stat(%p,%p,%p,%s)=%s\n",\ OciTp, (void*)errhp, d,sl,sb,oci_status_name(stat)),stat \ : stat #define OCIIterDelete_log_stat(impsth,envhp,errhp,itr,stat) \ stat = OCIIterDelete(envhp,errhp,itr );\ (DBD_OCI_TRACEON(impsth)) \ ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \ "%sOCIIterDelete_log_stat(%p,%p,%p)=%s\n",\ OciTp, (void*)envhp, (void*)errhp,itr,oci_status_name(stat)),stat \ : stat #define OCIIterCreate_log_stat(impsth,envhp,errhp,coll,itr,stat) \ stat = OCIIterCreate(envhp,errhp,coll,itr);\ (DBD_OCI_TRACEON(impsth)) \ ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \ "%sIterCreate_log_stat(%p,%p,%p)=%s\n",\ OciTp, (void*)envhp, (void*)errhp,(void*)coll,oci_status_name(stat)),stat \ : stat /* #define OCICollSize_log_stat(envhp,errhp,coll,coll_siz,stat)\ stat = OCICollSize(envhp,errhp,(CONST OCIColl *)coll,coll_siz);\ (DBD_OCI_TRACEON) \ ? PerlIO_printf(DBD_OCI_TRACEFP,\ "%sOCICollSize_log_stat(%p,%p,%d)=%s\n",\ OciTp, (void*)envhp, (void*)errhp,oci_status_name(stat)),stat \ : stat */ #define OCIDefineObject_log_stat(impsth,defnp,errhp,tdo,eo_buff,eo_ind,stat) \ stat = OCIDefineObject(defnp,errhp,tdo,eo_buff,0,eo_ind, 0);\ (DBD_OCI_TRACEON(impsth)) \ ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \ "%sOCIDefineObject(%p,%p,%p)=%s\n",\ OciTp, (void*)defnp, (void*)errhp, (void*)tdo,oci_status_name(stat)),stat \ : stat #define OCITypeByName_log(impsth,envhp,errhp,svchp,sn,snl,tn,tnl,vn,vnl,duration,option,tdo,stat) \ stat = OCITypeByName(envhp,errhp,svchp,sn,snl,tn,tnl,vn,vnl,duration,option,tdo); \ (DBD_OCI_TRACEON(impsth)) \ ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \ "%sTypeByName(%p,%p,%p,%s,%d,%s,%d,\"\",0,%d,%d,%p)=%s\n", \ OciTp, (void*)envhp, (void*)errhp, (void*)svchp, sn,snl,tn,tnl,duration,option,tdo,oci_status_name(stat)), stat \ :stat #define OCITypeByRef_log_stat(impsth,envhp,errhp,ref,tdo,stat) \ stat = OCITypeByRef(envhp,errhp,ref,OCI_DURATION_TRANS,OCI_TYPEGET_ALL,tdo);\ (DBD_OCI_TRACEON(impsth)) \ ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \ "%sTypeByRef(%p,%p,%p)=%s\n",\ OciTp, (void*)envhp, (void*)errhp, (void*)ref,oci_status_name(stat)),stat \ : stat /* added by lab */ #define OCILobCharSetId_log_stat(impxxh, envhp, errhp, locp, csidp, stat ) \ stat = OCILobCharSetId( envhp, errhp, locp, csidp ); \ (DBD_OCI_TRACEON(impxxh)) \ ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \ "%sLobCharSetId(%p,%p,%p,%d)=%s\n",\ OciTp, (void*)envhp, (void*)errhp, (void*)locp, *csidp, oci_status_name(stat)),stat \ : stat /* added by lab */ #define OCILobCharSetForm_log_stat(impxxh, envhp, errhp, locp, formp, stat ) \ stat = OCILobCharSetForm( envhp, errhp, locp, formp ); \ (DBD_OCI_TRACEON(impxxh)) \ ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \ "%sLobCharSetForm(%p,%p,%p,%d)=%s\n",\ OciTp, (void*)envhp, (void*)errhp, (void*)locp, *formp, oci_status_name(stat)),stat \ : stat /* added by lab */ #define OCINlsEnvironmentVariableGet_log_stat(impdbh, valp, size, item, charset, rsizep ,stat ) \ stat = OCINlsEnvironmentVariableGet( valp, size, item, charset, rsizep ); \ (DBD_OCI_TRACEON(impdbh)) \ ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \ "%sNlsEnvironmentVariableGet(%d,%lu,%d,%d,%lu)=%s\n",\ OciTp, *valp, (unsigned long)size, item, charset, (unsigned long)*rsizep, oci_status_name(stat)),stat \ : stat /* added by lab */ #define OCIEnvNlsCreate_log_stat(impdbh, envp, mode, ctxp, f1, f2, f3, sz, usremepp ,chset, nchset ,stat ) \ stat = OCIEnvNlsCreate(envp, mode, ctxp, f1, f2, f3, sz, usremepp ,chset, nchset ); \ (DBD_OCI_TRACEON(impdbh)) \ ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \ "%sEnvNlsEnvCreate(%p,%s,%d,%d,%p,%p,%p,%d,%p,%d,%d)=%s\n", \ OciTp, (void*)envp, oci_mode(mode),mode, ctxp, (void*)f1, (void*)f2, (void*)f3, sz, (void*)usremepp ,chset, nchset, oci_status_name(stat)),stat \ : stat #define OCIAttrGet_log_stat(impxxh, th,ht,ah,sp,at,eh,stat) \ stat = OCIAttrGet(th,ht,ah,sp,at,eh); \ (DBD_OCI_TRACEON(impxxh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \ "%sAttrGet(%p,%s,%p,%p,%s,%p)=%s\n", \ OciTp, (void*)th,oci_hdtype_name(ht),(void*)ah,pul_t(sp),oci_attr_name(at),(void*)eh,\ oci_status_name(stat)),stat : stat #define OCIAttrGet_d_log_stat(impsth, th,ht,ah,sp,at,eh,stat) \ stat = OCIAttrGet(th,ht,ah,sp,at,eh); \ (DBD_OCI_TRACEON(impsth)) ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \ "%sAttrGet(%p,%s,%p,%p,%s,%p)=%s\n", \ OciTp, (void*)th,oci_hdtype_name(ht),(void*)ah,pul_t(sp),oci_dtype_attr_name(at),(void*)eh,\ oci_status_name(stat)),stat : stat #define OCIAttrGet_parmap(imp_sth,dh, ht, p1, l, stat) \ OCIAttrGet_log_stat(imp_sth, dh, ht, \ (void*)(p1), (l), OCI_ATTR_PARAM, imp_sth->errhp, stat) #define OCIAttrGet_parmdp(imp_sth, parmdp, p1, l, a, stat) \ OCIAttrGet_d_log_stat(imp_sth, parmdp, OCI_DTYPE_PARAM, \ (void*)(p1), (l), (a), imp_sth->errhp, stat) #define OCIAttrGet_stmhp_stat(imp_sth, p1, l, a, stat) \ OCIAttrGet_log_stat(imp_sth, imp_sth->stmhp, OCI_HTYPE_STMT, \ (void*)(p1), (l), (a), imp_sth->errhp, stat) #define OCIAttrGet_stmhp_stat2(imp_sth, stmhp, p1, l, a, stat) \ OCIAttrGet_log_stat(imp_sth, stmhp, OCI_HTYPE_STMT, \ (void*)(p1), (l), (a), imp_sth->errhp, stat) #define OCIAttrSet_log_stat(impxxh,th,ht,ah,s1,a,eh,stat) \ stat=OCIAttrSet(th,ht,ah,s1,a,eh); \ (DBD_OCI_TRACEON(impxxh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \ "%sAttrSet(%p,%s, %p,%lu,Attr=%s,%p)=%s\n", \ OciTp, (void*)th,oci_hdtype_name(ht),(void *)ah,ul_t(s1),oci_attr_name(a),(void*)eh, \ oci_status_name(stat)),stat : stat #define OCIBindByName_log_stat(impsth,sh,bp,eh,p1,pl,v,vs,dt,in,al,rc,mx,cu,md,stat) \ stat=OCIBindByName(sh,bp,eh,p1,pl,v,vs,dt,in,al,rc,mx,cu,md); \ (DBD_OCI_TRACEON(impsth)) ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \ "%sBindByName(%p,%p,%p,\"%s\",placeh_len=%ld,value_p=%p,value_sz=%ld," \ "dty=%u,indp=%p,alenp=%p,rcodep=%p,maxarr_len=%lu,curelep=%p (*=%d),mode=%s,%lu)=%s\n",\ OciTp, (void*)sh,(void*)bp,(void*)eh,p1,sl_t(pl),(void*)(v), \ sl_t(vs),(ub2)(dt),(void*)(in),(ub2*)(al),(ub2*)(rc), \ ul_t((mx)),pul_t((cu)),(cu ? *(int*)cu : 0 ) ,oci_bind_options(md),ul_t((md)), \ oci_status_name(stat)),stat : stat #define OCIBindArrayOfStruct_log_stat(impsth,bp,ep,sd,si,sl,sr,stat) \ stat=OCIBindArrayOfStruct(bp,ep,sd,si,sl,sr); \ (DBD_OCI_TRACEON(impsth)) ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \ "%sOCIBindArrayOfStruct(%p,%p,%u,%u,%u,%u)=%s\n", \ OciTp,(void*)bp,(void*)ep,sd,si,sl,sr, \ oci_status_name(stat)),stat : stat #define OCIBindDynamic_log(impsth,bh,eh,icx,cbi,ocx,cbo,stat) \ stat=OCIBindDynamic(bh,eh,icx,cbi,ocx,cbo); \ (DBD_OCI_TRACEON(impsth)) ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \ "%sBindDynamic(%p,%p,%p,%p,%p,%p)=%s\n", \ OciTp, (void*)bh,(void*)eh,(void*)icx,(void*)cbi, \ (void*)ocx,(void*)cbo, \ oci_status_name(stat)),stat : stat #define OCIDefineByPos_log_stat(impsth,sh,dp,eh,p1,vp,vs,dt,ip,rp,cp,m,stat) \ stat=OCIDefineByPos(sh,dp,eh,p1,vp,vs,dt,ip,rp,cp,m); \ (DBD_OCI_TRACEON(impsth)) ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \ "%sDefineByPos(%p,%p,%p,%lu,%p,%ld,%u,%p,%p,%p,mode=%s,%lu)=%s\n", \ OciTp, (void*)sh,(void*)dp,(void*)eh,ul_t((p1)),(void*)(vp), \ sl_t(vs),(ub2)dt,(void*)(ip),(ub2*)(rp),(ub2*)(cp),oci_define_options(m),ul_t(m), \ oci_status_name(stat)),stat : stat #define OCIDescribeAny_log_stat(impsth,sh,eh,op,ol,opt,il,ot,dh,stat) \ stat=OCIDescribeAny(sh,eh,op,ol,opt,il,ot,dh); \ (DBD_OCI_TRACEON(impsth)) ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \ "%sDescribeAny(%p,%p,%p,%lu,%u,%u,%u,%p)=%s\n", \ OciTp, (void*)sh,(void*)eh,(void*)op,ul_t(ol), \ (ub1)opt,(ub1)il,(ub1)ot,(void*)dh, \ oci_status_name(stat)),stat : stat #define OCIDescriptorAlloc_ok(impxxh,envhp, p1, t) \ if (DBD_OCI_TRACEON(impxxh)) PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \ "%sDescriptorAlloc(%p,%p,%s,0,0)\n", \ OciTp,(void*)envhp,(void*)(p1),oci_hdtype_name(t)); \ if (OCIDescriptorAlloc((envhp), (void**)(p1), (t), 0, 0)==OCI_SUCCESS); \ else croak("OCIDescriptorAlloc (type %d) failed",t) #define OCIDescriptorFree_log(impxxh,d,t) \ if (DBD_OCI_TRACEON(impxxh)) PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \ "%sDescriptorFree(%p,%s)\n", OciTp, (void*)d,oci_hdtype_name(t)); \ OCIDescriptorFree(d,t) #define OCIEnvInit_log_stat(impdbh,ev,md,xm,um,stat) \ stat=OCIEnvInit(ev,md,xm,um); \ (DBD_OCI_TRACEON(impdbh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \ "%sEnvInit(%p,%lu,%lu,%p)=%s\n", \ OciTp, (void*)ev,ul_t(md),ul_t(xm),(void*)um, \ oci_status_name(stat)),stat : stat #define OCIErrorGet_log_stat(impxxh, hp,rn,ss,ep,bp,bs,t, stat) \ ((stat = OCIErrorGet(hp,rn,ss,ep,bp,bs,t)), \ ((DBD_OCI_TRACEON(impxxh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \ "%sErrorGet(%p,%lu,\"%s\",%p,\"%s\",%lu,%lu)=%s\n", \ OciTp, (void*)hp,ul_t(rn),OciTstr(ss),psl_t(ep), \ bp,ul_t(bs),ul_t(t), oci_status_name(stat)),stat : stat)) #define OCIHandleAlloc_log_stat(impxxh,ph,hp,t,xs,ump,stat) \ stat=OCIHandleAlloc(ph,hp,t,xs,ump); \ (DBD_OCI_TRACEON(impxxh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \ "%sHandleAlloc(%p,%p,%s,%lu,%p)=%s\n", \ OciTp, (void*)ph,(void*)hp,oci_hdtype_name(t),ul_t(xs),(void*)ump, \ oci_status_name(stat)),stat : stat #define OCIHandleAlloc_ok(impxxh,envhp, p1, t, stat) \ OCIHandleAlloc_log_stat(impxxh,(envhp),(void**)(p1),(t),0,0, stat); \ if (stat==OCI_SUCCESS) ; \ else croak("OCIHandleAlloc(%s) failed",oci_hdtype_name(t)) #define OCIHandleFree_log_stat(impxxh,hp,t,stat) \ stat=OCIHandleFree( (hp), (t)); \ (DBD_OCI_TRACEON(impxxh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \ "%sHandleFree(%p,%s)=%s\n",OciTp,(void*)hp,oci_hdtype_name(t), \ oci_status_name(stat)),stat : stat #define OCILobGetLength_log_stat(impxxh,sh,eh,lh,l,stat) \ stat=OCILobGetLength(sh,eh,lh,l); \ (DBD_OCI_TRACEON(impxxh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \ "%sLobGetLength(%p,%p,%p,%p)=%s\n", \ OciTp, (void*)sh,(void*)eh,(void*)lh,pul_t(l), \ oci_status_name(stat)),stat : stat #define OCILobGetChunkSize_log_stat(impdbh,sh,eh,lh,cs,stat) \ stat=OCILobGetChunkSize(sh,eh,lh,cs); \ (DBD_OCI_TRACEON(impdbh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \ "%sLobGetChunkSize(%p,%p,%p,%p)=%s\n", \ OciTp, (void*)sh,(void*)eh,(void*)lh,pul_t(cs), \ oci_status_name(stat)),stat : stat #define OCILobFileOpen_log_stat(impxxh,sv,eh,lh,mode,stat) \ stat=OCILobFileOpen(sv,eh,lh,mode); \ (DBD_OCI_TRACEON(impxxh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \ "%sLobFileOpen(%p,%p,%p,%u)=%s\n", \ OciTp, (void*)sv,(void*)eh,(void*)lh,(ub1)mode, \ oci_status_name(stat)),stat : stat #define OCILobFileClose_log_stat(impsth,sv,eh,lh,stat) \ stat=OCILobFileClose(sv,eh,lh); \ (DBD_OCI_TRACEON(impsth)) ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \ "%sLobFileClose(%p,%p,%p)=%s\n", \ OciTp, (void*)sv,(void*)eh,(void*)lh, \ oci_status_name(stat)),stat : stat /*Added by JPS for Jeffrey.Klein*/ #define OCILobCreateTemporary_log_stat(impdbh,sv,eh,lh,csi,csf,lt,ca,dur,stat) \ stat=OCILobCreateTemporary(sv,eh,lh,csi,csf,lt,ca,dur); \ (DBD_OCI_TRACEON(impdbh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \ "%sLobCreateTemporary(%p,%p,%p,%lu,%lu,%lu,%lu,%lu)=%s\n", \ OciTp, (void*)sv,(void*)eh,(void*)lh, \ ul_t(csi),ul_t(csf),ul_t(lt),ul_t(ca),ul_t(dur), \ oci_status_name(stat)),stat : stat /*end add*/ #define OCILobFreeTemporary_log_stat(impxxh,sv,eh,lh,stat) \ stat=OCILobFreeTemporary(sv,eh,lh); \ (DBD_OCI_TRACEON(impxxh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \ "%sLobFreeTemporary(%p,%p,%p)=%s\n", \ OciTp, (void*)sv,(void*)eh,(void*)lh, \ oci_status_name(stat)),stat : stat #define OCILobIsTemporary_log_stat(impsth,ev,eh,lh,istemp,stat) \ stat=OCILobIsTemporary(ev,eh,lh,istemp); \ (DBD_OCI_TRACEON(impsth)) ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \ "%sLobIsTemporary(%p,%p,%p,%p)=%s\n", \ OciTp, (void*)ev,(void*)eh,(void*)lh,(void*)istemp, \ oci_status_name(stat)),stat : stat /*Added by JPS for Jeffrey.Klein */ #define OCILobLocatorAssign_log_stat(impdbh,sv,eh,src,dest,stat) \ stat=OCILobLocatorAssign(sv,eh,src,dest); \ (DBD_OCI_TRACEON(impdbh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \ "%sLobLocatorAssign(%p,%p,%p,%p)=%s\n", \ OciTp,(void*)sv,(void*)eh,(void*)src,(void*)dest, \ oci_status_name(stat)),stat : stat /*end add*/ #define OCILobRead_log_stat(impxxh,sv,eh,lh,am,of,bp,bl,cx,cb,csi,csf,stat) \ stat=OCILobRead(sv,eh,lh,am,of,bp,bl,cx,cb,csi,csf); \ (DBD_OCI_TRACEON(impxxh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \ "%sLobRead(%p,%p,%p,%p,%lu,%p,%lu,%p,%p,%u,%u)=%s\n", \ OciTp, (void*)sv,(void*)eh,(void*)lh,pul_t(am),ul_t(of), \ (void*)bp,ul_t(bl),(void*)cx,(void*)cb,(ub2)csi,(ub1)csf, \ oci_status_name(stat)),stat : stat #define OCILobTrim_log_stat(impxxh,sv,eh,lh,l,stat) \ stat=OCILobTrim(sv,eh,lh,l); \ (DBD_OCI_TRACEON(impxxh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \ "%sLobTrim(%p,%p,%p,%lu)=%s\n", \ OciTp, (void*)sv,(void*)eh,(void*)lh,ul_t(l), \ oci_status_name(stat)),stat : stat #define OCILobWrite_log_stat(impxxh,sv,eh,lh,am,of,bp,bl,p1,cx,cb,csi,csf,stat) \ stat=OCILobWrite(sv,eh,lh,am,of,bp,bl,p1,cx,cb,csi,csf); \ (DBD_OCI_TRACEON(impxxh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \ "%sLobWrite(%p,%p,%p,%p,%lu,%p,%lu,%u,%p,%p,%u,%u)=%s\n", \ OciTp, (void*)sv,(void*)eh,(void*)lh,pul_t(am),ul_t(of), \ (void*)bp,ul_t(bl),(ub1)p1, \ (void*)cx,(void*)cb,(ub2)csi,(ub1)csf, \ oci_status_name(stat)),stat : stat #define OCILobWriteAppend_log_stat(impxxh,sv,eh,lh,am,bp,bl,p1,cx,cb,csi,csf,stat) \ stat=OCILobWriteAppend(sv,eh,lh,am,bp,bl,p1,cx,cb,csi,csf); \ (DBD_OCI_TRACEON(impxxh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \ "%sLobWriteAppend(%p,%p,%p,%p,%p,%lu,%u,%p,%p,%u,%u)=%s\n", \ OciTp, (void*)sv,(void*)eh,(void*)lh,pul_t(am), \ (void*)bp,ul_t(bl),(ub1)p1, \ (void*)cx,(void*)cb,(ub2)csi,(ub1)csf, \ oci_status_name(stat)),stat : stat #define OCIParamGet_log_stat(impsth,hp,ht,eh,pp,ps,stat) \ stat=OCIParamGet(hp,ht,eh,pp,ps); \ (DBD_OCI_TRACEON(impsth)) ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \ "%sParamGet(%p,%lu,%p,%p,%lu,%s)=%s\n", \ OciTp, (void*)hp,ul_t((ht)),(void*)eh,(void*)pp,ul_t(ps), \ oci_hdtype_name(ht),oci_status_name(stat)),stat : stat #define OCIServerAttach_log_stat(imp_dbh, dbname,md,stat) \ stat=OCIServerAttach( imp_dbh->srvhp, imp_dbh->errhp, \ (text*)dbname, (sb4)strlen(dbname), md); \ (DBD_OCI_TRACEON(imp_dbh)) ? PerlIO_printf(DBD_OCI_TRACEFP(imp_dbh), \ "%sServerAttach(%p, %p, \"%s\", %lu, mode=%s,%lu)=%s\n", \ OciTp, (void*)imp_dbh->srvhp,(void*)imp_dbh->errhp, dbname, \ ul_t(strlen(dbname)), oci_mode(md),ul_t(md),oci_status_name(stat)),stat : stat #define OCIStmtExecute_log_stat(impsth,sv,st,eh,i,ro,si,so,md,stat) \ stat=OCIStmtExecute(sv,st,eh,i,ro,si,so,md); \ (DBD_OCI_TRACEON(impsth)) ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \ "%sStmtExecute(%p,%p,%p,%lu,%lu,%p,%p,mode=%s,%lu)=%s\n", \ OciTp, (void*)sv,(void*)st,(void*)eh,ul_t((i)), \ ul_t((ro)),(void*)(si),(void*)(so),oci_exe_mode(md),ul_t((md)), \ oci_status_name(stat)),stat : stat #define OCIStmtFetch_log_stat(impsth,sh,eh,nr,or,os,stat) \ stat=OCIStmtFetch2(sh,eh,nr,or,os,OCI_DEFAULT); \ (DBD_OCI_TRACEON(impsth)) ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \ "%sStmtFetch(%p,%p,%lu,%u,%d)=%s\n", \ OciTp, (void*)sh,(void*)eh,ul_t(nr),(ub2)or,(ub2)os, \ oci_status_name(stat)),stat : stat #define OCIStmtPrepare_log_stat(impsth,sh,eh,s1,sl,l,m,stat) \ stat=OCIStmtPrepare(sh,eh,s1,sl,l,m); \ (DBD_OCI_TRACEON(impsth)) ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \ "%sStmtPrepare(%p,%p,'%s',%lu,%lu,%lu)=%s\n", \ OciTp, (void*)sh,(void*)eh,s1,ul_t(sl),ul_t(l),ul_t(m), \ oci_status_name(stat)),stat : stat #define OCIServerDetach_log_stat(impdbh,sh,eh,md,stat) \ stat=OCIServerDetach(sh,eh,md); \ (DBD_OCI_TRACEON(impdbh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \ "%sServerDetach(%p,%p,mode=%s,%lu)=%s\n", \ OciTp, (void*)sh,(void*)eh,oci_mode(md),ul_t(md), \ oci_status_name(stat)),stat : stat #define OCISessionBegin_log_stat(impdbh,sh,eh,uh,cr,md,stat) \ stat=OCISessionBegin(sh,eh,uh,cr,md); \ (DBD_OCI_TRACEON(impdbh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \ "%sSessionBegin(%p,%p,%p,%lu,mode=%s %lu)=%s\n", \ OciTp, (void*)sh,(void*)eh,(void*)uh,ul_t(cr),oci_mode(md),ul_t(md), \ oci_status_name(stat)),stat : stat #define OCISessionEnd_log_stat(impdbh,sh,eh,ah,md,stat) \ stat=OCISessionEnd(sh,eh,ah,md); \ (DBD_OCI_TRACEON(impdbh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \ "%sSessionEnd(%p,%p,%p,mode=%s %lu)=%s\n", \ OciTp, (void*)sh,(void*)eh,(void*)ah,oci_mode(md),ul_t(md), \ oci_status_name(stat)),stat : stat #define OCITransCommit_log_stat(impxxh,sh,eh,md,stat) \ stat=OCITransCommit(sh,eh,md); \ (DBD_OCI_TRACEON(impxxh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \ "%sTransCommit(%p,%p,%lu)=%s\n", \ OciTp, (void*)sh,(void*)eh,ul_t(md), \ oci_status_name(stat)),stat : stat #define OCITransRollback_log_stat(impdbh,sh,eh,md,stat) \ stat=OCITransRollback(sh,eh,md); \ (DBD_OCI_TRACEON(impdbh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \ "%sTransRollback(%p,%p,mode=%s %lu)=%s\n", \ OciTp, (void*)sh,(void*)eh,oci_mode(md),ul_t(md), \ oci_status_name(stat)),stat : stat #define OCIDBStartup_log_stat(impdbh,svchp,errhp,admhp,mode,flags,stat) \ stat=OCIDBStartup(svchp,errhp,admhp,mode,flags); \ (DBD_OCI_TRACEON(impdbh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \ "%sOCIDBStartup(%p,%p,%p,%u,%u)=%s\n", \ OciTp, (void*)svchp,(void*)errhp,(void*)admhp,mode,flags, \ oci_status_name(stat)),stat : stat #define OCIDBShutdown_log_stat(impdbh,svchp,errhp,admhp,mode,stat) \ stat=OCIDBShutdown(svchp,errhp,admhp,mode); \ (DBD_OCI_TRACEON(impdbh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \ "%sOCIDBShutdown(%p,%p,%p,%u)=%s\n", \ OciTp, (void*)svchp,(void*)errhp,(void*)admhp,mode, \ oci_status_name(stat)),stat : stat #endif /* !DBD_OCI_TRACEON */ DBD-Oracle-1.74/Changes0000644000175000017500000023761112326332111014056 0ustar yanickyanickRevision history for DBD::Oracle 1.74 2014-04-24 - Promote to stable. 1.73_01 2014-04-23 - Tweak fix for RT-88185. (GH#14, Martin J. Evans) 1.73_00 2014-04-23 - Reverts current fix for RT-88185, as it causes breakage. (GH#14) 1.72 2014-04-14 - promote 1.71_00 to stable. 1.71_00 2014-03-31 - Recognizes __CYGWIN64__. (RT88709, reported by Witold Petriczek) - CHOOSE hint is deprecated. (RT91217, reported by Andy Bucksch, fix by Martin J Evans) - Set UTF8 flag per-connection. (RT88185, reported by Heinrich Mislik, patch by Martin J. Evans) - Add a CONTRIBUTING.mkd file. (GH#2) - Add SELinux trick. (RT#87003, patch submitted by Mike Doherty) 1.70 2014-02-12 - promote 1.69_02 to stable. 1.69_02 2014-01-19 [IMPROVEMENTS] - The DSN 'dbi:Oracle:sid=foo' is now an alias for 'dbi:Oracle:foo'. (RT#91775, Yanick Champoux, requested by David Wheeler) - Support for ORA_SYSBACKUP, ORA_SYSDG and ORA_SYSKM. (RT#91473, Kris Lemaire) [BUG FIXES] - OCI_THREADED setting had been accidentally removed, causing potential crashes when using threads. (RT#92229, Martin J. Evans, reported by Detlef Lütticke) - When using fetch*_hashref the values are decoded but not the keys so if you have unicode column names they were not returned correctly. (RT#92134, Martin J. Evans, reported by Marcel Montes) 1.69_01 2014-01-14 [BUG FIXES] - Fix RT91698. If you bound an output parameter to a scalar and repeatedly called execute the memory allocated in your bound scalar could increase each time. (Martin J. Evans) 1.68 2013-11-25 - promote 1.67_00 to stable. 1.67_00 2013-11-05 [BUG FIXES] - Fix RT88135. Add statistics_info support (patch by Steffen Goeldner) - Fix RT89491. Add RULE hint (patch by Steffen Goeldner) [DOCUMENTATION] - POD typos (RT#88285, RT#88284, Gregor Herrman). - Grooming of Hpux troubleshooting pod (GH#7, Martin J. Evans, Yanick Champoux) 1.66 2013-08-23 - promote 1.65_00 to stable. 1.65_00 2013-07-29 [BUG FIXES] - Fix RT85886. The TYPE passed to bind_col is supposed to be sticky and it wasn't. Attributes passed to bind_col could be lost later if bind_col is called again without attributes. Both of these occur when fetchall_arrayref is called with a slice (Martin J. Evans). [DOCUMENTATION] - Fix a bunch of typos. [GH#5, David Steinbrunner] 1.64 2013-05-22 - promote 1.63_00 to stable. 1.63_00 2013-05-03 [ENHANCEMENTS] - DBD-Oracle: Use of uninitialized value $user_only in uc [RT#84657] (Steffen Goeldner) [BUG FIXES] - Make 50cursor.t Oracle8-friendly. (RT#84660, patch by Steffen Goeldner) - Makefile.PL's use of ACL tweaked for Suse Enterprise 11 SP2 (RT#84530, patch by Alfred Nathaniel) [DOCUMENTATION] - Bogus 227 directory no longer required for MacOS. (GH#1, patch by theory) 1.62 2013-04-30 - promote 1.61_00 to official release 1.61_00 2013-04-15 [BUG FIXES] - Adjust the privs needed for the DROP/CREATE table test. [GH#35] (Joe Crotty) - Fixed RT84170 - when using scrollable cursors and you've done a positioned fetch and then keep fetching until the end of the result-set calls to fetch never return undef and you keep getting the last row forever. Also added test case to the 51scroll.t test (Martin J. Evans). 1.60 2013-04-01 - Move github repository to github.com/pythian/DBD-Oracle. 1.58 2013-03-05 - promote 1.57_00 to official release 1.57_00 2013-02-07 [BUG FIXES] - fix RT46628 - bind_param_inout ORA_RSET causes MSWin32 access violation and RT82663 - Errors if a returned SYS_REFCURSOR is not opened (Martin J. Evans) - Fix RT82663. If a procedure/function returns a SYS_REFCURSOR which was never opened DBD::Oracle magics a DBI statement handle into existence and attempts to describe it (which fails). This change examines a returned SYS_REFCURSOR and if it it is initialised but not executed does not create a DBI statement handle and returns undef instead. So now if you have a procedure/function which returns a SYS_REFCURSOR and never open it you'll get undef back instead of a useless statement handle. Extended 50cursor.t test to check the above fix. (Martin J. Evans) [DOCUMENTATION] - Update Lion instructions for 64-bit Instant Client. (GH#37, patch by theory) 1.56 2013-01-08 - fix t/26exe_array.t in the case of no db connection (RT82506, reported by Peter Rabbitson) 1.54 2013-01-03 - promote 1.53_00 to official release 1.53_00 2012-12-18 [BUG FIXES] - Fix RT69350 - 31lob.t was using $lob after destroying its parent $sth (Rob Davies) - Fix memory leak in execute_array (John Scoles, Pierre-Alain Blanc) - Fix RT80349 - The error message in execute_for_fetch when a row fails can contain the wrong error count. Thanks to Steffen Goeldner for RT and patch. - Fix RT80375 - no exception when execute_for_fetch fails and ArrayTupleStatus is not specified. Also the tuple count calculation resulted in an undefined warning. Thanks to Steffen Goeldner for RT and patch. - Fix RT80487. Skip XMLType tests if Oracle less than V9. Thanks to Steffen Goeldner for RT and patch. - Fix RT80486 for 31lob_extended.t. In old old Oracle8, SYS_REFCURSOR is not defined. Instead of CREATE/DROP PROCEDURE, use anonymous block. Thanks to Steffen Goeldner for RT and patch. - Fix bug in 39attr.t which could fail if using an Oracle Client > 11 but not >= 11.2 (Martin J. Evans) - ora_server_version was not documented. - Fix RT80566. 70meta.t test fails with Oracle 8 because ALL_TAB_COLUMNS.CHAR_LENGTH is new in Oracle 9. Use DATA_LENGTH instead on pre-9 versions. Thanks to Steffen Goeldner for RT and patch. - Fix RT80704. 51scroll.t test checks scrollable cursors but assumes all Oracles support them (only 9 and above). Thanks to Steffen Goeldner for RT and patch. - Fix RT81067. 58object.t has some subtype tests and subtypes were introduced in Oracle 9. Skip if < Oracle 9. Thanks to Steffen Goeldner for RT and patch. - Fix RT81317. 34pres_lobs.t uses the Data Interface for Persistent LOBs which is new in Oracle 9. Skip if < Oracle 9. Thanks to Steffen Goeldner for RT and patch. [MISCELLANEOUS] - The original 26exe_array test was replaced some time ago with a copy of the one from DBD::ODBC. Since then I've fixed issues in the DBD::ODBC one and added more tests (like tests for some RTs above). To make keeping them in synch easier I've modularised the tests. Hence new ExecuteArray.pm. (Martin J. Evans) - simple code clean up, replacing 3 uses of safemalloc with Newz (John Scoles) - Add DBI as a configure prereq for the META* files (thanks to Joe Crotty) - New FAQ entry on Solaris and setting linker library path (Martin J. Evans) - Removed ineffective commit in 34pres_lobs.t (Martin J. Evans) - Remove dead README link in Win32 documentation. (pointed out by Alexandr Ciornii, RT#82040) - Changed any use of if SvUPGRADE to remove the if test as per email from Dave Mitchell and posting at http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2012-12/msg00424.html (Martin J. Evans) 1.52 2012-10-19 - promote 1.51_00 to official release 1.51_00 2012-09-28 [BUG FIXES] - fix serious memory corruption in TAF support (Martin J. Evans) - fix finding client in situation where client and server both installed but different architectures (patch by H.Merijn Brand) - fix memory leak in TAF handling - the TAF function was leaked (Martin J. Evans) - fix issue with taf_function being set to a scalar which goes out of scope before the callback is made (Martin J. Evans) - fix RT46739 if a connection breaks the environment handle is not thrown away (Martin J. Evans) - ora_driver_name was not defaulted to the correct DBD::Oracle version (Martin J. Evans) - ora_driver_name, ora_client_info, ora_client_identifier, ora_action and ora_oci_success_warn were set twice (if specified) on connect as they were not deleted from the connect attributes once handled. Code now leaves the setting to the later STORE DBI calls (Martin J. Evans) - fixed some compiler warnings for %lf (Martin J. Evans) - fixed RT78700 - column_info reports wrong size for char semantic char type columns (Douglas Wilson). [CHANGE IN BEHAVIOUR] - ora_taf and ora_taf_sleep were redundant and have been removed. To enable/disable TAF simply set ora_taf_function and if you want to sleep do it in your callback (Martin J. Evans) - ora_taf_function can now be a code reference as well as a string (Martin J. Evans) [ENHANCEMENTS] - the ora_can_taf method was virtually useless since you can only call it after connecting and to enable TAF you had to do it in the connect call. Now you can enable and disable TAF at any time by simply setting or clearing the ora_taf_function (see RT78811) (Martin J. Evans) - the ora_taf_function is now passed a third argument of the connection handle (Martin J. Evans) - RT78987 - removed Oraperl.pm and oraperl.ph; these files will be available in a separate distribution named "Oraperl" (David Perry) [MISCELLANEOUS] - hide dr, db and st packages from PAUSE (Martin J. Evans) - added a few more simple TAF tests (Martin J. Evans) 1.50 2012-08-15 - RT78965 - Remove Oraperl tests (which were forcing a require on Oraperl) 1.48 2012-08-09 - promote 1.47_00 to official release 1.47_00 2012-07-11 [BUG FIXES] - fixed redeclaration of $len in 31lob.t - (Martin J, Evans) - RT55028 - stop segfaulting when attempting to read empty lobs (Martin J. Evans) - RT69059 - Despite OCIPing being documented as added in 10.2 AIX does not seem to have it in 10.2 leading to undefined symbol - Martin J. Evans [DOCUMENTATION] - Promoted the troubleshooting for the different architectures to POD documents, for easier/prettier access. - Added a troubleshooting entry for RT71819 - bound output parameters may be returned in the wrong order (Martin J. Evans) 1.46 2012-07-11 - promote 1.45_00 to official release 1.45_00 2012-06-21 [CHANGE IN BEHAVIOUR] - In future versions of DBD::Oracle ora_verbose will be changed so that it is simply a switch to turn DBI's DBD tracing on or off. A true value will turn it on and a false value will turn it off. DBI's "DBD" tracing was not available when ora_verbose was created and ora_verbose adds an additional test to every trace test. [BUG FIXES] - Fixed RT76695 - offset passed to ora_fetch_scroll should not affect normal fetches (Martin J. Evans) - Fixed RT76410 - fetch after fetch absolute always returns the same row (Martin J. Evans); - Fixed RT75721 - does not build with Oracle 9.2 (Martin J. Evans) - Fixed RT71343 - Oracle 9i does not have OCI_ATTR_TAF_ENABLED or OCI_ATTR_RESERVED_15/16 so cannot build (Martin J. Evans) - skip 24implicit_utf8.t if chr set is not UTF-8 (Martin J. Evans) - Fixed RT76269 - ora_taf_sleep was documented as taf_sleep by accident. There was no way to stop the TAF reconnect attempts. If you want to try another connect attempt in your taf handler you now need to return OCI_FO_RETRY from it. (Martin J. Evans) [MISCELLANEOUS] - minor change to confusing debug output for input parameters (Martin J. Evans) - RT72989 - add note to trouble shooting guide re this RT and Module::Runtime (Martin J. Evans) 1.44 2012-04-23 - promote 1.43_00 to official release 1.43_00 2012-03-30 [BUG FIXES] - Applied patch from Rafael Kitover (Caelum) to column_info to handle DEFAULT columns greater in length than the DBI default of 80. The DEFAULT column is a long and it is a PITA to have to set LongReadLen which you can only do on a connection handle in DBD::Oracle. The default maximum size is now 1Mb; above that you will still have to set LongReadLen (Martin J. Evans) - Fixed 70meta and rt74753-utf8-encoded to not die if you cannot connect to Oracle or you cannot install from CPAN if you have not set up a valid Oracle connection. - Fixed 75163. Bfile lobs were not being opened before fetching if ora_auto_lobs was disabled (Martin J. Evans). Note: this has a minor impact on non bfile lobs when ora_auto_lobs is not in force as an additional call to OCILobFileIsOpen will be made. - Removed all DBIS usage fixing and speeding up threaded Perls (Martin J. Evans). - Minor fix to avoid use of uninitialised variable in 31lob.t (Martin J. Evans) [DOCUMENTATION] - clarification of when StrictlyTyped/DiscardString can be used and LongReadLen (Martin J. Evans) - Documented the 3rd type of placeholder and rewrote the existing pod for placeholders (Martin J. Evans). 1.42 2012-03-13 - skip rt74753-utf8-encoded.t if db is not unicode 1.40 2012-03-08 - promote 1.39_00 to official release 1.39_00 2012-02-24 [BUG FIXES] - TAF supports now conditional to presence of OCI_ATTR_TAF_ENABLED [RT73798] - detect broken Win32::TieRegistry (patch by Rafael Kitover (Caelum)) [RT74544] - PL/SQL out values were not utf8 encoded [RT74753] (Steve Baldwin + Martin J. Evans) [DOCUMENTATION] - Mention the release of Oracle Instant Client 64 bit which does not work on Lion. (Martin J. Evans) - fix DBD::Oracle::GetInfo blurb (patch by Julián Moreno Patiño) [rt74000] - fix typos. (patch by Julián Moreno Patiño) [rt73999] - add troubleshoot doc and diag for error with bequeather. [rt75263] [OTHERS] - change the shebang line of examples to the more modern '/usr/bin/env perl' [RT74001] 1.38 2012-01-13 - promote 1.37_00 to official release 1.37_00 2011-12-30 [ENHANCEMENTS] - added SYSASM session mode. [RT651211] (patch from Anthony DeRobertis, reported by Julián Moreno Patiño) [BUG FIXES] - applied patch from Charles Jardine avoiding undefined values warnings in ora_server_version when the database is not open [RT72623] (Martin J. Evans) - TNS_ADMIN was ignored [RT73456] [DOCUMENTATION] - Document possible problem with ora_connect_with_default_signals and connect_cached [RT72716] (Martin J. Evans) - Fix documentation for 'ora_fetch_scroll()' Changes in DBD-Oracle 1.36 (6-12-2011) - promote 1.35_00 to official release Changes in DBD-Oracle 1.35_00 (18-11-2011) [BUG FIXES] - if bind_col is called with a TYPE but no bind attributes like StrictlyTyped or DiscardString are set DBD::Oracle still attempts to call sql_type_cast which is pointless (Martin J. Evans) - if bind_col is called with a TYPE other than SQL_NUMERIC, SQL_INTEGER or SQL_DOUBLE and bind attributes like StrictlyTyped or DiscardString a warning was not issued that the type is unsupported and no data was returned (Martin J. Evans) - Fix test so it works with perl compiled with -Duselongdouble [RT71852] - Apply patch from Charles Jardine for better building against a full Oracle 11 install [RT72463] (Martin J. Evans) [DOCUMENTATION] - Added notes to bind_col documenting the fact that setting a TYPE does not affect how the column is bound in Oracle, only what happens after the column data is retrieved (Martin J. Evans) - fix typo (thanks to Julián Moreno Patiño) [RT72038] - shuffle POD around to improve documentation flow [RT72252] - major tidying up of the connect() documentation. (by Gwen Shapira) - Moved LONG examples out of POD and into examples/ [OTHER] - Commented out some functions in oci8.c which were not used to reduce the size of the driver a little (Martin J. Evans) Changes in DBD-Oracle 1.34 (31-10-2011) - promote 1.33_00 to official release Changes in DBD-Oracle 1.33_00 (18-10-2011) [BUG FIXES] - COLUMN_SIZE of VARCHAR2 returns size in chars, not bytes. [RT#13865] (reported by Stefano and Laurent Dami) [DOCUMENTATION] - add mention of the github mirror of the subversion repository - add 'resources' info to META.yml - fixed broken link to Oracle DRCP doc in POD (John Scoles) Changes in DBD-Oracle 1.32 (16-10-2011) - promote 1.31_00 to official release Changes in DBD-Oracle 1.31_00 [ENHANCEMENTS] - Makefile.PL's options are now documented - move 'explain' to '/examples' directory [BUG FIXES] - support development release versions in GetInfo (Martin J. Evans) - don't gag diag() on the tests by default - SKIP condition in 10general.t was reversed (reported by Alois) [RT#46761] - Check for LD_LIBRARY_PATH_(32|64) as well for solaris [RT#46761] - convert a symbolically linked ORACLE_HOME to an absolute path (patch by H.Merijn Brand, applied by Martin J. Evans) [rt70785] [DOCUMENTATION] - announce that Oraperl will be removed from the dist by v1.38. - add Mac OS instructions for Lion (patch by David Wheeler) [rt71109] - fixed minor typo in POD (John Scoles) Changes in DBD-Oracle 1.30 [DOCUMENTATION] - add warning about RT#69350 in documentation Changes in DBD-Oracle 1.29_1 [ENHANCEMENTS] - added support for TAF callback (John Scoles) - now trap OCIServerAttach errors (patch by Marc Fielding, applied by Martin J. Evans) [rt68958] - added installation notes for MAC Snow Leopard (Martin J. Evans) - added '/etc' to the search paths for tnsnames.ora (Martin J. Evans, Jay Senseman) [rt67942] - removed support for ProcC connections (John Scoles) - added ora_db_shutdown and ora_db_startup private functions (Steffen Goeldner) - added Test::Simple 0.90 to build_requires as we use note etc (Martin J. Evans) [BUG FIXES] - fixed bug in bind_col which was broken in 1.27 and stopped anyone using a string as a column number. e.g., '1' (Martin J. Evans, Alexander Foken) - removed obsolete oparse_lang (John Scoles) - fixed some compiler warnings in dbdimp.c and oci8.c (Martin J. Evans) - added missing OCIServerRelease to oci.def (Martin J. Evans) [rt68172] - fixed up the POD based on DBD::Pg (John Scoles) - POD review rephrasing, fixing typos and spelling mistakes up to "Placeholder Binding Attributes" (Martin J. Evans) - rt 56824 - add META_MERGE mentioning DBI required version (Martin J. Evans) * Changes in DBD-Oracle 1.28 (svn rev 14765) Changed 26exe_array.t so it is compatible with older version of Test::More by John Scoles A fix from Charles Jardine for 58object.t to stop an error on some 64 bit systems A few quick changes from H. Merijn Brand to fix some compiler warings and a fix for Oracle 9 clients Added connection attribute 'ora_connect_with_default_signals' that will localize Perl's $SIG{INT} handler from Brian Phillips and T. Bunce Fix in execute_array to stop possible endless loop when using a fetch sub by Martin J. Evans Adapted Martin J. Evans' ODBC 70execute_array.t into t/26exe_array.t by John Scoles Fix for execute_array to bring it up to spec. by Martin J. Evans and John Scoles Marked ProC, Oraperl.pm, ora_explain.pl, ora_context, ora_use_proc_connection and ora_parse_lang as deprecated to be removed in 1.29 Added in 4 new server side debug/trace attributes, ora_driver_name, ora_client_info, ora_session_user and ora_action on the connection handle from John Scoles Cleaned up the pod a little by John Scoles Fix for function name length, Some function names are over 31char long which may cause problems for some OS/Compilers (VMS IA64 box.) from Jakob Snoer Fix for OCIPing in case where a 10 client tries to ping a <10 DB from Tim Oertel Fix for DBD-Oracle stored proc with array bug where second call array size is unchanged from Tim Oertel Fix for rt.cpan.org Ticket #=63332: Spelling error in POD from jonasbn Fix for rt.cpan.org Ticket #=62152: t/28array_bind.t and t/31lob.t may call plan() twice and others do not fail on not connect from John Scoles Fix for rt.cpan.org Ticket #=61511 ORA-00942 when inserting into a table with a LOB column over a synonym on HP-UX from Kris Lemaire Fix for rt.cpan.org Ticket #=42842 Test 31lob fails with 64-bit Instant Client by John Scoles Fix for support for objects on big endian platforms from Charles Jardine, John R Pierce Fix for rt.cpan.org Ticket #=61225 Windows install (Stawberry Perl) fails on long path names from David Tulloh Fix for rt.cpan.org Ticket #=rt64524 Memory Leak when Oracle connection fails by Martin J. Evans Added all the missing ora_drcp values to dbh private_attribute_info by Martin J. Evans Removed a load of attributes from sth private_attribute_info which are not handle attributes but attributes to bind_param/prepare by Martin J. Evans Fix for rt.cpan.org Ticket #=64244 - don't bail out, skip tests when we cannot connect by Martin J. Evans and John Scoles Added DBI to PREREQ_PM in Makefile.PL by Martin J. Evans Added build_requires in Makefile.PL by Martin J. Evans Added workaround for ExtUtils::MakeMaker problems by Martin J. Evans Added LICENSE to Makefile.PL by Martin J. Evans * Changes in DBD-Oracle 1.27 (svn rev 14583) This version removes 'PERL_POLLUTE' and adds in PL_ where required so it will be fully compatible with Perl 5.13 * Changes in DBD-Oracle 1.26 (svn rev 14411) Manual re-release of 1.25 with changes to file permissions. * Changes in DBD-Oracle 1.25(svn rev 14411) Added support for the OCIPing by John Scoles Spell checked the pod (the first time in a while me thinks) updated the todo By John Scoles Added support for DCRP (Database Resident Connection Pooling) by John Scoles with Luben Karavelov Fix for odd error with Ping from Tom Payerle Removed the NEW_OCI_INIT compile directive and the deprecated OCIInitialize calls Fix for rt.cpan.org Ticket #=57256 : Double free problem in dbdimp.c by John Scoles Fix for invalid format in trace of OCILobLocatorIsInit_log_stat reported by Martin Evans Fixed by John Scoles Fix for very odd UNKNOWN OCI STATUS 1041 (OCILobFreeTemporary) on disconnect reported by John Parker and Bob Mcgowan fixed by John Scoles Fix for rt.cpan.org Ticket #=55445: get_info(28) SQL_IDENTIFIER_CASE seems to return the wrong value from Martin J Evans and a bunch of re jigging from John Scoles Patch for PL/SQL: numeric or value error: character string buffer too small from Scott T. Hildreth Fix for rt.cpan.org Ticket #=51594 type_info and type_info_all miss vital information from John Scoles Added ora_lob_is_init function by John Scoles Fix for rt.cpan.org Ticket #=55031 Ubuntu Server Building with Oracle XE under 32-bit from Brian Candler Fix for rt.cpan.org Ticket #=56810 bug with multiple nested cursor from John Scoles Fix for bug found only on Big-Endian hardware reported by Timothy Everett and others from Charles Jardine Fix for memory leak when using prepared_cached and lobs reported by Mark Bobak and Martin Evans found and fixed by John Scoles and a test from Martin Evans Added more entries to the Readmes from John Scoles * Changes in DBD-Oracle 1.24_01(svn rev 14060) This release has been prepared specifically for the 'Debian' http://www.debian.org project. It contains no changes to functionality or usage. The following has been changed Fixed some formatting and typos in Pod from Julián Patiño The Copyright terms for ora_explain have changed and now read as follows: You may distribute under the terms of either the GNU General Public License or the Artistic License, as specified in the Perl README file. * Changes in DBD-Oracle 1.24(svn rev 13793) Extended precision for OCIDateTimeToText to 6 instead of 0 for embedded types from John Scoles Extended support of Oracle Embedded objects from Charles Jardine Added support for RowsInCache as RO and RowCacheSize as a set-able value on the Statement Handle. So it would comply with DBI spec By John Scoles with thanks to Martin J. Evans Added extended support for 64 bit clients in Makefile.PL from Ralph Doncaster Added extended nvarchar support from Jan Mach Added support for the TYPE attribute on bind_col and the new DBI bind_col attributes StrictlyTyped and DiscardString from Martin J. Evans Added ora_ncs_buff_mtpl and environment var ORA_DBD_NCS_BUFFER so we can control the size of the buffer when doing nclob reads Fix for rt.cpan.org Ticket #=49741 Oracle.h has commented out params in OCIXMLTypeCreateFromSrc from Kartik Thakore Added from rt.cpan.org Ticket #=49436 Patch to add support for a few Oracle data types to type_info_all from David Hull Added from rt.cpan.org Ticket #=49435 Patch to add support for a few Oracle data types to dbd_describe from David Hull Fix for rt.cpan.org Ticket #=49331 Bad code example in POD from John Scoles Added support for looking up OCI_DTYPE_PARAM Attributes Added support for looking up csform values Fix for rt.cpan.org Ticket #=46763,46998 enhancement -Rowcache size is now being properly implemented with row fetch buffer from John Scoles Fix for rt.cpan.org Ticket #=46438 enhancement -Errors returned by procedures are now unicode strings from Martin Evans, John Scoles and Tim Bunce Fix for rt.cpan.org Ticket #=47503 bugfix - using more than 1 LOB in insert broken from APLA Fix for rt.cpan.org Ticket #=46613 bugfix - sig-abort on nested objects with ora_objects=1 from TomasP Fix for rt.cpan.org Ticket #=46661 DBD::Oracle hangs when insert/update with LOB and quoted table name from APLA Fix for rt.cpan.org Ticket #=46246 fetching from nested cursor (returned from procedure) leads to application crash (abort) from John Scoles Fix for rt.cpan.org Ticket #=46016 LOBs bound with ora_field broken from RKITOVER Fix for bug in 58object.t when test run as externally identified user from Charles Jardine * Changes in DBD-Oracle 1.23(svn rev 12724) Fix from rt.cpan.org ticket #=44788 bool in_lite should be char in_literal Fix for UTF8 and blobs by John Scoles with Milo van der Leij Fix for some warnings and one bug in ocitrace.h from Charles Jardine Fix in case there may be a bug in 11 where the OCI_ATTR_DATA_SIZE my return 0 which should never happen, John Scoles Fix on the Makefile.PL for a possible sql bug in IC from Martin Evans Added a change from a suggestion from Martin Evans for making ref cursors faster. Added rt.cpan.org Ticket #=42328 ora_objects attribute for extended embedded objects support from Tomas Pokorny Fix for rt.cpan.org Ticket #=42328 user defined types from different schema in describe_obj from Tomas Pokorny Added a README for sun suggested by Jim McCullars Clean up of white space and formatting to 4 tabs from John Scoles Fix for GCC 4.3 warnings from Eric Simon Standardized the dbd_verbose levels so they are all 3 and over. from John Scoles Added private statement functions ora_stmt_type_name and ora_stmt_type from John Scoles Update to POD from Chris Underhill Added README.win64.txt with content from Alex Buttery Fix for rt.cpan.org Ticket #=21920 Bug with Oracle DBD for Mac OS X Instant Client From boingolover Added a few more constants to get rid of magic numbers from John Scoles Fix for rt.cpan.org Ticket #=38267 Inserts/Updates to BLOB's via synonyms fails from John Scoles Fix for rt.cpan.org Ticket #=39603 build problem and fix missing functions in oci.def from Zoltán Sebestyén Fix for rt.cpan.org Ticket #=39374 Makefile.PL: error when reducing echo messages from make from Tippa Fix for rt.cpan.org Ticket #=39232 binding large XMLTYPE fails on 64-bit perl from Jeff Klein Fix for rt.cpan.org Ticket #=38749 Warning of a NULL column in an aggregate function also added ora_oci_success_warn to display silent OCI warnings from John Scoles Patch for UTF8 check on execute_array from David Mansfield and a little by John Scoles * Changes in DBD-Oracle 1.22(svn rev 11618) 1st Aug 2008 Patch to remove compiler warnings from H.Merijn Brand Patch to Makfile for 64bit boxes from Alex Laslavic Added OCILobGetLength to lob functions from Milo van der Leij Updated readmes to state the test user has to have create, call and drop a procedure privileges by John Scoles suggested by Gisle Aas Patch to Makfile to prevent the installation of the lib/DBD/mkta.pl fil from Gisle Aas Added new Test 31lob_extended.t for use of LOBs when returned via stored procedures with bind_param_inout from Martin Evans Update to connection part of POD from John Scoles Fix to test suite to bring it up to standard from Martin Evans Fix for memory hemorrhage in bind_param_inout_array found by Ricky Egeland, Fix by John Scoles Fix for a typo in oracle.xs from Milo van der Leij Fix for bugs on SPs with Lobs reported by Martin Evans, Fix by J Scoles Changed the way Ping works rather than using prepare and execute it now makes a single round trip call to DB by John Scoles Fix for rt.cpan.org Ticket #=37501 fail HP-UX Itanium 11.31 makefile also added the OS and version to the output of the Makefile.PL for easier debugging. from John Scoles and Rich Roemer Added a number of internal functions for decoding OCI debug values from John Scoles Fix for hpux 11.23 linker error unrecognized argument on the Makefile from someone on CPAN forum Added fetch by piece for lobs, fixed persistent lobs and expansed thier usage for LONG and LONG RAW and changed to pod to reflect the changes from John Scoles Added comment to POD on case sensitivity of ORACLE environment variables suggested by Gerhard Lausser Added patch to fix a number of harmless, but annoying, GCC warnings from Eric Simon Added (finally) ora_verbose for DBD only tracking from John Scoles and thanks to H.Merijn Brand Fix for rt.cpan.org Ticket #=32396 from John Scoles Fix for memory leak that snuck into 1.21 from John Scoles Fix for rt.cpan.org Ticket #=36069: Problem with synonym from John Scoles Fix for rt.cpan.org Ticket #=28811 ORA_CHAR(s) not returning correct length in functions and procedures from John Scoles Makefile.PL now working without flags for Linux 11.1.0.6 instant client and regular client from John Scoles, Andy Sautins, H.Merijn Brand, Nathan Vonnahme and Karun Dutt Fixed how persistent lob fetch works now uses callback correctly, from John Scoles & Darren Kipp * Changes in DBD-Oracle 1.21(svn rev 11067) 11th April 2008 Added Notes to README.win32.txt on installing Instant Client 11.1.0.6.0 from John Scoles Added the oci_typecode_name method to get the name rather than just the number of an OCI_TYPECODE from John Scoles Fixed a unreported bug with Embedded Objects from John Scoles Fixes for #34621 & 33791 from RT cpan Added patch to allow faster fetch from REF CURSORs from Biswadeep Chowdhury Updated the Todo file for next version from John Scoles Added support for the 10.2 Data Interface for Persistent LOBs by John Scoles Changed the way pre-fetching is done by John Scoles Added support for Scrollable cursors from John Scoles Changed the max size of cache_rows to a sb4 rather than a int and or a ub4 from John Scoles Added support for Lobs in select of OCI Embedded Objects from John Scoles with a big thankyou to Paul Weiss Fixed for embedded object in object from Paul Weiss Added support for direct insert of large XML data into XMLType fields from Hendrik Fuss & John Scoles Fixed memory leak (not releasing Temp Lob with OCILobFreeTemporary) when created for a bind from John Scoles Added support for bind_param_inout_array for use with execute_array from John Scoles Added enhancement for Embedded Objects handling from Paul G. Weiss Fixed to Makefile.PL let it read makefiles from other makes from Alexander V Alekseev Updated POD to tell users to Avoid Using "SQL Call" from Charles Jardine Updated POD to account for rt.cpan.org #30910: "DBD-Oracle crashes when trying to read empty LOB" from John Scoles Added DBD::Oracle impdata/threads patch from Jeffrey Klein * Changes in DBD-Oracle 1.20(svn rev 10517) 11th January 2008 Fixed lob test so it skips the one test that relies on it if v$ session. from Rafael Kitover Fixed // with /* */ in dbdimp.c from John Scoles Fixed for execute_for_fetch in Oracle.pm returning 0 instead of 0E0. from Martin J. Evans Added README.64bit.txt that contains help for compiling on 64 bit boxes from John Scoles Fixed typo in Oracle.pm from Tom R. Added support for ora_charset, ora_ncharset from Stephen J. Smith Fixed Makefile.PL for better handling of empty array in File::Find::find from Slaven Rezic Fixed references to README.clients.txt in Makefile.PL from John Scoles Added PERL_NO_GET_CONTEXT for better multi-threaded support from John Scoles Changed required version of DBI to be 1.51 from John Scoles Fixed bug in 31lob.t from John Scoles Added notes on installing Instantclient .rpm to README.Lunix.txt Added support for OCI array bind from Alexander V Alekseev Added support for select of OCI Embedded Objects from John Scoles Added a tip in README.64bit.txt from cartmanltd Added fix to Makefile.PL for finding SQLplus for Ubuntu Server (but should work for others) from Martin J. Evans Added fix to Makefile.PL for Gentoo AMD64 from Tom R. Added fix to dbdimp.c for speed up of Null-Operations from Andreas Behal Added fix to dbdimp.c for SQLCS_NCHAR index use on varchar2s from Peter J. Holzer * Changes in DBD-Oracle 1.19 (svn rev 8002) 3rd November 2006 Fixed execute_array to comply with DBI standard from Martin J. Evans, Xho Jingleheimerschmidt and others Fixed execute_array so it will not throw a Perl warning on undef values in Tuples from John Scoles Fixed execute_array so it will take the ora_array_chunk_size DB handle attribute Fixed some typos in code and READMEs from John Scoles Fixed a few other little bugs dealing with compatibility with Oracle 8 Changes to README from Karl Auer Suppress warning in 26exe_array.t from Philip Garrett Added support for array context aware execute_for_fetch from Martin J. Evans Fixed Makefile.PL for an incompatibility with ExtUtils::MM_Unix v1.50 (invoked byExtUtils::MakeMaker) from Dennis McRitchie Updated POD to reflect that OCI after 9.2 no longer strips trialing spaces * Changes in DBD-Oracle 1.18 (svn rev 6697) Added support for native Oracle Array interface thanks Kristian Nielsen Added suppot for LOB Locators from Jeffrey Klein. Updated README.win32.txt for Oracle 10xe and new Visual C++ version Updated README.lunix.txt for work-araound for UTF8 bug Fixed a number of compile warings please enjoy. * Changes in DBD-Oracle 1.17 (svn rev 3726) Updated README.win32.txt fixed some typos Fixed expanded support for Lobs support from Jeffrey Klein Added notes on expanded support for Lobs to Oracle.pm * Changes in DBD-Oracle 1.17 (svn rev 3725) Added expanded support for Lobs from Jeffrey Klein * Changes in DBD-Oracle 1.17 (svn rev 2487) 7th February 2006 NOTE: With this release of DBD::Oracle pythian.com (http://www.pythian.com) are taking on the role of lead maintainer - with my support and gratitude. John Scoles at pythian.com is now the man in the hot seat for support and maintenance! Fixed automatic csform setting for some UTF8 cases and for Oracle 8.0 Fixed truncation error on fetch into UTF8 charset thanks to Honza Pazdziora. Fixed INTERVAL DAY TO SECOND thanks to Honza Pazdziora. Fixed unicode tests for cygwin thanks to Andy Hassall. Fixed undef warnings when connecting with undef $user. Fixed undef warnings from $dbh->get_info(18); Fixed LOB streaming example thanks to Pablo Zorzoli. Added support for nested cursors in select lists thanks to Charles Jardine. Added "Trailing Spaces" section to docs thanks to Michael A Chase. Added support for binary floats/doubles thanks to Dennis Box. Added INSTANCE_NAME, SERVER and SERVICE_NAME as valid connect keywords in the 'dbi:Oracle:x=y' short form of connecting without tnsnames.ora. For example 'dbi:Oracle:host=localhost;service_name=xe;server=dedicated' Added auto-detection of ORACLE_HOME in some configurations. Changed "Binding Cursors" docs, clarifying examples thanks to Charles Jardine. Changed tests to use ORACLE_DSN or DBI_DSN env vars if defined thanks to Jill Vogel. Updated README.vms re logical name tables thanks to Jakob Snoer. Removed README.utf8 since the topic was covered better in the main docs. Updated README.hpux.txt and restructured examples thanks to H.Merijn Brand. Updated README.aix thanks to Stephen de Vries and Nathan Vonnahme. Updated README.macosx thanks to Stephen de Vries. Renamed README.*'s to add .txt suffix to make life easier for some. Changes to Makefile.PL: Instant Client support thanks to Hilmar Lapp, John Scoles and others. Improved HP-UX support thanks to H.Merijn Brand. Avoid risk of sqlplus hanging thanks to Mark Dedlow. More reliably use correct sqlplus thanks to Honza Pazdziora. Improved build rule and Oracle header file detection. Improved cygwin build thanks to Andy Hassall. VMS logical name checks thanks to Jakob Snoer. The Copyright terms for DBD::Oracle have been simplified and now read: The DBD::Oracle module is free open source software; you can redistribute it and/or modify it under the same terms as Perl 5. * Changes in DBD-Oracle 1.16 (svn rev 515) 22nd October 2004 NOTE: This release has major changes to Unicode support. See below. It no longer supports the old Oracle 7 OCI interface. It requires DBI >= 1.38 for some of the tests if using Perl 5.6. It no longer supports Perl 5.5 or earlier. Fixed placeholder names to be case insensitive thanks to Charles Jardine. Fixed some LOB test problems with Oracle 8.1.7 by implementing ora_lob_append with OCILobGetLength() and OCILobWrite(), instead of buggy OCILobWriteAppend(), if the Oracle client version is < 9.0. Thanks to Jeff Urlwin. Fixed handling of temporary LOBs thanks to Chris Donnelly. Fixed memory leaks in auto LOB refetch code thanks to Dongqiang Bai. Fixed reporting of length truncated in error message thanks to Jeff Urlwin. Fixed column_info() to handle TIMESTAMP and INTERVAL datatypes for Oracle >= 8 thanks to Stephen Clouse. Fixed STORE to cache attribute value in handle cache. Fixed seg fault returning LOB Locators reported by Raj Chandran. Fixed binding to allow overloaded scalars (not for 'inout' params). Fixed setting of $DBI::err to 0 triggering PrintWarn in DBI >= 1.41. Fixed some edge cases in row cache sizing. Fixed truncation error fetching very small numbers (1 ^ -130). Fixed Oraperl to not enable PrintError or AutoCommit (broken since 1.13). Changed some utf8 internals for LOBs. Changed ORA_OCI constant from being just 7 or 8 to being a dualvar: in numeric context returns the major.minor version number (8.1, 9.2 etc) in string context it returns the full "major.minor.foo.bar" version string. Changed some SUCCESS_WITH_INFO situtions to be treated as a "warning" by setting $DBI::err to "0" (and so trigger PrintWarn in DBI >= 1.43) eg "ORA-28011: the account will expire soon; change your password now" and package compilation errors. Added automatic support for UTF-8 for both NLS_LANG and NLS_NCHAR Many thanks to Lincoln Baxter who did most of the hard work and testing and to Jeff Urlwin and others who also helped out. Perl 5.8.x and Oracle 9+ are highly recommended if you want to use Unicode. See POD for more information and documentation. Added support for "... RETURNING lob_locator_column INTO ?" using $sth->bind_param_inout(2, \$loc, 0, {ora_type => ORA_BLOB}); Added bind_param() ora_csform, ora_csid, and ora_maxdata_size attributes. Added bind_param() support for SQL_BLOB & SQL_CLOB thanks to Stephen Clouse. Added $dbh->ora_can_unicode and $dbh->ora_nls_parameters thanks to Andy Hassall. Documentation changes: Corrected typo in ora_lob_read() example thanks to Johannes Wierny. Corrected LOB example thanks to Sascha Pfalz and Thomas Upton. Updated README.macosx thanks to Hilmar Lapp. Updated README.hpux thanks to Gram Ludlow and Lincoln Baxter. Added $dbh->reauthenticate($user,$pass) docs thanks to Andy Hassall. Added $dbh->{ora_parse_error_offset} docs thanks to Andy Hassall. Added gcc example to README.aix thanks to Adrian Terranova. Added INSERT ... RETURNING ... example prompted by Steven Lembark. Build Changes: Fixed build32/build64 Makefile.PL bug spotted by Sean Kelly. Fixed Oracle version detection on clients thanks to Marko Asplund. Fixed Oracle 10 version detection on clients thanks to Andy Hassall. Fixed HP-UX 64bit build issues thanks to Weiguo Sun. Fixed VMS build issues thanks to Jakob Snoer. Fixed suprious warning from Makefile.PL thanks to Marko Asplund. Fixed compiler warnings thanks to Robert Baron. Fixed oci.def for Cygwin by adding OCILobWriteAppend thanks to Gert-Jan Paulissen. Changed to use ANSI C prototypes thanks to Steffen Goeldner. Changed to not warn if ORACLE_HOME env var is not defined as it's not used with Oracle's new 'Instant Client'. Added Test::More as a prerequisite module. Added many Unicode related tests thanks to Lincoln Baxter. * Changes in DBD-Oracle 1.15 27th January 2004 NOTE: DBD::Oracle now requires DBI version 1.28 (June 2002) or later. NOTE: This is probably the last release that will support being built with the old Oracle 7 OCI interface. NOTE: This release will build for perl 5.5 only after some manual edits which are detailed in README.help. Future releases may not build for 5.5. Perl 5.5.3 is very old and and upgrading to at least 5.6.1 is recommended. The DBI itself has required perl >= 5.6.0 since DBI 1.38, August 2003. Fixed Makefile.PL for HPUX thanks to H.Merijn Brand & Sweth Chandramouli. Fixed Makefile.PL for handling 32/64bit libs thanks to Lincoln Baxter, Sean Kelly, Joel Van Boeckel and others. Oh the fun we've had. Fixed Makefile.PL error typo thanks to Martijn Koster. Fixed to build okay for Oracle 8.0.x and for older C compilers. Fixed minor omission in t/ph_test.t thanks to Tom Malaher. Fixed for extproc_perl (http://search.cpan.org/author/JHORWITZ/extproc_perl/) Fixed Oraperl handling of ora_errno and ora_errstr thanks to Martin Busik. Fixed PRECISION for "NUMBER" to be 126 not 0 thanks to Steffen Goeldner. Fixed bind_param_inout() for placeholders not assigned to in PL/SQL. Changed bind_param_inout for CHAR types to no longer use a minimum length of 28 characters. Warning: this change may break code that doesn't pass bind_param_inout() a length value large enough for the returned string. (The minimum length was not documented and should not have been relied upon. This change currently only applies to the CHAR type but may extended to all string types in a later release.) Changed type_info_all() to return the same type info as Oracle's own ODBC driver does, thanks to Andy Hassall for the data. The types include LOBs but not the new TIMESTAMP and INTERVAL types. Added direct access to LOB Locators and major LOB Locator functions such as $sth->ora_lob_read(...), $sth->ora_lob_write(...) etc. This work was sponsored by Geospiza Inc. Added LOB Locator example docs thanks to Mark Dilger at Geospiza. Added TIMESTAMP [WITH [LOCAL] TIME ZONE]] support thanks to Stephen Clouse and Robert Wyrick. Added INTERVAL YEAR TO MONTH, INTERVAL DAY TO SECOND support. Added warning for bad DSN string format thanks to Michael A Chase. Added /*+RULE*/ hint to metadata method SQL thanks to Andy Hassall. Added README.linux thanks to William Fishburne, Stephen Clouse and Brent LaVelle. Added README.aix thanks to KC, Mike Paladino and Rafael Caceres. Added connect example using OS authentication thanks to Bob Thomson. Added prepare("...", { ora_placeholders => 0 }) to disable placeholders. Added docs for returning a recordset (table/array) using Oracle >=9.0.1 via "FUNCTION foo RETURN type PIPELINED" thanks to Steve Baldwin. Added docs on ora_check_sql=>0 in prepare() to avoid server-side parses. Added support for sharing database connections with ProC/SQLLIB code via ora_use_proc_connection attribute, thanks to Kristian Nielsen needs build time option thanks to Steffen Goeldner Added (restored) the error "possibly near <*> indicator" marker for syntax errors thanks to Jason Hitt and Andy Hassall. Added $dbh->{ora_parse_error_offset} attribute thanks to Andy Hassall. Added auto setting of $dbh->{Username} if not given to connect i.e. using Oracle OS authentication and connecting as "/" by selecting SYS_CONTEXT('userenv','session_user') from the db thanks to Eric Lenio and Andy Hassall. Updated README.macosx thanks to Danial Pearce and William Goedicke. Updated README.help for UnixWare thanks to Earle Nietzel. Updated PL/SQL cursor examples, plus Oracle.ex/README and curref.pl examples thanks to Michael A Chase. Updated PL/SQL example setup thanks to Bob Kline. * Changes in DBD-Oracle 1.14 27th March 2003 NOTE: OCI 7 and Oraperl will not be supported in future releases. Implemented inserting NULL values into LOB fields using placeholders, (sponsored by bayerwald-fenster.de thanks to Bernhard Donaubauer). Fixed broken get_info() due to missing GetInfo.pm #2274. Fixed compiler warnings/errors thanks to H.Merijn Brand. Fixed bind_param with array ref to croak not warn, reported by Steven Roels. Fixed "Bad hash" error using $sth->{ParamValues} if there were no placeholders. Fixed Makefile.PL for more HPUX/Oracle configurations thanks to Lincoln Baxter. Simplified MacOS X build thanks to Brook Schofield, see README.macosx. Updated README.hpux thanks to H.Merijn Brand, Jay Strauss, and Lincoln Baxter. Updated README and README.utf8 with minor changes thanks to Alexey Mahotkin. * Changes in DBD-Oracle 1.13 14th March 2003 Fixed null user issue when using OS Authentication thanks to Christopher R. Baker Fixed precision for Raw types in oci7.c thanks to J.D. Laub. Fixed LOB code for table names containing $ thanks to Wayne Volkmuth. Fixed LOB synonym handling thanks to John Milton. Fixed dbms_output_get to be immune to ora_ph_type changes thanks to Michael Fox. Fixed to now not treat SUCCESS_WITH_INFO (eg ORA-28011) on connect as an error. Updated table_info to decode SYS and SYSTEM to prepend 'SYSTEM ' thanks to Olga Voronina Updated table_info and added get_info, foreign_key_info thanks to Steffen Goeldner. Added that ShowErrorStatement is now enabled by default. Added ParamValues attribute so ShowErrorStatement includes bind_param values. Added experimental utf8 support thanks to Stefan Eissing. See README.utf8 Added BFILE support thanks to David Hull. Added :ora_session_modes export tag for ORA_SYSDBA ORA_SYSOPER constants, added ORA_STRING and ORA_CHARZ to :ora_types export tag and added docs for ora_ph_type attribute and other doc fixes, thanks to Michael A Chase. Added t/cursor.t tests thanks to Jeffrey Horn. Added ability to share connections between threads via ora_dbh_share attribute, thanks to Gerald Richter. Added ability to connect() via 'external process context', for embedding Perl DBI into Oracle server, thanks to Jeff Horwitz. Documentation changes: Updated README.hpux thanks to Lincoln Baxter and Jay Strauss. Documented ora_parse_lang, ora_auto_lob, and ora_check_sql prepare() method attributes thanks to Michael A Chase. Configuration and build related changes: Added Win32 support on systems with multiple Oracle Homes thanks To Jeff Urlwin. Fixed prototype for constant() thanks to Sreeji K Das. Fixed warning in Oraperl.pm with recent perl versions thanks to Ilya V.Rachkov. Fixed handling of shell backticks in make output during build rule discovery. Fixed Win32 build using gcc thanks to Chris R. Donnelly and Michael A Chase. Help HPUX configs by removing -l:libcl.a from liblist, thanks to Frans Postma. Assorted improvements to Makefile.PL thanks to Michael A Chase and Stephen Clouse. Updated tests and Oraperl.pm to not use old style connect (deprecated in DBI 1.33). * Changes in DBD::Oracle 1.12 31th August 2001 Improved LD_RUN_PATH code in Makefile.PL thanks to John Groenveld. Improved HPUX code in Makefile.PL thanks to H.Merijn Brand. Fixed handle/descriptor name code to be less Oracle version sensitive. Updated $dbh->primary_key_info() to new DBI spec thanks to Steffen Goeldner. Version 1.11 was skipped (uploaded to PAUSE with an error). * Changes in DBD::Oracle 1.10 30th August 2001 Explicitly require DBI version 1.20 (or later). Support multiple oracle home's in Win32 registry thanks to Jeff Urlwin. Improved build support for Oracle >=8.1.7 (I_SYM) thanks to Stephen Close. Fixed LOB bug when writing non-string values thanks to Stephen Close. Fixed t/ph_type.t to be better behaved thanks to Ville Skytta. Added OCI8 handle/descriptor name to trace output for some API calls. * Changes in DBD::Oracle 1.09 27th August 2001 Changed behaviour when OCIStmtExecute() returns OCI_SUCCESS_WITH_INFO: used to be treated as OCI_SUCCESS, now also sets $DBI::err/$DBI::errstr and will therefore trigger RaiseError/PrintError if they are set. Fixed ins/upd of LOBs in views thanks to Tom Moore. Fixed reading of CLOBs in wide characters sets. Fixed 'inherited AUTOLOAD for non-method DBD::Oracle::ORA_OCI' problem. Workaround very long column names causing failure thanks to Martin Busik. Added $dbh->primary_key_info() thanks to Steffen Goeldner. Added $sth->cancel method thanks to Fredrik Sjoholm. Added mention to registry to login failed hint thanks to Tim Callaghan. Changed type_info_all VARCHAR2 max length to 4000 if using OCI8. Removed use of perl global PL_no_modify to avoid linkage problems. Old OCI7 API: Fixed OCI7 memory leak from statement handles thanks to Bret Haeler. Fixed OCI7 PRECISION for RAW data types thanks to J.D. Laub. Fixed old OCI7 LONG buffer overwrite bug thanks to Bruce Templeton. (I thought I'd done this before but perhaps now it's done right.) Build: Fixed default build to set LD_RUN_PATH at build time. Yeah. Fixed parsing of Oracle's .mk files to handle += (appending values). Fixed detection of 'OCI' dire for Win32 Oracle >=8.1 thanks to many. Improved test for gcc in Makefile.PL thanks to Ian Kallen. Improved build rule detection thanks to Jonathan Segal. Don't merge text from Oracle's .mk into generated Makefile (use -f to reenable). Fixed bad test in plsql.t so shouldn't give false negatives. Added t/ph_type.t to test placeholder type issues thanks to James Jurach. Retested for perl 5.4.4 for possibly the last time. You have been warned. In future I'll only be testing on perl >= 5.5.3 and >=5.6.1. Documentation: Documented workaround for hang in "repetitive connect" test thanks to Alexi Lookin. Short version: add bequeath_detach=yes to sqlnet.ora file. Documented ora_oratab_orahome connect attribute (Oracle OCI 7 only). Documented ora_module_name connect attribute thanks to Renzo Toma. Added IRIX linking advice into README.help thanks to Dennis Box. Added AIX core dump on disconnect advice into README.help. Added docs on how Oracle determines the timezone thanks to Brad Howerter. Added 'return cursor function' example to docs thanks to Michael A. Chase Added more notes to README.java thanks to Peter Ludemann and Dave C. Added more notes to README.login thanks to Geoff Young. * Changes in DBD::Oracle 1.08 7th August 2001 Fix Oracle 7 build broken in previous release. Fix for 64bit builds thanks to Alan Burlison. Fix for 9i Makefile.PL thanks to Dong Wang. Added Oracle.ex/curref.pl thanks to Geoffery Young. REF types are now returned in a form usable with Oracle::OCI module when using Oracle >= 8.1.x (untested at the moment) Updated Makefile.PL and README.hpux thanks to Lincoln Baxter. * Changes in DBD::Oracle 1.07 5th June 2001 This release is mostly targeted at the needs of the new Oracle::OCI module. It's not a general release and not recommended for production use. Fixed SCALE/PRECISION/TYPE values for numeric types, including FLOAT, to be more correct thanks to Steffen Goeldner. NOTE: this may break code that depends on the old values! Fixed Win32::TieRegistry and Tie::Registry usage thanks to David Bradford. Fixed insert/update of LOBs while AutoCommit enabled. Fixed error in 'LOB value truncated' error thanks to Paul Walmsley. Fixed old oci7 LONG buffer overwrite bug thanks to Bruce Templeton. Fixed ocitrace.h not to trip up some compilers. Added table_info() search attribs thanks to Steffen Goeldner and Olga Voronova. Implemented some reworking of the placeholder handling, especially in relation to the start of some basic array support. Updated email and web page details to dbi-users@perl.org and dbi.perl.org. * Changes in DBD::Oracle 1.06 14th July 2000 Fixed ora_ph_type attribute to allow 96 or 97. Fixed compile failure with Oracle 7. * Changes in DBD::Oracle 1.05 13th July 2000 Added $dbh->{ora_ph_type} attribute to define default bind type: 1=> VARCHAR2, does strip trailing spaces, embedded \0 bytes okay 5=> STRING, doesn't strip trailing spaces, embedded \0 ends string 96=> CHAR, doesn't strip trailing spaces, embedded \0 okay 97=> CHARZ, doesn't strip trailing spaces, embedded \0 ends string? The two CHAR types force 'blank-padded comparison semantics'. Needs testing and documenting, volunteers most welcome! Added (many) typecasts to avoid compiler warnings thanks to Denis Goddard. Added ability to pass existing DBD::Oracle select statement handle (cursor) back _into_ Oracle as a ref cursor type thanks to Mike Moretti. Note that this enables a workaround for closing ref cursors: $dbh->do("BEGIN CLOSE :cursor; END;", undef, $sth_ref_csr_to_close); Improved Win32 support in Makefile.PL thanks to Michael A. Chase. Workaround Win32::TieRegistry FETCH error during global destruction. Re-enable row cache by default for OCI8 (can give big speed increase). Fixed bug in OCI8 row cache calculation thanks to Greg Stark. * Changes in DBD::Oracle 1.04 11th July 2000 Added info on workarounds for Java thread related linker errors on Solaris with Oracle 8.1.6. Thanks to Andi Lamprecht. Fixed memory leak on connect. Thanks to Jeffrey W. Baker. Fixed memory and ref cursor leaks. Thanks to Mike Moretti and John Tobey. Fixed SEGV on insert/update or many LOBS. Thanks to Honza Pazdziora. Fixed treating SUCCESS_WITH_INFO from finish() as an error. Fixed passing of attribs to connect thanks to K.Takaoka. Fixed cursor binding example in docs thanks to Michael Chase. Build using otrace/demo/atmoci.mk as last resort thanks to Chris Sylvain. Improved reliability of "perl Makefile.PL -b" configure option. Improved reliability of t/plsql.t cursor tests. Hopefully. Improved reliability of ping method. Fixed broken SQL type warning in bind_param. * Changes in DBD::Oracle 1.03 12th July 1999 Added "perl Makefile.PL -b" configure option. Links DBD::Oracle using same linker args as Oracle's own OCI demo applications. Added connect("dbi:Oracle:host=foo;sid=bar", ...) syntax. Added OCI8 function trace at level 6, useful for Oracle support. Added ora_session_mode attribute to connect (eg SYSDBA/SYSOPER). Added test for Oracle security problem. See README.sec. Updated ora_explain tool to v1.1 thanks to Alan Burlison. Contributions from Michael Chase (plus docs from Andy Duncan): Documented plsql_errstr & dbms_output_enable/_put/_get. Enhanced $dbh->func('plsql_errstr') output. Replaced old Oraperl examples with DBI/DBD::Oracle ones. * Changes in DBD::Oracle 1.02 14th June 1999 LongReadLen no longer limited to 64KB for OCI 7 & 8! But beware of OCI 7 bug when fetching >64KB. See t/long.t for more details. Fixed OCI7 ref cursor missing data row. Fixed OCI8 LOB statement handle leak & improved trace. * Changes in DBD::Oracle 1.01 8th June 1999 Enhanced diagnostics in t/long.t test suite. Removed byte with high-bit set from t/long.t test data. Disable finish if database disconnected or perl is terminating. Made t/general.t work with other NLS settings. Added Cygwin support thanks to Alexander Smishlajev. Fixed 'undeclared identifier' error building with old Oracle's. * Changes in DBD::Oracle 1.00 4th June 1999 Increased default row cache size for improved performance. Added OCI8 binding of cursors! Sponsored by cp.net. Added OCI7 binding of cursors! (Was easier after OCI8 work :-) Added OCI8 blob_read (only for LOBs not LONGs) thanks to Jim Lawson. Added OCI8 re-authentication thanks to John Tobey. Added t/long.t test script for LONG/LONG RAW/CLOB/BLOB handling. Length of fetched LONG RAW string now 2 * LongReadLen for OCI7 & 8. Fixed LONG fetches being one byte longer than LongReadLen. Fixed OCI8 non-reporting of LobWrite error. Fixed OCI8 "LongReadLen too small and/or LongTruncOk not set" hint. Fixed OCI7 probable cursor leak. Fixed ping method to be more robust. This should fix the "morning bug" problem with Apache::DBI. Fixed t/general.t core dump thanks to Donald Buczek. Fixed ora_check_sql prepare attribute (for selects). Fetch errors (non-row level) now turn off the Active attribute. * Changes in DBD::Oracle 0.61, 9th April 1999 Fixed execute() always returning 0 rows! (with OCI 7). Fixed $sth->bind_param(..., SQL_CHAR); Assorted minor Makefile.PL improvements. Added ora_check_sql attribute to prepare() for OCI8. * Changes in DBD::Oracle 0.60, 10th March 1999 Fetching all records now resets Active flag as it should. Finally fixed "Can't bind unknown placeholder" (hopefully :-). Fixed placeholder parser to ignore comments, thanks to JD Laub. Fixed placeholder parser to ignore double-quotes strings. No longer changes ORACLE_HOME to match oratab, by default. Fixes for OCI 8: Fixed selection of very large numbers (132 digits). Fixed small memory leak in parameter binding. Fixed small memory leak in prepare of statements using LOBs. Fixed binding empty strings. Fixed OCILobRead error when fetching of zero length LOBs. Fixed OCILobWrite of zero length to use OCILobTrim instead. Treat SUCCESS_WITH_INFO from OCIStmtExecute as SUCCESS. Enabled OCI_CRED_EXT login thanks to Alan Burlison & Jeremy Brinkley. Modified hints/svr4.pl - SVR4 users please test. Updated Alan Burlison's ora_explain Tk tool to version 1.0. * Changes in DBD::Oracle 0.59 (Oraperl 1.37), 27th December 1998 Fixed detection of ambiguous LOB-param-to-table-field assignment (previous fix had typo). Only affects multiple LOBs in same table. Added support for Oracle 8's "... RETURNING foo,bar INTO :foo,:bar" for simple scalar types (not LOBs or arrays) via bind_param_inout. Cleaned up the code. Improved Oracle 8 library selection code for Win32 (untested). * Changes in DBD::Oracle 0.58 (Oraperl 1.37), 22nd December 1998 Fixed detection of ambiguous LOB-param-to-table-field assignment. Added bind_param ora_field attribute to disambiguate if needed. * Changes in DBD::Oracle 0.57 (Oraperl 1.37), 21st December 1998 Fixed bug preventing fetching LONGs when using OCI 8, better. (Oracle bug #641812 not involved. Should work for all 8.0.x) * Changes in DBD::Oracle 0.56 (Oraperl 1.37), 19th December 1998 Fixed bug preventing fetching LONGs when using OCI 8. (Oracle bug #641812 may still cause failure prior to v8.0.5.) Fixed LongTruncOk to work when using OCI 8. Fixed bug in table name detection code for OCI8 LOB refetch. SCALE & PRECISION work for OCI 7 & 8. * Changes in DBD::Oracle 0.55 (Oraperl 1.37), 16th December 1998 Major internal work to support Oracle 8 OCI. Oracle 8 LOBs are supported and treated as LONGs (DBD::Oracle works hard to hide the complexities of handling Lob Locators for you). See Oracle 8 section in the docs for more details. Added $sth->{TYPE}. SCALE & PRECISION are implemented but return 0 (Oracle bug?). DBI 1.02 or later is required. Assorted build time Makefile.PL improvements. Builds with 5.004_04, 5.005_02 and 5.005_54 (not _53). Added "use DBD::Oracle qw(:ora_types);" * Changes in DBD::Oracle 0.54 (Oraperl 1.37), 14th August 1998 Added $dbh->type_info_all. Fixed $dbh->tables (partly by renaming to new $dbh->table_info). data_sources no longer adds abbreviated versions of tnsnames. Alan Burlison's whizzo Tk based explain script now bundled. Revised workaround for "Can't bind unknown placeholder '3'" errors. Doubled default automatic row cache size (now approx 5KB). The resetting of Oracle's SIGCHD handler to SA_RESTART can now be disabled by setting the env var DBD_ORACLE_SIGCHLD=0. Fixed Makefile.PL -c to better avoid shared Oracle lib. * Changes in DBD::Oracle 0.53 (Oraperl 1.37), 3rd August 1998 Further build fixes (esp kpudc problem with Oracle 8). Now prefers oracle.mk over proc.mk again. Only $ENV{ORA_CLIENT_LIB} ||= 'shared' if shared lib exists. Builds okay with 5.005-thread (not tested). * Changes in DBD::Oracle 0.52 (Oraperl 1.37), 28th July 1998 Assorted build fixes (esp. Win32, HP-UX and AIX). More hints on error messages, especially long truncation and field-level errors when fetching. Compiles okay now for systems without SQLT_CUR defined. Only sets SA_RESTART on SIGCLD if connect was successful. * Changes in DBD::Oracle 0.51 (Oraperl 1.37), 5rd July 1998 Makefile.PL no longer tries to link with just -lclntsh directly :-( Improvements to some HP-UX builds (hopefully). DBI->data_sources ' dummy ' value removed (and list now sorted). connect failure now shows actual Oracle error message again. Initial (incomplete) support for binding cursor vars (see t/plsql.t). * Changes in DBD::Oracle 0.50 (Oraperl 1.36), 3rd June 1998 Makefile.PL changes: fixed -c option, now searches for .h files, tries alternate location for sysliblist, checks for executable orainst/inspdver before using it. Fixed cursor leak. Added first word of tnsnames.ora name as aliases if no clash. * Changes in DBD::Oracle 0.49 (Oraperl 1.36), 1st June 1998 Further improvements to build process over 0.48. Fixed broken truncation error in 0.48. Fetch ORACLE_SID from Win32 registry (thanks to Preston Bannister) Improved automatic row cache sizing (prompted by Jon Meek). Added $sth->{ora_cache_rows} and $sth->{ora_est_row_width} as read-only attributes to make cache size logic easier to test. * Changes in DBD::Oracle 0.48 (Oraperl 1.36), 25th May 1998 THIS IS AN EXPERIMENTAL RELEASE - USE WITH CAUTION! Now links to -lclntsh directly (Thanks to Bruce Nelson and others) Workaround for broken backticks after login (Thanks to Warren Jones) Now finds and reads tnsnames.ora to disambiguate dbnames in connect. Added basic support for bind_param(..., SQL_TYPE). Fixed bind_param_inout after execute. Added dbms_output_(enable|put|get) functions. Added $dbh->ping. Added DBI->data_sources('Oracle'); $sth->rows now warns if called for select before rows fetched. Fixed RAW types to not truncate. Improved quality and clarity of trace information. Requires DBI 0.92 * Changes in DBD::Oracle 0.47 (Oraperl 1.35), 8th Sept 1997 $h->{InactiveDestroy} = 1; now works reliably (with DBI 0.90). Makefile.PL changed for Oracle8. Thanks to Philippe Vanhaesendonck. Long params now work. Thanks to Michael Harvey. (Long params don't yet work for inout params.) AutoCommit flag now per-dbh. Thanks to Irving Reid. Fixed panic: _dbd_rebind_ph when binding an undef. Added $dbh->ping method (for Apache::DBI users). Some field-level fetch errors didn't cause the fetch to fail (the field was simply set undef). LongReadLen now works (if $Oraperl::ora_trunc unset or <= 0) LongTruncOk now works (for non oraperl mode handle). * Changes in DBD::Oracle 0.46 (Oraperl 1.34), 20th June 1997 Fixed Makefile.PL to work with 5.004_01. Some VMS support from Dan Sugalski If ORACLE_HOME isn't set, Oracle.pm no longer tries to guess it. bind_param_inout now checks for read-only variables. Requires DBI 0.84. * Changes in DBD::Oracle 0.45 (Oraperl 1.33), 16th June 1997 A $dbh DESTROY without an explicit disconnect does a rollback. Note that this may 'break' existing 'lazy' code but is completely essential for robust applications. See comments in Oracle.xs. Added Makefile.PL changes from Eric Bartley and others. The changes should fix build problems for Oracle 7.3.x. Requires DBI 0.83. Oraperl now uses DBI->connect and thus works with DBI 0.81 to automatically support Apache without requiring script changes. Reworked parameter binding in preparation for future changes. - mutated placeholder values are now automatically rebound. - in/out vars that become undef/null after binding now work. - transparent support for longs should be easier to implement. Added Win32 support from Jeff Urlwin. Added some documentation to DBD::Oracle for 'perldoc DBD::Oracle'. Most tests now converted to standard t/*.t format. Added $sth->{NULLABLE}->[$field]. Added private plsql_errstr method: $txt=$dbh->func('plsql_errstr') to fetch PL/SQL error messages. Thanks to Bob Menteer. Added $sth->{ora_pad_empty} and ORAPERL_PAD_EMPTY env var for better compatibility with old oraperl. Added $sth->{AutoCommit} FETCH. Added $sth->{ChopBlanks} (but not yet tested). No longer asks Oracle for text of login failure message since that can cause oracle's code to hang (sigh). We provide fake text for the most common errors and a useful default for the rest. You can set DBD_ORACLE_LOGIN_ERR env var to revert to old behaviour. The Copyright terms for DBD::Oracle have changed and now read as follows: You may distribute under the terms of either the GNU General Public License or the Artistic License, as specified in the Perl README file, with the exception that it cannot be placed on a CD-ROM or similar media for commercial distribution without the prior approval of the author. * Changes in DBD::Oracle 0.44 (Oraperl 1.30), 14th Jan 1997 Fixed leak in read_blob (thanks to Jurgen Botz for the patch). Improved automatic cache sizing (so better default caching). Negative cache size specifies desired cache/transfer size in bytes. Added $rowid = $csr->{ora_rowid} attribute (untested, please test). (Use via $csr->bind_param(1, $rowid, { ora_type => 11 });) Queries returning LONG's are no longer cached (so there's no need to set the cache to 1 explicitly to get read_blob to work). Added a test using string type with bind_param_inout in test.pl. Worked around the rather sad VMS linker case insensitivity. Worked around VMS linker length warning on XS...disconnect_all. Makefile.PL deletes non-existant files from $(COMPOBJS) (thanks to aburlison@cix.compulink.co.uk for the original patch) * Changes in DBD::Oracle 0.43 (Oraperl 1.30), 29nd Oct 1996 Fixed serious 'false ora_errno 1 after short select' bug. Worked around oracle bug that makes cda->ft unreliable. Do not use DBD::Oracle 0.41 or 0.42. Cursors are now 'describe'd at prepare time thus making NUM_OF_FIELDS always available. Describe does nothing for non-select operations. NUM_OF_FIELDS > 0 is now used to select between oexec() and oexfet() in execute(). Added more internal debugging. Improved test.pl. * Changes in DBD::Oracle 0.42 (Oraperl 1.30), 28nd Oct 1996 Fixed serious 'cache empty after re-bind' bug. Do not use DBD::Oracle 0.41. Implemented oexfet (combined execute and cache fetch) for select operations. This is a further significant speed up. Many selects now make only one trip to Oracle (after prepare) which combines the execute and fetching multiple rows. * Changes in DBD::Oracle 0.41 (Oraperl 1.30), 22nd Oct 1996 Added the long overdue row cache to DBD::Oracle. (Thanks to Reetnem@aol.com for providing a patch that prompted me to complete the work.) Oraperl $ora_cache and cache parameter to ora_open now work. Default cache size is adjusted automatically for row width. Major reworking of field buffer memory management. Added a more internal debugging. Further updates to the README files. * Changes in DBD::Oracle 0.40 (Oraperl 1.29), 14th Oct 1996 WARNING - This release contains significant changes to the placeholding binding code. You should test it carefully before using in live systems. Implemented PL/SQL output values via $sth->bind_param_inout. See the code at the end of test.pl for example usage. Binding is now implemented using obndra rather than obndrv. This may have a subtle effect when matching char fields against placeholders with trailing spaces. Fixed bind_param ora_type attribute. Thanks to Stephen Zander for the patch. Updated README's. Added README.longs. * Changes in DBD::Oracle 0.39 (Oraperl 1.29), 23rd Sep 1996 Fix for DEC "target := MACRO = string" Makefile syntax. Added README notes from Dave Moellenhoff, Lou Henefeld and others. Added README.login from James Taylor. Added README.client with various notes about building DBD::Oracle on minimaly configured client systems. Extra parameters to ora_do are now passed to DBI's do(). (This is an extension to the original oraperl ora_do.) * Changes in DBD::Oracle 0.38 (Oraperl 1.28), 22th Aug 1996 Overhaul of Makefile variable parsing. Should now cope with complex variables which expand to nested shell escapes. Try perl Makefile.PL -v to watch the fun. Updated README, Makefile.PL and test.pl messages for clarity. Fixed possible memory corruption in dbd_bind_ph(). * Changes in DBD::Oracle 0.37 (Oraperl 1.28), 25th July 1996 Fixed Makefile.PL for Oracle 7.3.2. Fixed $num_fields = ora_fetch($csr) before first fetch for queries with bind vars. Fixed occasional core dump on global destruct. * Changes in DBD::Oracle 0.36 (Oraperl 1.28), 10th July 1996 Fixed bind_param ora_type attribute. Fixed preparse to allocate enough memory for worst case. Fixed broken HP-UX 10 check in Makefile.PL. Other assorted Makefile.PL improvements. (Many thanks to those who sent in fixes.) * Changes in DBD::Oracle 0.35 (Oraperl 1.28), 21st June 1996 Fixed broken Solaris 2.5 check in Makefile.PL. Added ld path to the log. * Changes in DBD::Oracle 0.34 (Oraperl 1.28), 21st June 1996 Workaround Solaris 2 bug #1224467 (_rmutex_unlock). With many thanks to James Taylor. Added 'Bad free()' warning suppression to ora_logon and ora_logoff(). Setting the DBD_DUMP environment variable will trigger a (handy for me) core dump if a Bad free warning is detected. Further additions to the README about Bad free()'s. * Changes in DBD::Oracle 0.33 (Oraperl 1.27), 19th June 1996 Added Makefile.PL -g option to enable debugging. Added Makefile.PL -s symbol_name option to search for symbols. Reorganised the way Makefile.PL uses MakeMaker liblist code. Oraperl defaults to the 'safe' (normal) mode of using the DBI. Oraperl uses sigtrap on SEGV & BUS to give a perl stack trace. Added README notes about -g option, core files and stack traces. Small change to $dbname/$user/$passwd logic in connect. * Changes in DBD::Oracle 0.32 (Oraperl 1.25), 30th May 1996 Fixed memory leak when FETCH'ing attributes. Fixed Makefile.PL FileHandle problem (forgot 'use FileHandle;'). Enhanced Makefile.PL support for Oracle 7.3. * Changes in DBD::Oracle 0.31 (Oraperl 1.25), 20th May 1996 Makefile.PL for HP-UX now defaults to dynamic for hpux >= 10. execute (ora_bind/ora_do) now returns undef on error or the number of rows affected (0 is returned as 0E0, hence true, for okay but no rows affected or no row count available/applicable). This matches the oraperl version 2.4 behaviour. Made an attempt at supporting Oracle 7.3 (e.g. include's in proc.mk) Please let me know if it works (else supply patches to fix it :-) Fixed small memory leak in ora_titles etc functions. * Changes in DBD::Oracle 0.30, 7th May 1996 THE ORAPERL EMULATION LAYER IS NOW FORMALLY RELEASED (NO LONGER ALPHA). Note that the underlying DBI and DBD::Oracle interfaces remain alpha because they are still subject to (possibly significant) change. Oraperl v2 used to return the string 'OK' to indicate success with a zero numeric value. The Oraperl emulation now uses the string '0E0' to achieve the same effect since it does not cause any -w warnings when used in a numeric context. Fixed typecast warning (s/safefree/Safefree). Automatically sets/resets ORACLE_HOME from oratab value for sid. TO DO: Automatic configuration from Oracle 7.3 is not yet working (Oracle have reorganised the makefiles yet again!). * Changes in DBD::Oracle 0.29, 2 March 1996 Fixed Makefile.PL to get DBIXS.h from right spot. Changes to suit perl5.002 and site_lib directories. Detects old versions ahead of new in @INC. Random tidy-ups. * Changes in DBD::Oracle 0.28, 29 Jan 1996: Minor release for Perl5.002 (beta2 or later). Requires Perl5.002 and DBI 0.66; Only functional change is to suppress (rare) 'handle not setup' warnings unless debugging. * Changes in DBD::Oracle 0.27, 16 Nov 1995: Improved oraperl compatibility in assorted ways. Added the original oraperl manual to Oraperl.pm as pod. (perldoc Oraperl will display the manual). The manual highlights remaining differences in the emulation. Added original oraperl examples into oraperl.ex directory. Improved error reporting in test.pl. Removed some internal limits. Renamed readblob to blob_read and fixed return value. Implemented $sth = $dbh->tables method (see DBI changes file). Uses $Config{archlibexp} not $Config{archlib} in makefile.PL Requires DBI-0.65. I've still not got around to implementing a row cache (array fetch) but it's next on my list. This should be the last alpha release of the oraperl emulation. (The DBD::Oracle module itself will remain alpha for awhile yet.) * Changes in DBD::Oracle 0.26, 23 Oct 1995: Removed error message (sql) size limits in parse and ora_error. Fixed FETCH NUM_OF_PARAMS so it doesn't trigger a describe. The ora_lengths and ora_types attributes work in non-oraperl mode. * Changes in DBD::Oracle 0.25, 26 Aug 1995: User visible changes: Fixed bug in parsing '?' style placeholders. $sth->bind_param now checks for a too long LONG type string. $sth->prepare now takes attributes: ora_parse_lang => 0 | 1 | 2 (v6, auto v6/v7, v7) ora_parse_defer => 0 | 1 (control defered parsing) Other changes to be propogated to other drivers: Added usage of new DBD_ATTRIB_* macros to XS and C code. dbd_bind_ph return value inverted to make it consistent. Added braces around XSRETURN_UNDEF in execute. Checked for describe failure in FETCH. Removed NumParams since it's now called NUM_OF_PARAMS in DBI. Updated NEED_DBIXS_VERSION in Oracle.h * Changes in DBD::Oracle 0.24, 22 Aug 1995: User visible changes: $sth->bind_param method implemented (needs testing :-) and new DBI $sth->bind_col* methods work for DBD::Oracle. Other changes to be propogated to other drivers: - Slight change to STORE functions to allow them to return status if called as $h->STORE(...). - Revised signature of dbd_bind_ph function and added a bind_param method for it. Prototype moved from dbdimp.h to Oracle.h - Revised execute method to use modified dbd_bind_ph function and remove remaining oracle specifics. - imp_xxh_t structures first element now called 'com' not 'dbihcom' and new DBI macros used to access fields. * Changes in DBD::Oracle 0.23, 18 Aug 1995: Fixed Oraperl.pm debug which was left on by default by accident. Added small patches from Davide.Migliavacca@inferentia.it for longs (dbtype_is_long, dbd_describe and dbd_st_readblob). Added svr4 hints from Alan Burlison Changed dbd_describe to return true for success (to be consistent). * Changes in DBD::Oracle 0.22, 17 Aug 1995: Much more maturity, in line with the required DBI-0.60 release. The .xs file is now very 'clean'. It's an excellent base for developing other drivers. See notes in the DBI Changes file. The oraperl &ora_do should be working now (along with $sth->do()). It does not leak (as far as I can tell). This release is stable enough for general use again (like 0.20). Please test heavily. * Changes in DBD::Oracle 0.21, 15 Aug 1995: NOTE: THIS IS AN UNSTABLE RELEASE! It requires the closely related DBI 0.59 release. See Changes file in that release. Major reworking of internal data management! Only execute and fetchrow have yet to move into dbdimp.c. These were kept back since I plan other associated changes. Known problems: Warning mode is on by default so certain oraperl coding styles cause warnings such as: Statement handle ... destroyed without finish() at ... disconnect(...) invalidates 1 associated cursor(s) at ... In future oraperl mode handles will have those warnings disabled. ...other changes to numerous/minor to mention * Changes in DBD::Oracle 0.20, 1 Aug 1995: Fixed core dump when binding an undef (treated as a NULL) Binding a string longer that 2000 bytes will use LONG type. Workaround OSF makefile and oratype.h problems PL/SQL := construct will no longer confuse dbd_preparse() * Changes in DBD::Oracle 0.19, 21 June 1995: Added $VERSION disconnect_all now gives error 'not implemented'. Reworked memory management, imp_dbh's are cached. imp_dbh_t now has an in_use flag and generation counter. st::DESTROY now checks its imp_dbh for validity. &ora_do() now returns "OK" for 0 rows (as per oraperl). Reworked logging to use DBILOGFP macro. Now test code added to loop through logon/prep/fin/logoff. * Changes in DBD::Oracle 0.18, 17th June 1995 Makefile.PL: HPUX now builds with LINKTYPE=static automatically. Fixed errors on logout/global destruction. Added logout/global destruction test to test.pl. Changed Oraperl.pm default mode from safe to fast (see func_ref()). Added platform who's-who list to README. Added $sth->readblob($field, $offset, $length [, \$dest) method. (You need to add the following after line 80 in DBI/DBI.pm: 'readblob' => {'U'=>[4,5,'$field, $offset, $len [, \\$buf]']}, in order to access the new readblob method.) * Changes in DBD::Oracle 0.17, 9th June 1995 Further enhancements to proc.mk parsing (this should fix the bug introduced in the last version which required the manual editing of -lora etc into the link line). Automatic use of proc16.mk if proc.mk not found. Automatic use of -Xa if compiler is 'clcc' (CenterLine). Further migration of code from Oracle.xs to dbdimp.c. This is not complete but may give you a flavor of my current direction. Fixed more warnings from pedantic compilers. [Released with DBI 0.56] * Changes in DBD::Oracle 0.16, 25 May 1995 Makefile.PL more robust and flexible. Code restructured - much more still to do. Changes to ora_do. It's probably still not right. [Released with DBI 0.55] * Changes in DBD::Oracle 0.15, 25 Apr 1995 Fixed all known build problems/core dumps/truncated data etc. Returns undef for NULLS. Bind vars still not supported (soon I hope). Bind vars produce errors rather than being ignored. Login usage of ORACLE_SID and TWO_TASK slightly revised. test.pl now uses ORACLE_SID, TWO_TASK and ORACLE_USER if defined. * Changes in DBD::Oracle 0.14, 5 Apr 1995 Fixed assorted build and core-dump problems. * Changes in DBD::Oracle 0.13, 8th March 1995 "Another alpha release but hey, guess what, this one actually allows you to fetch data :-)" * Changes in DBD::Oracle 0.12, 1st March 1995 "For DBD::Oracle I have implemented a fairly radical way to deal with the nightmare of Oracle OCI makefiles. Rather than try to maintain a *large* and complicated set of Makefile macros the DBD::Oracle Makefile.PL now actually extracts the macros which oracle itself uses from $ORACLE_HOME/rdbms/lib/oracle.mk! (The horses mouth, so to speak.)" [Released with DBI 0.53] * Changes in DBD::Oracle 0.11, 24th Feb 1995 "The first fruits of that work are now available for the brave (or foolhardy). Take note: this very much *unsupported* *alpha* software (it does not even fetch records from oracle yet). Feel free to ftp it but don't expect to do anything very useful with it." Also first release of the Oraperl emulation module: "Yes, that's real oraperl code and it works! The only addition is the 'use DBD::Oraperl' line." [Released with DBI 0.51] * ANCIENT HISTORY 12th Oct 1994: First public release of the DBI module. (for Perl 5.000-beta-3h) 19th Sep 1994: DBperl project renamed to DBI. 29th Sep 1992: DBperl project started. DBD-Oracle-1.74/LICENSE0000644000175000017500000004364412326332111013571 0ustar yanickyanickThis software is copyright (c) 1994 by Tim Bunce. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 1994 by Tim Bunce. This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 1994 by Tim Bunce. This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End DBD-Oracle-1.74/README.help.txt0000644000175000017500000003164612326332111015210 0ustar yanickyanick=============================================================================== Platform or Oracle Version specific notes, hints, tips etc: Note that although some of these refer to specific systems and versions the same or similar problems may exist on other systems or versions. Most of this mess is due to Oracle's fondness for changing the build/link process for OCI applications between versions. ------------------------------------------------------------------------------- AIX 4 - core dump on login and similar problems set cc='xlc_r' in config.sh. Rebuild everything, and make sure xlc_r is used everywhere. set environment ORACCENV='cc=xlc_r'; export ORACCENV to enforce this in oraxlc Thanks to Goran Thyni for this information. ------------------------------------------------------------------------------- AIX - core dump on disconnect (SIGILL signal) Try setting BEQUEATH_DETACH=YES in SQLNET.ORA and restarting Oracle instance. See 'Hang during "repetitive connect/open/close/disconnect" test' below. ------------------------------------------------------------------------------- HP-UX: General Read README.hpux.txt. Then read it again. HP's bundled C compiler is dumb. Very dumb. You're almost bound to have problems if you use it - you'll certainly need to do a 'static link' (see elsewhere). It is recommended that you use HP's ANSI C compiler (which costs) or fetch and build the free GNU GCC compiler (v2.7.2.2 or later). Note that using shared libraries on HP-UX 10.10 (and others?) requires patch 441647. With thanks to John Liptak . ------------------------------------------------------------------------------- HP-UX: Terry Greenlaw I traced a problem with "ld: Invalid loader fixup needed" to the file libocic.a. On HP-UX 9 it contains position-dependant code and cannot be used to generate dynamic load libraries. The only shared library that Oracle ships under HP-UX is liboracle.sl which replaces libxa.a, libsql.a, libora.a, libcvg.a, and libnlsrtl.a. The OCI stuff still appears to only link statically under HU-UX 9.x [10.x seems okay]. You'll need to build DBD::Oracle statically linked into the perl binary. See the static linking notes below. If you get an error like: Bad magic number for shared library: Oracle.a You'll need to build DBD::Oracle statically linked into the perl binary. HP-UX 10 and Oracle 7.2.x do work together when creating dynamic libraries. The problem was older Oracle libraries were built without the +z flag to cc, and were therefore position-dependent libraries that can't be linked dynamically. Newer Oracle releases don't have this problem and it may be possible to even use the newer Oracle libraries under HP-UX 9. Oracle 7.3 will ONLY work under HP-UX 10, however. HP-UX 10 and Oracle 7.3.x seem to have problems. You'll probably need to build DBD::Oracle statically linked (see below). The problem seems to be related to Oracle's own shared library code trying to do a dynamic load (from lxfgno() in libnlsrtl3.a or libclntsh.sl). If you get core dumps on login try uncommenting the /* #define signed */ line in dbdimp.h as a long-shot. Please let me know if this fixes it for you (but I doubt it will). ------------------------------------------------------------------------------- For platforms which require static linking. You'll need to build DBD::Oracle statically linked and then link it into a perl binary: perl Makefile.PL LINKTYPE=static make make perl (makes a perl binary in current directory) make test FULLPERL=./perl (run tests using the new perl binary) make install You will probably need to have already built and installed a static version of the DBI in order that it be automatically included when you do the 'make perl' above. Remember that you must use this new perl binary to access Oracle. ------------------------------------------------------------------------------- Error: Can't find loadable object for module DBD::Oracle in @INC ... You probably built DBD::Oracle for static linking rather than dynamic linking. See 'For platforms which require static linking' above for more info. If your platform supports dynamic linking then try to work out why DBD::Oracle got built for static linking. ------------------------------------------------------------------------------- Error: Syntax warnings/errors relating to 'signed' Remove the /* and */ surrounding the '/* #define signed */' line in dbdimp.h ------------------------------------------------------------------------------- ORA-00900: invalid SQL statement "begin ... end" You probably don't have PL/SQL Oracle properly/fully installed. ------------------------------------------------------------------------------- Connection/Login slow. Takes a long time and may coredump Oracle bug number: 227321 related to changing the environment before connecting to oracle. Reported to be fixed in 7.1.6 (or by patch 353611). To work around this bug, do not set any environment variables in your oraperl script before you call ora_login, and when you do call ora_login, the first argument must be the empty string. This means that you have to be sure that your environment variables ORACLE_SID and ORACLE_HOME are set properly before you execute any oraperl script. It is probably also possible to pass the SID to ora_login as part of the username (for example, ora_login("", "SCOTT/TIGER@PROD", "")), although I have not tested this. This workaround is based on information from Kevin Stock. Also check $ORACLE_HOME/otrace/admin. If it contains big *.dat files then you may have otrace enabled. Try setting EPC_DISABLED=TRUE in the environment of the database and listener before they're started. Oracle 7.3.2.2.0 sets this to FALSE by default, which turns on tracing of all SQL statements, and will cause very slow connects once that trace file gets big. You can also add (ENVS='EPC_DISABLED=TRUE') to the SID_DESC part of listener.ora entries. (With thanks to Johan Verbrugghen jverbrug@be.oracle.com) ------------------------------------------------------------------------------- Connection/Login takes a long time Try connect('', 'user/passwd@tnsname', ''). See README.login.txt and item above. ------------------------------------------------------------------------------- Error: ORA-00604: error occurred at recursive SQL level (DBD: login failed) This can happen if TWO_TASK is defined but you connect using ORACLE_SID. ------------------------------------------------------------------------------- Error: ld: Undefined symbols _environ _dlopen _dlclose ... Environment: SunOS 4.1.3, Oracle 7.1.6 Steve Livingston If you get link errors like: ld: Undefined symbols _environ _dlopen _dlclose ... and the link command line includes '-L/usr/5lib -lc' then comment out the 'CLIBS= $(OTHERLIBS) -L/usr/5lib -lc' line in the Makefile. ------------------------------------------------------------------------------- Error: fatal: relocation error: symbol not found: main Environment: Solaris, GCC Do not use GNU as or GNU ld on Solaris. Delete or rename them, they are just bad news. In the words of John D Groenveld : Run, dont walk, to your console and 'mv /opt/gnu/bin/as /opt/gnu/bin/gas; mv /opt/gnu/bin/ld /opt/gnu/bin/gld'. You can add -v to the gcc command in the Makefile to see what GCC is using. ------------------------------------------------------------------------------- Error: relocation error:symbol not found:setitimer Environment: SVR4, stephen.zander@mckesson.com Error: can't load ./blib/arch/auto/DBD/Oracle/Oracle.so for module DBD::Oracle: DynamicLinker:/usr/local/bin/perl:relocation error:symbol not found:setitimer Fix: Try adding the '-lc' to $ORACLE_HOME/rdbms/lib/sysliblist (just make sure it's not on a new line). ------------------------------------------------------------------------------- Error: relocation error:symbol not found:mutex_init Environment: UnixWare 7.x, earle.nietzel@es.unisys.com On the UnixWare 7.x platform the compiler flag -Kthread is commonly used when compiling for mulithread however in this case you should use -lthread. The compiler will complain that you should be using -Kthread and not -lthread, you should ignore these messages. Besure to check this compiler flag in $ORACLE_HOME/lib/sysliblist also. ------------------------------------------------------------------------------- Error: Undefined symbols __cg92_used at link time. Environment: Solaris, GCC Fix: If you're compiling Oracle applications with gcc on Solaris you need to link with a file called $ORACLE_HOME/lib/__fstd.o. If you compile with the SparcWorks compiler you need to add the command line option on -xcg92 to resolve these symbol problems cleanly. Alligator Descartes ------------------------------------------------------------------------------- Environment: SunOS 4.1.3, Oracle 7.1.3 John Carlson Problem: oraperl and DBD::Oracle fail to link. Some messing around with the library order makes the link succeed. Now I get a "Bad free()" when ora_logoff is called. Solution: In my case, this was caused by a faulty oracle install. The install grabbed the wrong version of mergelib (The X11R6 one) instead of the one in $ORACLE_HOME/bin. Try a more limited path and reinstall Oracle again. ------------------------------------------------------------------------------- Environment: SGI IRIX From Dennis Box : Details instructions are available from http://misdev.fnal.gov/~dbox/n32/ (To build IRIX n32 format using the Oracle n32 toolkit.) From Mark Duffield : (possibly now out of date) Oracle only supports "-32" and "-mips2" compilation flags, not "-n32". Configure and build perl with -32 flag (see perl hints/irix_6.sh file in the perl distribution). Rebuild DBI (which will now use the -32 flag). Rebuild DBD::Oracle (which will now use the -32 flag). Since IRIX depends on the perl executable in /usr/sbin, you'll have to keep it around along with the one you just built. Some care will need to be taken to make sure that you are getting the right perl, either through explicitly running the perl you want, or with a file header in your perl file. The file header is probably the better solution of the two. In summary, until Oracle provides support for either the "-n32" or the "-64" compiler switches, you'll have to have a perl, DBI, and DBD-Oracle which are compiled and linked "-32". I understand that Oracle is working on a 64bit versions of V7.3.3 for SGI (or MIPS ABI as they call it), but I don't have any firm dates. You may also need to use perl Makefile.PL -p. ------------------------------------------------------------------------------- Environment: 64-bit platforms (DEC Alpha, OSF, SGI/IRIX64 v6.4) Problem: 0 ORA-00000: normal, successful completion Solution: Add '#define A_OSF' to Oracle.h above '#include ' and complain to Oracle about bugs in their header files on 64 bit systems. ------------------------------------------------------------------------------- Link errors or test core dumps Try each of these in turn (follow each with a make && make test): perl Makefile.PL -nob perl Makefile.PL -c perl Makefile.PL -l perl Makefile.PL -n LIBCLNTSH let me know if any of these help. =============================================================================== Hang during "repetitive connect/open/close/disconnect" test: From: "Alexi S. Lookin" In short, this problem was solved after addition of parameter BEQUEATH_DETACH=YES in SQLNET.ORA and restarting Oracle instance. Browsed Net8 doc (A67440-01 Net8 Admin Guide for Oracle 8.1.5, Feb.1999) and found some mention of inadequate bequeath behaviour when disconnecting bequeath session, and some solution for this problem at page 10-15 (may vary at any other release) : "p.10-15 Child Process Termination Since the client application spawns a server process internally through the Bequeath protocol as a child process, the client application becomes responsible for cleaning up the child process when it completes. When the server process completes its connection responsibilities, it becomes a defunct process. Signal handlers are responsible for cleaning up these defunct processes. Alternatively, you may configure your client SQLNET.ORA file to pass this process to the UNIX init process by disabling signal handlers. Use the Net8 Assistant to configure a client to disable the UNIX signal handler. The SQLNET.ORA parameter set to disable is as follows: bequeath_detach=yes This parameter causes all child processes to be passed over to the UNIX init process (pid = 1). The init process automatically checks for "defunct" child processes and terminates them. Bequeath automatically chooses to use a signal handler in tracking child process status changes. If your application does not use any signal handling, then this default does not affect you." =============================================================================== End. DBD-Oracle-1.74/README.mkdn0000644000175000017500000052066712326332111014401 0ustar yanickyanick# NAME DBD::Oracle - Oracle database driver for the DBI module # VERSION version 1.74 # SYNOPSIS use DBI; $dbh = DBI->connect("dbi:Oracle:$dbname", $user, $passwd); $dbh = DBI->connect("dbi:Oracle:host=$host;sid=$sid", $user, $passwd); # See the DBI module documentation for full details # for some advanced uses you may need Oracle type values: use DBD::Oracle qw(:ora_types); # DESCRIPTION DBD::Oracle is a Perl module which works with the DBI module to provide access to Oracle databases. This documentation describes driver specific behaviour and restrictions. It is not supposed to be used as the only reference for the user. In any case consult the [DBI](https://metacpan.org/pod/DBI) documentation first! # CONSTANTS - :ora\_session\_modes ORA\_SYSDBA ORA\_SYSOPER ORA\_SYSASM ORA\_SYSBACKUP ORA\_SYSDG ORA\_SYSKM - :ora\_types ORA_VARCHAR2 ORA_STRING ORA_NUMBER ORA_LONG ORA_ROWID ORA_DATE ORA_RAW ORA_LONGRAW ORA_CHAR ORA_CHARZ ORA_MLSLABEL ORA_XMLTYPE ORA_CLOB ORA_BLOB ORA_RSET ORA_VARCHAR2_TABLE ORA_NUMBER_TABLE SQLT_INT SQLT_FLT ORA_OCI SQLT_CHR SQLT_BIN - SQLCS\_IMPLICIT - SQLCS\_NCHAR SQLCS\_IMPLICIT and SQLCS\_NCHAR are _character set form_ values. See notes about Unicode elsewhere in this document. - SQLT\_INT - SQLT\_FLT These types are used only internally, and may be specified as internal bind type for ORA\_NUMBER\_TABLE. See notes about ORA\_NUMBER\_TABLE elsewhere in this document - ORA\_OCI Oracle doesn't provide a formal API for determining the exact version number of the OCI client library used, so DBD::Oracle has to go digging (and sometimes has to more or less guess). The ORA\_OCI constant holds the result of that process. In string context ORA\_OCI returns the full "A.B.C.D" version string. In numeric context ORA\_OCI returns the major.minor version number (8.1, 9.2, 10.0 etc). But note that version numbers are not actually floating point and so if Oracle ever makes a release that has a two digit minor version, such as `9.10` it will have a lower numeric value than the preceding `9.9` release. So use with care. The contents and format of ORA\_OCI are subject to change (it may, for example, become a _version object_ in later releases). I recommend that you avoid checking for exact values. - :ora\_fetch\_orient OCI_FETCH_CURRENT OCI_FETCH_NEXT OCI_FETCH_FIRST OCI_FETCH_LAST OCI_FETCH_PRIOR OCI_FETCH_ABSOLUTE OCI_FETCH_RELATIVE These constants are used to set the orientation of a fetch on a scrollable cursor. - :ora\_exe\_modes OCI_STMT_SCROLLABLE_READONLY - :ora\_fail\_over OCI_FO_END OCI_FO_ABORT OCI_FO_REAUTH OCI_FO_BEGIN OCI_FO_ERROR OCI_FO_NONE OCI_FO_SESSION OCI_FO_SELECT OCI_FO_TXNAL OCI_FO_RETRY # DBI CLASS METHODS ## __connect__ This method creates a database handle by connecting to a database, and is the DBI equivalent of the "new" method. To open a connection to an Oracle database you need to specify a database connection string (URL), username and password. The connection string is always of the form: "dbi:Oracle:" There are several ways to identify a database: 1. If the database is local, specifying the SID or service name will be enough. 2. If the database is defined in a TNSNAMES.ORA file, you can use the service name given in the file 3. To connect without TNSNAMES.ORA file, you can use an EZCONNECT url, of the form: //host\[:port\]\[/service\_name\] If port name is not specified, 1521 is the default. If service name is not specified, the hostname will be used as a service name. The following examples show several ways a connection can be created: $dbh = DBI->connect('dbi:Oracle:DB','username','password'); $dbh = DBI->connect('dbi:Oracle:DB','username/password',''); $dbh = DBI->connect('dbi:Oracle:','username@DB','password'); $dbh = DBI->connect('dbi:Oracle:host=foobar;sid=DB;port=1521', 'scott/tiger', ''); $dbh = DBI->connect("dbi:Oracle://myhost:1522/ORCL",'username', 'password'); ### OS authentication To connect to a local database with a user which has been set up to authenticate via the OS ("ALTER USER username IDENTIFIED EXTERNALLY"): $dbh = DBI->connect('dbi:Oracle:','/',''); Note the lack of a connection name (use the ORACLE\_SID environment variable). If an explicit SID is used you will probably get an ORA-01004 error. That only works for local databases. (Authentication to remote Oracle databases using your Unix login name without a password is possible but it is not secure and not recommended so not documented here. ### Oracle Environment Variables To use DBD::ORACLE to connect to an Oracle database, ORACLE\_HOME environment variable should be set correctly. In general, the value used should match the version of Oracle that was used to build DBD::Oracle. If using dynamic linking then ORACLE\_HOME should match the version of Oracle that will be used to load in the Oracle client libraries (via LD\_LIBRARY\_PATH, ldconfig, or similar on Unix). Oracle can use two environment variables to specify default connections: ORACLE\_SID and TWO\_TASK. To use them, specify either a local SID or service name, or a service name that is specified in the TNSNAMES.ORA file. Note that if you have \*both\* local and remote databases, and you have ORACLE\_SID \*and\* TWO\_TASK set, and you don't specify a fully qualified connect string on the command line, TWO\_TASK takes precedence over ORACLE\_SID (i.e. you get connected to remote system). It is highly recommended not to rely on environment variables and to always explicitly specify the SID in the connection string. This can prevent serious mistakes such as dropping a schema in the wrong database, and generally makes debugging and troubleshooting easier. Also remember that depending on the operating system you are using the differing "ORACLE" environment variables may be case sensitive, so if you are not connecting as you should double check the case of both the variable and its value. ### Timezones If the query is run through SQL\*Net (mostly queries that are executed on remote servers), Oracle will return the time zone based on the setting of the UNIX environment variable "TZ" for the user who started the listener. If the query is run locally, Oracle will return the time zone based on the "TZ" environment variable setting of the user running the query. With local queries, you can change the time zone for a particular user by simply changing the setting of "TZ". To check the current setting, issue the UNIX "date" command. ### Oracle DRCP DBD::Oracle supports DRCP (Database Resident Connection Pool) so if you have an 11.2 database and DRCP is enabled you can direct all of your connections to it by adding ':POOLED' to the SID or setting a connection attribute of ora\_drcp, or set the SERVER=POOLED when using a TNSENTRY style connection or even by setting an environment variable ORA\_DRCP. All of which are demonstrated below; $dbh = DBI->connect('dbi:Oracle:DB:POOLED','username','password') $dbh = DBI->connect('dbi:Oracle:','username@DB:POOLED','password') $dbh = DBI->connect('dbi:Oracle:DB','username','password',{ora_drcp=>1}) $dbh = DBI->connect('dbi:Oracle:DB','username','password',{ora_drcp=>1, ora_drcp_class=>'my_app', ora_drcp_min =>10}) $dbh = DBI->connect('dbi:Oracle:host=foobar;sid=ORCL;port=1521;SERVER=POOLED', 'scott/tiger', '') $dbh = DBI->connect('dbi:Oracle:', q{scott/tiger@(DESCRIPTION= (ADDRESS=(PROTOCOL=TCP)(HOST= foobar)(PORT=1521)) (CONNECT_DATA=(SID=ORCL)(SERVER=POOLED)))}, "") if the ORA_DRCP environment variable is set then just this $dbh = DBI->connect('dbi:Oracle:DB','username','password') You can find a white paper on setting up DRCP and its advantages at [http://www.oracle.com/technetwork/articles/oracledrcp11g-1-133381.pdf](http://www.oracle.com/technetwork/articles/oracledrcp11g-1-133381.pdf). Please note that DRCP support in DBD::Oracle is relatively new so the mechanics or its implementation are subject to change. ### TAF (Transparent Application Failover) Transparent Application Failover (TAF) is the feature in OCI that allows for clients to automatically reconnect to an instance in the event of a failure of the instance. The reconnect happens automatically from within the OCI (Oracle Call Interface) library. DBD::Oracle now supports a callback function that will fire when a TAF event takes place. You may use the callback to inform the user a failover is taking place or to setup the session again once the failover has succeeded. You will have to set up TAF on your instance before you can use this callback. You can test your instance to see if you can use TAF callback with $dbh->ora_can_taf(); If you try to set up a callback without it being enabled DBD::Oracle will croak. NOTE: Currently, you must enable TAF during DBI's connect. However once enabled you can change the TAF settings. It is outside the scope of this document to go through all of the possible TAF situations you might want to set up but here is a simple example: The TNS entry for the instance has had the following added to the CONNECT\_DATA section (FAILOVER_MODE= (TYPE=select) (METHOD=basic) (RETRIES=10) (DELAY=10)) You will also have to create your own perl function that will be called from the client. You can name it anything you want and it will always be passed two parameters, the failover event value and the failover type. You can also set a sleep value in case of failover error and the OCI client will sleep for the specified seconds before it attempts another event. use DBD::Oracle(qw(:ora_fail_over)); #import the ora fail over constants #set up TAF on the connection # NOTE since DBD::Oracle uses call_pv you may need to pass a full # name space as the function e.g., 'main::handle_taf' # NOTE from 1.49_00 ora_taf_function can accept a code ref as well # as a sub name as it now uses call_sv my $dbh = DBI->connect('dbi:Oracle:XE', 'hr', 'hr', {ora_taf_function => 'main::handle_taf'}); #create the perl TAF event function sub handle_taf { # NOTE from 1.49_00 the $dbh handle was passed to your callback my ($fo_event,$fo_type, $dbh) = @_; if ($fo_event == OCI_FO_BEGIN){ print " Instance Unavailable Please stand by!! \n"; printf(" Your TAF type is %s \n", (($fo_type==OCI_FO_NONE) ? "NONE" :($fo_type==OCI_FO_SESSION) ? "SESSION" :($fo_type==OCI_FO_SELECT) ? "SELECT" : "UNKNOWN!")); } elsif ($fo_event == OCI_FO_ABORT){ print " Failover aborted. Failover will not take place.\n"; } elsif ($fo_event == OCI_FO_END){ printf(" Failover ended ...Resuming your %s\n",(($fo_type==OCI_FO_NONE) ? "NONE" :($fo_type==OCI_FO_SESSION) ? "SESSION" :($fo_type==OCI_FO_SELECT) ? "SELECT" : "UNKNOWN!")); } elsif ($fo_event == OCI_FO_REAUTH){ print " Failed over user. Resuming services\n"; } elsif ($fo_event == OCI_FO_ERROR){ print " Failover error ...\n"; sleep 5; # sleep before having another go return OCI_FO_RETRY; } else { printf(" Bad Failover Event: %d.\n", $fo_event); } return 0; } The TAF types are as follows OCI_FO_SESSION indicates the user has requested only session failover. OCI_FO_SELECT indicates the user has requested select failover. OCI_FO_NONE indicates the user has not requested a failover type. OCI_FO_TXNAL indicates the user has requested a transaction failover. The TAF events are as follows OCI_FO_BEGIN indicates that failover has detected a lost connection and failover is starting. OCI_FO_END indicates successful completion of failover. OCI_FO_ABORT indicates that failover was unsuccessful, and there is no option of retrying. OCI_FO_ERROR also indicates that failover was unsuccessful, but it gives the application the opportunity to handle the error and retry failover. OCI_FO_REAUTH indicates that you have multiple authentication handles and failover has occurred after the original authentication. It indicates that a user handle has been re-authenticated. To find out which, the application checks the OCI_ATTR_SESSION attribute of the service context handle (which is the first parameter). ### Connect Attributes #### ora\_ncs\_buff\_mtpl You can customize the size of the buffer when selecting LOBs with the built-in AUTO Lob. The default value is 4 which is probably excessive for most situations but is needed for backward compatibility. If you not converting between a NCS on the DB and the Client then you might want to set this to 1 to reduce memory usage. This value can also be specified with the `ORA_DBD_NCS_BUFFER` environment variable in which case it sets the value at the connect stage. #### ora\_drcp For Oracle 11.2 or greater. Set to _1_ to enable DRCP. Can also be set via the `ORA_DRCP` environment variable. #### ora\_drcp\_class If you are using DRCP, you can set a CONNECTION\_CLASS for your pools as well. As sessions from a DRCP cannot be shared by users, you can use this setting to identify the same user across different applications. OCI will ensure that sessions belonging to a 'class' are not shared outside the class'. The values for ora\_drcp\_class cannot contain a '\*' and must be less than 1024 characters. This value can be also be specified with the `ORA_DRCP_CLASS` environment variable. #### ora\_drcp\_min This optional value specifies the minimum number of sessions that are initially opened. New sessions are only opened after this value has been reached. The default value is 4 and any value above 0 is valid. Generally, it should be set to the number of concurrent statements the application is planning or expecting to run. This value can also be specified with the `ORA_DRCP_MIN` environment variable. #### ora\_drcp\_max This optional value specifies the maximum number of sessions that can be open at one time. Once reached no more sessions can be opened until one becomes free. The default value is 40 and any value above 1 is valid. You should not set this value lower than ora\_drcp\_min as that will just waste resources. This value can also be specified with the `ORA_DRCP_MAX` environment variable. #### ora\_drcp\_incr This optional value specifies the next increment for sessions to be started if the current number of sessions are less than ora\_drcp\_max. The default value is 2 and any value above 0 is valid as long as the value of ora\_drcp\_min + ora\_drcp\_incr is not greater than ora\_drcp\_max. This value can also be specified with the `ORA_DRCP_INCR` environment variable. #### ora\_taf This attribute was removed in 1.49\_00 as it was redundant. To enable TAF simply set ["ora\_taf\_function"](#ora_taf_function). #### ora\_taf\_function If your Oracle instance has been configured to use TAF events you can enable the TAF callback by setting this option. The name of the Perl subroutine (or a code ref from 1.49\_00) that will be called from OCI when a TAF event occurs. You must supply a perl function to use the callback and it will always receive at least two parameters; the failover event value and the failover type. From 1.49\_00 the dbh is passed as the third argument. Below is an example of a TAF function sub taf_event{ # NOTE from 1.49_00 the $dbh handle is passed to the callback my ($event, $type, $dbh) = @_; print "My TAF event=$event\n"; print "My TAF type=$type\n"; return; } Note if passing a sub name you will probably have to use the full name space when setting the TAF function e.g., 'main::my\_taf\_function' and not just 'my\_taf\_function'. #### ora\_taf\_sleep This attribute was removed in 1.49\_00 as it was redundant. If you want to sleep between retries simple add a sleep to your callback sub. #### ora\_session\_mode The ora\_session\_mode attribute can be used to connect with SYSDBA, SYSOPER, ORA\_SYSASM, ORA\_SYSBACKUP, ORA\_SYSKM and ORA\_SYSDG authorization. The ORA\_SYSDBA, ORA\_SYSOPER, ORA\_SYSASM, ORA\_SYSBACKUP, ORA\_SYSKM and ORA\_SYSDG constants can be imported using use DBD::Oracle qw(:ora_session_modes); This is one case where setting ORACLE\_SID may be useful since connecting as SYSDBA or SYSOPER via SQL\*Net is frequently disabled for security reasons. Example: $dsn = "dbi:Oracle:"; # no dbname here $ENV{ORACLE_SID} = "orcl"; # set ORACLE_SID as needed delete $ENV{TWO_TASK}; # make sure TWO_TASK isn't set $dbh = DBI->connect($dsn, "", "", { ora_session_mode => ORA_SYSDBA }); It has been reported that this only works if `$dsn` does not contain a SID so that Oracle then uses the value of ORACLE\_SID (not TWO\_TASK) environment variable to connect to a local instance. Also the username and password should be empty, and the user executing the script needs to be part of the dba group or osdba group. #### ora\_oratab\_orahome Passing a true value for the ora\_oratab\_orahome attribute will make DBD::Oracle change `$ENV{ORACLE_HOME}` to make the Oracle home directory that specified in the `/etc/oratab` file _if_ the database to connect to is specified as a SID that exists in the oratab file, and DBD::Oracle was built to use the Oracle 7 OCI API (not Oracle 8+). #### ora\_module\_name After connecting to the database the value of this attribute is passed to the SET\_MODULE() function in the `DBMS_APPLICATION_INFO` PL/SQL package. This can be used to identify the application to the DBA for monitoring and performance tuning purposes. For example: my $dbh = DBI->connect($dsn, $user, $passwd, { ora_module_name => $0 }); $dbh->{ora_module_name} = $y; The maximum size is 48 bytes. NOTE: You will need an Oracle client 10.1 or later to use this. #### ora\_driver\_name For 11g and later you can now set the name of the driver layer using OCI. Perl, Perl5, ApachePerl so on. Names starting with "ORA" are reserved. You can enter up to 8 characters. If none is enter then this will default to DBDOxxxx where xxxx is the current version number. This value can be retrieved on the server side using V$SESSION\_CONNECT\_INFO or GV$SESSION\_CONNECT\_INFO my $dbh = DBI->connect($dsn, $user, $passwd, { ora_driver_name => 'ModPerl_1' }); $dbh->{ora_driver_name} = $q; #### ora\_client\_info Allows you to add any value (up to 64 bytes) to your session and it can be retrieved on the server side from the `V$SESSION`a view. my $dbh = DBI->connect($dsn, $user, $passwd, { ora_client_info => 'Remote2' }); $dbh->{ora_client_info} = "Remote2"; NOTE: You will need an Oracle client 10.1 or later to use this. #### ora\_client\_identifier Allows you to specify the user identifier in the session handle. Most useful for web applications as it can pass in the session user name which might be different to the connection user name. Can be up to 64 bytes long but do not to include the password for security reasons and the first character of the identifier should not be ':'. This value can be retrieved on the server side using `V$SESSION` view. my $dbh = DBI->connect($dsn, $user, $passwd, { ora_client_identifier => $some_web_user }); $dbh->{ora_client_identifier} = $local_user; #### ora\_action Allows you to specify any string up to 32 bytes which may be retrieved on the server side using `V$SESSION` view. my $dbh = DBI->connect($dsn, $user, $passwd, { ora_action => "Login"}); $dbh->{ora_action} = "New Long Query 22"; NOTE: You will need an Oracle client 10.1 or later to use this. #### ora\_dbh\_share Requires at least Perl 5.8.0 compiled with ithreads. Allows you to share database connections between threads. The first connect will make the connection, all following calls to connect with the same ora\_dbh\_share attribute will use the same database connection. The value must be a reference to a already shared scalar which is initialized to an empty string. our $orashr : shared = '' ; $dbh = DBI->connect ($dsn, $user, $passwd, {ora_dbh_share => \$orashr}) ; #### ora\_envhp The first time a connection is made a new OCI 'environment' is created by DBD::Oracle and stored in the driver handle. Subsequent connects reuse (share) that same OCI environment by default. The ora\_envhp attribute can be used to disable the reuse of the OCI environment from a previous connect. If the value is `0` then a new OCI environment is allocated and used for this connection. The OCI environment holds information about the client side context, such as the local NLS environment. By altering `%ENV` and setting ora\_envhp to 0 you can create connections with different NLS settings. This is most useful for testing. #### ora\_charset, ora\_ncharset For oracle versions >= 9.2 you can specify the client charset and ncharset with the ora\_charset and ora\_ncharset attributes. You still need to pass `ora_envhp = 0` for all but the first connect. These attributes override the settings from environment variables. $dbh = DBI->connect ($dsn, $user, $passwd, {ora_charset => 'AL32UTF8'}); #### ora\_verbose Use this value to enable DBD::Oracle only tracing. Simply either set the ora\_verbose attribute on the connect() method to the trace level you desire like this my $dbh = DBI->connect($dsn, "", "", {ora_verbose=>6}); or set it directly on the DB handle like this; $dbh->{ora_verbose} =6; In both cases the DBD::Oracle trace level is set to 6, which is the highest level tracing most of the calls to OCI. NOTE: In future versions of DBD::Oracle ora\_verbose will be changed so that it is simply a switch to turn DBI's DBD tracing on or off. A true value will turn it on and a false value will turn it off. DBI's "DBD" tracing was not available when ora\_verbose was created and ora\_verbose adds an additional test to every trace test. #### ora\_oci\_success\_warn Use this value to print otherwise silent OCI warnings that may happen when an execute or fetch returns "Success With Info" or when you want to tune RowCaching and LOB Reads $dbh->{ora_oci_success_warn} = 1; #### ora\_objects Use this value to enable extended embedded oracle objects mode. In extended: 1. Embedded objects are returned as instance (including type-name etc.) instead of simple ARRAY. 2. Determine object type for each instance. All object attributes are returned (not only super-type's attributes). $dbh->{ora_objects} = 1; #### ora\_ph\_type The default placeholder datatype for the database session. The `TYPE` or ["ora\_type"](#ora_type) attributes to ["bind\_param" in DBI](https://metacpan.org/pod/DBI#bind_param) and ["bind\_param\_inout" in DBI](https://metacpan.org/pod/DBI#bind_param_inout) override the datatype for individual placeholders. The most frequent reason for using this attribute is to permit trailing spaces in values passed by placeholders. Constants for the values allowed for this attribute can be imported using use DBD::Oracle qw(:ora_types); Only the following values are permitted for this attribute. - ORA\_VARCHAR2 Oracle clients using OCI 8 will strip trailing spaces and allow embedded \\0 bytes. Oracle clients using OCI 9.2 do not strip trailing spaces and allow embedded \\0 bytes. This is the normal default placeholder type. - ORA\_STRING Do not strip trailing spaces and end the string at the first \\0. - ORA\_CHAR Do not strip trailing spaces and allow embedded \\0. Force 'blank-padded comparison semantics'. For example: use DBD::Oracle qw(:ora_types); $SQL="select username from all_users where username = ?"; #username is a char(8) $sth=$dbh->prepare($SQL)"; $sth->bind_param(1,'bloggs',{ ora_type => ORA_CHAR}); Will pad bloggs out to 8 characters and return the username. #### ora\_parse\_error\_offset If the previous error was from a failed `prepare` due to a syntax error, this attribute gives the offset into the `Statement` attribute where the error was found. #### ora\_array\_chunk\_size Due to OCI limitations, DBD::Oracle needs to buffer up rows of bind values in its `execute_for_fetch` implementation. This attribute sets the number of rows to buffer at a time (default value is 1000). The `execute_for_fetch` function will collect (at most) this many rows in an array, send them off to the DB for execution, then go back to collect the next chunk of rows and so on. This attribute can be used to limit or extend the number of rows processed at a time. Note that this attribute also applies to `execute_array`, since that method is implemented using `execute_for_fetch`. #### ora\_connect\_with\_default\_signals Sometimes the Oracle client seems to change some of the signal handlers of the process during the connect phase. For instance, some users have observed Perl's default `$SIG{INT}` handler being ignored after connecting to an Oracle database. If this causes problems in your application, set this attribute to an array reference of signals you would like to be localized during the connect process. Once the connect is complete, the signal handlers should be returned to their previous state. For example: $dbh = DBI->connect ($dsn, $user, $passwd, {ora_connect_with_default_signals => [ 'INT' ] }); NOTE disabling the signal handlers the OCI library sets up may affect functionality in the OCI library. NOTE If you are using connect\_cached then the above example will lead to DBI thinking each connection is different as an anonymous array reference is being used. To avoid this when using connect\_cached you are advised to use: my @ora_default_signals = (...); $dbh = DBI->connect($dsn, $user, $passwd, {ora_connect_with_default_signals => \@ora_default_signals}); In more recent Perl versions you could possibly make use of new state variables. ## __connect\_cached__ Implemented by DBI, no driver-specific impact. Please note that connect\_cached as not been tested with DRCP. ## __data\_sources__ @data_sources = DBI->data_sources('Oracle'); @data_sources = $dbh->data_sources(); Returns a list of available databases. You will have to set either the 'ORACLE\_HOME' or 'TNS\_ADMIN' environment value to retrieve this list. It will read these values from TNSNAMES.ORA file entries. # METHODS COMMON TO ALL HANDLES For all of the methods below, __$h__ can be either a database handle (__$dbh__) or a statement handle (__$sth__). Note that _$dbh_ and _$sth_ can be replaced with any variable name you choose: these are just the names most often used. Another common variable used in this documentation is $_rv_, which stands for "return value". ## __err__ $rv = $h->err; Returns the error code from the last method called. ## __errstr__ $str = $h->errstr; Returns the last error that was reported by Oracle. Starting with "ORA-00000" code followed by the error message. ## __state__ $str = $h->state; Oracle hasn't supported SQLSTATE since the early versions OCI. It will return empty when the command succeeds and 'S1000' (General Error) for all other errors. While this method can be called as either `$sth->state` or `$dbh->state`, it is usually clearer to always use `$dbh->state`. ## __trace__ Implemented by DBI, no driver-specific impact. ## __trace\_msg__ Implemented by DBI, no driver-specific impact. ## __parse\_trace\_flag__ and __parse\_trace\_flags__ Implemented by DBI, no driver-specific impact. ## __func__ DBD::Oracle uses the `func` method to support a variety of functions. ## __Private database handle functions__ Some of these functions are called through the method func() which is described in the DBI documentation. Any function that begins with ora\_ can be called directly. ## __plsql\_errstr__ This function returns a string which describes the errors from the most recent PL/SQL function, procedure, package, or package body compile in a format similar to the output of the SQL\*Plus command 'show errors'. The function returns undef if the error string could not be retrieved due to a database error. Look in $dbh->errstr for the cause of the failure. If there are no compile errors, an empty string is returned. Example: # Show the errors if CREATE PROCEDURE fails $dbh->{RaiseError} = 0; if ( $dbh->do( q{ CREATE OR REPLACE PROCEDURE perl_dbd_oracle_test as BEGIN PROCEDURE filltab( stuff OUT TAB ); asdf END; } ) ) {} # Statement succeeded } elsif ( 6550 != $dbh->err ) { die $dbh->errstr; } # Utter failure else { my $msg = $dbh->func( 'plsql_errstr' ); die $dbh->errstr if ! defined $msg; die $msg if $msg; } ## __dbms\_output\_enable / dbms\_output\_put / dbms\_output\_get__ These functions use the PL/SQL DBMS\_OUTPUT package to store and retrieve text using the DBMS\_OUTPUT buffer. Text stored in this buffer by dbms\_output\_put or any PL/SQL block can be retrieved by dbms\_output\_get or any PL/SQL block connected to the same database session. Stored text is not available until after dbms\_output\_put or the PL/SQL block that saved it completes its execution. This means you __CAN NOT__ use these functions to monitor long running PL/SQL procedures. Example 1: # Enable DBMS_OUTPUT and set the buffer size $dbh->{RaiseError} = 1; $dbh->func( 1000000, 'dbms_output_enable' ); # Put text in the buffer . . . $dbh->func( @text, 'dbms_output_put' ); # . . . and retrieve it later @text = $dbh->func( 'dbms_output_get' ); Example 2: $dbh->{RaiseError} = 1; $sth = $dbh->prepare(q{ DECLARE tmp VARCHAR2(50); BEGIN SELECT SYSDATE INTO tmp FROM DUAL; dbms_output.put_line('The date is '||tmp); END; }); $sth->execute; # retrieve the string $date_string = $dbh->func( 'dbms_output_get' ); ## __dbms\_output\_enable ( \[ buffer\_size \] )__ This function calls DBMS\_OUTPUT.ENABLE to enable calls to package DBMS\_OUTPUT procedures GET, GET\_LINE, PUT, and PUT\_LINE. Calls to these procedures are ignored unless DBMS\_OUTPUT.ENABLE is called first. The buffer\_size is the maximum amount of text that can be saved in the buffer and must be between 2000 and 1,000,000. If buffer\_size is not given, the default is 20,000 bytes. ## __dbms\_output\_put ( \[ @lines \] )__ This function calls DBMS\_OUTPUT.PUT\_LINE to add lines to the buffer. If all lines were saved successfully the function returns 1. Depending on the context, an empty list or undef is returned for failure. If any line causes buffer\_size to be exceeded, a buffer overflow error is raised and the function call fails. Some of the text might be in the buffer. ## __dbms\_output\_get__ This function calls DBMS\_OUTPUT.GET\_LINE to retrieve lines of text from the buffer. In an array context, all complete lines are removed from the buffer and returned as a list. If there are no complete lines, an empty list is returned. In a scalar context, the first complete line is removed from the buffer and returned. If there are no complete lines, undef is returned. Any text in the buffer after a call to DBMS\_OUTPUT.GET\_LINE or DBMS\_OUTPUT.GET is discarded by the next call to DBMS\_OUTPUT.PUT\_LINE, DBMS\_OUTPUT.PUT, or DBMS\_OUTPUT.NEW\_LINE. ## __reauthenticate ( $username, $password )__ Starts a new session against the current database using the credentials supplied. ## __private\_attribute\_info__ $hashref = $dbh->private_attribute_info(); $hashref = $sth->private_attribute_info(); Returns a hash of all private attributes used by DBD::Oracle, for either a database or a statement handle. Currently, all the hash values are undef. # ATTRIBUTES COMMON TO ALL HANDLES ## __InactiveDestroy__ (boolean) Implemented by DBI, no driver-specific impact. ## __RaiseError__ (boolean, inherited) Forces errors to always raise an exception. Although it defaults to off, it is recommended that this be turned on, as the alternative is to check the return value of every method (prepare, execute, fetch, etc.) manually, which is easy to forget to do. ## __PrintError__ (boolean, inherited) Forces database errors to also generate warnings, which can then be filtered with methods such as locally redefining _$SIG{\_\_WARN\_\_}_ or using modules such as `CGI::Carp`. This attribute is on by default. ## __ShowErrorStatement__ (boolean, inherited) Appends information about the current statement to error messages. If placeholder information is available, adds that as well. Defaults to true. ## __Warn__ (boolean, inherited) Enables warnings. This is on by default, and should only be turned off in a local block for a short a time only when absolutely needed. ## __Executed__ (boolean, read-only) Indicates if a handle has been executed. For database handles, this value is true after the ["do"](#do) method has been called, or when one of the child statement handles has issued an ["execute"](#execute). Issuing a ["commit"](#commit) or ["rollback"](#rollback) always resets the attribute to false for database handles. For statement handles, any call to ["execute"](#execute) or its variants will flip the value to true for the lifetime of the statement handle. ## __TraceLevel__ (integer, inherited) Sets the trace level, similar to the ["trace"](#trace) method. See the sections on ["trace"](#trace) and ["parse\_trace\_flag"](#parse_trace_flag) for more details. ## __Active__ (boolean, read-only) Indicates if a handle is active or not. For database handles, this indicates if the database has been disconnected or not. For statement handles, it indicates if all the data has been fetched yet or not. Use of this attribute is not encouraged. ## __Kids__ (integer, read-only) Returns the number of child processes created for each handle type. For a driver handle, indicates the number of database handles created. For a database handle, indicates the number of statement handles created. For statement handles, it always returns zero, because statement handles do not create kids. ## __ActiveKids__ (integer, read-only) Same as `Kids`, but only returns those that are active. ## __CachedKids__ (hash ref) Returns a hashref of handles. If called on a database handle, returns all statement handles created by use of the `prepare_cached` method. If called on a driver handle, returns all database handles created by the ["connect\_cached"](#connect_cached) method. ## __ChildHandles__ (array ref) Implemented by DBI, no driver-specific impact. ## __PrintWarn__ (boolean, inherited) Implemented by DBI, no driver-specific impact. ## __HandleError__ (boolean, inherited) Implemented by DBI, no driver-specific impact. ## __HandleSetErr__ (code ref, inherited) Implemented by DBI, no driver-specific impact. ## __ErrCount__ (unsigned integer) Implemented by DBI, no driver-specific impact. ## __FetchHashKeyName__ (string, inherited) Implemented by DBI, no driver-specific impact. ## __ChopBlanks__ (boolean, inherited) Implemented by DBI, no driver-specific impact. ## __Taint__ (boolean, inherited) Implemented by DBI, no driver-specific impact. ## __TaintIn__ (boolean, inherited) Implemented by DBI, no driver-specific impact. ## __TaintOut__ (boolean, inherited) Implemented by DBI, no driver-specific impact. ## __Profile__ (inherited) Implemented by DBI, no driver-specific impact. ## __Type__ (scalar) Returns `dr` for a driver handle, `db` for a database handle, and `st` for a statement handle. Should be rarely needed. ## __LongReadLen__ The maximum size of long or longraw columns to retrieve. If one of these columns is longer than LongReadLen then either a data truncation error will be raised (LongTrunkOk is false) or the column will be silently truncated (LongTruncOk is true). DBI currently defaults this to 80. ## __LongTruncOk__ Implemented by DBI, no driver-specific impact. ## __CompatMode__ Type: boolean, inherited The CompatMode attribute is used by emulation layers (such as Oraperl) to enable compatible behaviour in the underlying driver (e.g., DBD::Oracle) for this handle. Not normally set by application code. It also has the effect of disabling the 'quick FETCH' of attribute values from the handles attribute cache. So all attribute values are handled by the drivers own FETCH method. This makes them slightly slower but is useful for special-purpose drivers like DBD::Multiplex. # ORACLE-SPECIFIC DATABASE HANDLE METHODS ## __ora\_can\_unicode ( \[ $refresh \] )__ Returns a number indicating whether either of the database character sets is a Unicode encoding. Calls ora\_nls\_parameters() and passes the optional $refresh parameter to it. 0 = Neither character set is a Unicode encoding. 1 = National character set is a Unicode encoding. 2 = Database character set is a Unicode encoding. 3 = Both character sets are Unicode encodings. ## __ora\_can\_taf__ Returns true if the current connection supports TAF events. False if otherwise. ## __ora\_nls\_parameters ( \[ $refresh \] )__ Returns a hash reference containing the current NLS parameters, as given by the v$nls\_parameters view. The values fetched are cached between calls. To cause the latest values to be fetched, pass a true value to the function. # ORACLE-SPECIFIC DATABASE FUNCTIONS ## __ora\_server\_version__ $versions = $dbh->func('ora_server_version'); Returns an array reference of server version strings e.g., [11,2,0,2,0] # DATABASE HANDLE METHODS ## __selectall\_arrayref__ $ary_ref = $dbh->selectall_arrayref($sql); $ary_ref = $dbh->selectall_arrayref($sql, \%attr); $ary_ref = $dbh->selectall_arrayref($sql, \%attr, @bind_values); Returns a reference to an array containing the rows returned by preparing and executing the SQL string. See the DBI documentation for full details. ## __selectall\_hashref__ $hash_ref = $dbh->selectall_hashref($sql, $key_field); Returns a reference to a hash containing the rows returned by preparing and executing the SQL string. See the DBI documentation for full details. ## __selectcol\_arrayref__ $ary_ref = $dbh->selectcol_arrayref($sql, \%attr, @bind_values); Returns a reference to an array containing the first column from each rows returned by preparing and executing the SQL string. It is possible to specify exactly which columns to return. See the DBI documentation for full details. ## __prepare__ $sth = $dbh->prepare($statement, \%attr); Prepares a statement for later execution by the database engine and returns a reference to a statement handle object. ### __Prepare Attributes__ These attributes may be used in the `\%attr` parameter of the ["prepare" in DBI](https://metacpan.org/pod/DBI#prepare) database handle method. - ora\_placeholders Set to false to disable processing of placeholders. Used mainly for loading a PL/SQL package that has been _wrapped_ with Oracle's `wrap` utility. - ora\_auto\_lob If true (the default), fetching retrieves the contents of the CLOB or BLOB column in most circumstances. If false, fetching retrieves the Oracle "LOB Locator" of the CLOB or BLOB value. See ["LOBS AND LONGS"](#lobs-and-longs) for more details. See also the LOB tests in 05dbi.t of Oracle::OCI for examples of how to use LOB Locators. - ora\_pers\_lob If true the ["Simple Fetch for CLOBs and BLOBs"](#simple-fetch-for-clobs-and-blobs) method for the ["Data Interface for Persistent LOBs"](#data-interface-for-persistent-lobs) will be used for LOBs rather than the default method ["Data Interface for LOB Locators"](#data-interface-for-lob-locators). - ora\_clbk\_lob If true the ["Piecewise Fetch with Callback"](#piecewise-fetch-with-callback) method for the ["Data Interface for Persistent LOBs"](#data-interface-for-persistent-lobs) will be used for LOBs. - ora\_piece\_lob If true the ["Piecewise Fetch with Polling"](#piecewise-fetch-with-polling) method for the ["Data Interface for Persistent LOBs"](#data-interface-for-persistent-lobs) will be used for LOBs. - ora\_piece\_size This is the max piece size for the ["Piecewise Fetch with Callback"](#piecewise-fetch-with-callback) and ["Piecewise Fetch with Polling"](#piecewise-fetch-with-polling) methods, in chars for CLOBS, and bytes for BLOBS. - ora\_check\_sql If 1 (default), force SELECT statements to be described in prepare(). If 0, allow SELECT statements to defer describe until execute(). See ["Prepare Postponed Till Execute"](#prepare-postponed-till-execute) for more information. - ora\_exe\_mode This will set the execute mode of the current statement. Presently only one mode is supported; OCI_STMT_SCROLLABLE_READONLY - make result set scrollable See ["SCROLLABLE CURSORS"](#scrollable-cursors) for more details. - ora\_prefetch\_rows Sets the number of rows to be prefetched. If it is not set, then the default value is 1. See ["Row Prefetching"](#row-prefetching) for more details. - ora\_prefetch\_memory Sets the memory level for rows to be prefetched. The application then fetches as many rows as will fit into that much memory. See ["Row Prefetching"](#row-prefetching) for more details. - ora\_row\_cache\_off By default DBD::Oracle will use a row cache when fetching to cut down the number of round trips to the server. If you do not want to use an array fetch set this value to any value other than 0; See ["Row Prefetching"](#row-prefetching) for more details. ### __Placeholders__ There are three types of placeholders that can be used in DBD::Oracle. The first is the "question mark" type, in which each placeholder is represented by a single question mark character. This is the method recommended by the DBI and is the most portable. Each question mark is internally replaced by a "dollar sign number" in the order in which they appear in the query (important when using ["bind\_param"](#bind_param)). The second type of placeholder is "named parameters" in the format ":foo" which is the one Oracle prefers. $dbh->{RaiseError} = 1; # save having to check each method call $sth = $dbh->prepare("SELECT name, age FROM people WHERE name LIKE :name"); $sth->bind_param(':name', "John%"); $sth->execute; DBI::dump_results($sth); Note when calling bind\_param with named parameters you must include the leading colon. The advantage of this placeholder type is that you can use the same placeholder more than once in the same SQL statement but you only need to bind it once. The last placeholder type is a variation of the two above where you name each placeholder :N (where N is a number). Like the named placeholders above you can use the same placeholder multiple times in the SQL but when you call bind\_param you only need to pass the N (e.g., for :1 you use bind\_param(1,...) and not bind\_param(':1',...). The different types of placeholders cannot be mixed within a statement, but you may use different ones for each statement handle you have. This is confusing at best, so stick to one style within your program. ## __prepare\_cached__ $sth = $dbh->prepare_cached($statement, \%attr); Implemented by DBI, no driver-specific impact. This method is most useful if the same query is used over and over as it will cut down round trips to the server. ## __do__ $rv = $dbh->do($statement); $rv = $dbh->do($statement, \%attr); $rv = $dbh->do($statement, \%attr, @bind_values); Prepare and execute a single statement. Returns the number of rows affected if the query was successful, returns undef if an error occurred, and returns -1 if the number of rows is unknown or not available. Note that this method will return __0E0__ instead of 0 for 'no rows were affected', in order to always return a true value if no error occurred. ## __last\_insert\_id__ Oracle does not implement auto\_increment of serial type columns it uses predefined sequences where the id numbers are either selected before insert, at insert time with a trigger, or as part of the query. Below is an example of you to use the latter with the SQL returning clause to get the ID number back on insert with the bind\_param\_inout method. . $dbh->do('CREATE SEQUENCE lii_seq START 1'); $dbh->do(q{CREATE TABLE lii ( foobar INTEGER NOT NULL UNIQUE, baz VARCHAR)}); $SQL = "INSERT INTO lii (foobar,baz) VALUES (lii_seq.nextval,'XX') returning foobar into :p_new_id";"; $sth = $dbh->prepare($SQL); my $p_new_id='-1'; $sth->bind_param_inout(":p_new_id",\$p_new_id,38); $sth->execute(); $db->commit(); ## __commit__ $rv = $dbh->commit; Issues a COMMIT to the server, indicating that the current transaction is finished and that all changes made will be visible to other processes. If AutoCommit is enabled, then a warning is given and no COMMIT is issued. Returns true on success, false on error. ## __rollback__ $rv = $dbh->rollback; Issues a ROLLBACK to the server, which discards any changes made in the current transaction. If AutoCommit is enabled, then a warning is given and no ROLLBACK is issued. Returns true on success, and false on error. ## __begin\_work__ This method turns on transactions until the next call to ["commit"](#commit) or ["rollback"](#rollback), if ["AutoCommit"](#autocommit) is currently enabled. If it is not enabled, calling begin\_work will issue an error. Note that the transaction will not actually begin until the first statement after begin\_work is called. ## __disconnect__ $rv = $dbh->disconnect; Disconnects from the Oracle database. Any uncommitted changes will be rolled back upon disconnection. It's good policy to always explicitly call commit or rollback at some point before disconnecting, rather than relying on the default rollback behavior. If the script exits before disconnect is called (or, more precisely, if the database handle is no longer referenced by anything), then the database handle's DESTROY method will call the rollback() and disconnect() methods automatically. It is best to explicitly disconnect rather than rely on this behavior. ## __ping__ $rv = $dbh->ping; This `ping` method is used to check the validity of a database handle. The value returned is either 0, indicating that the connection is no longer valid, or 1, indicating the connection is valid. This function does 1 round trip to the Oracle Server. ## __get\_info()__ $value = $dbh->get_info($info_type); DBD::Oracle supports `get_info()`, but (currently) only a few info types. ## __table\_info()__ DBD::Oracle supports attributes for `table_info()`. In Oracle, the concept of _user_ and _schema_ is (currently) the same. Because database objects are owned by an user, the owner names in the data dictionary views correspond to schema names. Oracle does not support catalogues so TABLE\_CAT is ignored as selection criterion. Search patterns are supported for TABLE\_SCHEM and TABLE\_NAME. TABLE\_TYPE may contain a comma-separated list of table types. The following table types are supported: TABLE VIEW SYNONYM SEQUENCE The result set is ordered by TABLE\_TYPE, TABLE\_SCHEM, TABLE\_NAME. The special enumerations of catalogues, schemas and table types are supported. However, TABLE\_CAT is always NULL. An identifier is passed _as is_, i.e. as the user provides or Oracle returns it. `table_info()` performs a case-sensitive search. So, a selection criterion should respect upper and lower case. Normally, an identifier is case-insensitive. Oracle stores and returns it in upper case. Sometimes, database objects are created with quoted identifiers (for reserved words, mixed case, special characters, ...). Such an identifier is case-sensitive (if not all upper case). Oracle stores and returns it as given. `table_info()` has no special quote handling, neither adds nor removes quotes. ## __primary\_key\_info()__ Oracle does not support catalogues so TABLE\_CAT is ignored as selection criterion. The TABLE\_CAT field of a fetched row is always NULL (undef). See ["table\_info()"](#table_info) for more detailed information. If the primary key constraint was created without an identifier, PK\_NAME contains a system generated name with the form SYS\_Cn. The result set is ordered by TABLE\_SCHEM, TABLE\_NAME, KEY\_SEQ. An identifier is passed _as is_, i.e. as the user provides or Oracle returns it. See ["table\_info()"](#table_info) for more detailed information. ## __foreign\_key\_info()__ This method (currently) supports the extended behaviour of SQL/CLI, i.e. the result set contains foreign keys that refer to primary __and__ alternate keys. The field UNIQUE\_OR\_PRIMARY distinguishes these keys. Oracle does not support catalogues, so `$pk_catalog` and `$fk_catalog` are ignored as selection criteria (in the new style interface). The UK\_TABLE\_CAT and FK\_TABLE\_CAT fields of a fetched row are always NULL (undef). See ["table\_info()"](#table_info) for more detailed information. If the primary or foreign key constraints were created without an identifier, UK\_NAME or FK\_NAME contains a system generated name with the form SYS\_Cn. The UPDATE\_RULE field is always 3 ('NO ACTION'), because Oracle (currently) does not support other actions. The DELETE\_RULE field may contain wrong values. This is a known Bug (#1271663) in Oracle's data dictionary views. Currently (as of 8.1.7), 'RESTRICT' and 'SET DEFAULT' are not supported, 'CASCADE' is mapped correctly and all other actions (incl. 'SET NULL') appear as 'NO ACTION'. The DEFERABILITY field is always NULL, because this columns is not present in the ALL\_CONSTRAINTS view of older Oracle releases. The result set is ordered by UK\_TABLE\_SCHEM, UK\_TABLE\_NAME, FK\_TABLE\_SCHEM, FK\_TABLE\_NAME, ORDINAL\_POSITION. An identifier is passed _as is_, i.e. as the user provides or Oracle returns it. See ["table\_info()"](#table_info) for more detailed information. ## __column\_info()__ Oracle does not support catalogues so TABLE\_CAT is ignored as selection criterion. The TABLE\_CAT field of a fetched row is always NULL (undef). See ["table\_info()"](#table_info) for more detailed information. The CHAR\_OCTET\_LENGTH field is (currently) always NULL (undef). Don't rely on the values of the BUFFER\_LENGTH field! Especially the length of FLOATs may be wrong. Datatype codes for non-standard types are subject to change. Attention! The DATA\_DEFAULT (COLUMN\_DEF) column is of type LONG so you may have to set LongReadLen on the connection handle before calling column\_info if you have a large default column. After DBD::Oracle 1.40 LongReadLen is set automatically to 1Mb when calling column\_info and reset aftwerwards. The result set is ordered by TABLE\_SCHEM, TABLE\_NAME, ORDINAL\_POSITION. An identifier is passed _as is_, i.e. as the user provides or Oracle returns it. See ["table\_info()"](#table_info) for more detailed information. It is possible with Oracle to make the names of the various DB objects (table,column,index etc) case sensitive. alter table bloggind add ("Bla_BLA" NUMBER) So in the example the exact case "Bla\_BLA" must be used to get it info on the column. While this alter table bloggind add (Bla_BLA NUMBER) any case can be used to get info on the column. ## __statistics\_info()__ Oracle does not support catalogues so TABLE\_CAT is ignored as selection criterion. The TABLE\_CAT field of a fetched row is always NULL (undef). See ["table\_info()"](#table_info) for more detailed information. The INDEX\_QUALIFIER field of a fetched row is always NULL (undef), for the same reason as for TABLE\_CAT. If an index was created without an identifier (e.g. in the course of a PK creation), INDEX\_NAME contains a system generated name with the form SYS\_. COLUMN\_NAME may contain a system generated name (e.g. for function-based indexes). For the TYPE column, a simple mapping is used: NORMAL btree CLUSTER clustered ... other The `$quick` parameter is currently ignored. The method uses the dictionary with the gathered statistics, thus cannot ensure that the values for CARDINALITY and PAGES are current. The result set is ordered by NON\_UNIQUE, TYPE, INDEX\_QUALIFIER, INDEX\_NAME, ORDINAL\_POSITION. An identifier is passed _as is_, i.e. as the user provides or Oracle returns it. See ["table\_info()"](#table_info) for more detailed information. ## __selectrow\_array__ @row_ary = $dbh->selectrow_array($sql); @row_ary = $dbh->selectrow_array($sql, \%attr); @row_ary = $dbh->selectrow_array($sql, \%attr, @bind_values); Returns an array of row information after preparing and executing the provided SQL string. The rows are returned by calling ["fetchrow\_array"](#fetchrow_array). The string can also be a statement handle generated by a previous prepare. Note that only the first row of data is returned. If called in a scalar context, only the first column of the first row is returned. Because this is not portable, it is not recommended that you use this method in that way. ## __selectrow\_arrayref__ $ary_ref = $dbh->selectrow_arrayref($statement); $ary_ref = $dbh->selectrow_arrayref($statement, \%attr); $ary_ref = $dbh->selectrow_arrayref($statement, \%attr, @bind_values); Exactly the same as ["selectrow\_array"](#selectrow_array), except that it returns a reference to an array, by internal use of the ["fetchrow\_arrayref"](#fetchrow_arrayref) method. ## __selectrow\_hashref__ $hash_ref = $dbh->selectrow_hashref($sql); $hash_ref = $dbh->selectrow_hashref($sql, \%attr); $hash_ref = $dbh->selectrow_hashref($sql, \%attr, @bind_values); Exactly the same as ["selectrow\_array"](#selectrow_array), except that it returns a reference to an hash, by internal use of the ["fetchrow\_hashref"](#fetchrow_hashref) method. ## __clone__ $other_dbh = $dbh->clone(); Creates a copy of the database handle by connecting with the same parameters as the original handle, then trying to merge the attributes. See the DBI documentation for complete usage. # DATABASE HANDLE ATTRIBUTES ## __AutoCommit__ (boolean) Supported by DBD::Oracle as proposed by DBI.The default of AutoCommit is on, but this may change in the future, so it is highly recommended that you explicitly set it when calling ["connect"](#connect). ## __ReadOnly__ (boolean) $dbh->{ReadOnly} = 1; Specifies if the current database connection should be in read-only mode or not. Please not that this method is not foolproof: there are still ways to update the database. Consider this a safety net to catch applications that should not be issuing commands such as INSERT, UPDATE, or DELETE. This method method requires DBI version 1.55 or better. ## __Name__ (string, read-only) Returns the name of the current database. This is the same as the DSN, without the "dbi:Oracle:" part. ## __Username__ (string, read-only) Returns the name of the user connected to the database. ## __Driver__ (handle, read-only) Holds the handle of the parent driver. The only recommended use for this is to find the name of the driver using: $dbh->{Driver}->{Name} ## __RowCacheSize__ DBD::Oracle supports both Server pre-fetch and Client side row caching. By default both are turned on to give optimum performance. Most of the time one can just let DBD::Oracle figure out the best optimization. ### __Row Caching__ Row caching occurs on the client side and the object of it is to cut down the number of round trips made to the server when fetching rows. At each fetch a set number of rows will be retrieved from the server and stored locally. Further calls the server are made only when the end of the local buffer(cache) is reached. Rows up to the specified top level row count `RowCacheSize` are fetched if it occupies no more than the specified memory usage limit. The default value is 0, which means that memory size is not included in computing the number of rows to prefetch. If the `RowCacheSize` value is set to a negative number then the positive value of RowCacheSize is used to compute the number of rows to prefetch. By default `RowCacheSize` is automatically set. If you want to totally turn off prefetching set this to 1. For any SQL statement that contains a LOB, Long or Object Type Row Caching will be turned off. However server side caching still works. If you are only selecting a LOB Locator then Row Caching will still work. ### Row Prefetching Row prefetching occurs on the server side and uses the DBI database handle attribute `RowCacheSize` and or the Prepare Attribute 'ora\_prefetch\_memory'. Tweaking these values may yield improved performance. $dbh->{RowCacheSize} = 100; $sth=$dbh->prepare($SQL,{ora_exe_mode=>OCI_STMT_SCROLLABLE_READONLY,ora_prefetch_memory=>10000}); In the above example 10 rows will be prefetched up to a maximum of 10000 bytes of data. The Oracle Call Interface Programmer's Guide, suggests a good row cache value for a scrollable cursor is about 20% of expected size of the record set. The prefetch settings tell the DBD::Oracle to grab x rows (or x-bytes) when it needs to get new rows. This happens on the first fetch that sets the current\_positon to any value other than 0. In the above example if we do a OCI\_FETCH\_FIRST the first 10 rows are loaded into the buffer and DBD::Oracle will not have to go back to the server for more rows. When record 11 is fetched DBD::Oracle fetches and returns this row and the next 9 rows are loaded into the buffer. In this case if you fetch backwards from 10 to 1 no server round trips are made. With large record sets it is best not to attempt to go to the last record as this may take some time, A large buffer size might even slow down the fetch. If you must get the number of rows in a large record set you might try using an few large OCI\_FETCH\_ABSOLUTEs and then an OCI\_FETCH\_LAST, this might save some time. So if you had a record set of 10000 rows and you set the buffer to 5000 and did a OCI\_FETCH\_LAST one would fetch the first 5000 rows into the buffer then the next 5000 rows. If one requires only the first few rows there is no need to set a large prefetch value. If the ora\_prefetch\_memory less than 1 or not present then memory size is not included in computing the number of rows to prefetch otherwise the number of rows will be limited to memory size. Likewise if the RowCacheSize is less than 1 it is not included in the computing of the prefetch rows. # ORACLE-SPECIFIC STATEMENT HANDLE METHODS ## __ora\_stmt\_type__ Returns the OCI Statement Type number for the SQL of a statement handle. ## __ora\_stmt\_type\_name__ Returns the OCI Statement Type name for the SQL of a statement handle. # DBI STATEMENT HANDLE OBJECT METHODS ## __bind\_param__ $rv = $sth->bind_param($param_num, $bind_value); $rv = $sth->bind_param($param_num, $bind_value, $bind_type); $rv = $sth->bind_param($param_num, $bind_value, \%attr); Allows the user to bind a value and/or a data type to a placeholder. The value of `$param_num` is a number if using the '?' or if using ":foo" style placeholders, the complete name (e.g. ":foo") must be given. The `$bind_value` argument is fairly self-explanatory. A value of `undef` will bind a `NULL` to the placeholder. Using `undef` is useful when you want to change just the type and will be overwriting the value later. (Any value is actually usable, but `undef` is easy and efficient). The `\%attr` hash is used to indicate the data type of the placeholder. The default value is "varchar". If you need something else, you must use one of the values provided by DBI or by DBD::Pg. To use a SQL value, modify your "use DBI" statement at the top of your script as follows: use DBI qw(:sql_types); This will import some constants into your script. You can plug those directly into the ["bind\_param"](#bind_param) call. Some common ones that you will encounter are: SQL_INTEGER To use Oracle SQL data types, import the list of values like this: use DBD::Pg qw(:ora_types); You can then set the data types by setting the value of the `ora_type` key in the hash passed to ["bind\_param"](#bind_param). The current list of Oracle data types exported is: ORA_VARCHAR2 ORA_STRING ORA_NUMBER ORA_LONG ORA_ROWID ORA_DATE ORA_RAW ORA_LONGRAW ORA_CHAR ORA_CHARZ ORA_MLSLABEL ORA_XMLTYPE ORA_CLOB ORA_BLOB ORA_RSET ORA_VARCHAR2_TABLE ORA_NUMBER_TABLE SQLT_INT SQLT_FLT ORA_OCI SQLT_CHR SQLT_BIN Data types are "sticky," in that once a data type is set to a certain placeholder, it will remain for that placeholder, unless it is explicitly set to something else afterwards. If the statement has already been prepared, and you switch the data type to something else, DBD::Oracle will re-prepare the statement for you before doing the next execute. Examples: use DBI qw(:sql_types); use DBD::Pg qw(:ora_types); $SQL = "SELECT id FROM ptable WHERE size > ? AND title = ?"; $sth = $dbh->prepare($SQL); ## Both arguments below are bound to placeholders as "varchar" $sth->execute(123, "Merk"); ## Reset the datatype for the first placeholder to an integer $sth->bind_param(1, undef, SQL_INTEGER); ## The "undef" bound above is not used, since we supply params to execute $sth->execute(123, "Merk"); ## Set the first placeholder's value and data type $sth->bind_param(1, 234, { pg_type => ORA_NUMBER }); ## Set the second placeholder's value and data type. ## We don't send a third argument, so the default "varchar" is used $sth->bind_param('$2', "Zool"); ## We realize that the wrong data type was set above, so we change it: $sth->bind_param('$1', 234, { pg_type => SQL_INTEGER }); ## We also got the wrong value, so we change that as well. ## Because the data type is sticky, we don't need to change it $sth->bind_param(1, 567); ## This executes the statement with 567 (integer) and "Zool" (varchar) $sth->execute(); These attributes may be used in the `\%attr` parameter of the ["bind\_param" in DBI](https://metacpan.org/pod/DBI#bind_param) or ["bind\_param\_inout" in DBI](https://metacpan.org/pod/DBI#bind_param_inout) statement handle methods. - ora\_type Specify the placeholder's datatype using an Oracle datatype. A fatal error is raised if `ora_type` and the DBI `TYPE` attribute are used for the same placeholder. Some of these types are not supported by the current version of DBD::Oracle and will cause a fatal error if used. Constants for the Oracle datatypes may be imported using use DBD::Oracle qw(:ora_types); Potentially useful values when DBD::Oracle was built using OCI 7 and later: ORA_VARCHAR2, ORA_STRING, ORA_LONG, ORA_RAW, ORA_LONGRAW, ORA_CHAR, ORA_MLSLABEL, ORA_RSET Additional values when DBD::Oracle was built using OCI 8 and later: ORA_CLOB, ORA_BLOB, ORA_XMLTYPE, ORA_VARCHAR2_TABLE, ORA_NUMBER_TABLE Additional values when DBD::Oracle was built using OCI 9.2 and later: SQLT_CHR, SQLT_BIN See ["Binding Cursors"](#binding-cursors) for the correct way to use ORA\_RSET. See ["LOBS AND LONGS"](#lobs-and-longs) for how to use ORA\_CLOB and ORA\_BLOB. See ["SYS.DBMS\_SQL datatypes"](#sys-dbms_sql-datatypes) for ORA\_VARCHAR2\_TABLE, ORA\_NUMBER\_TABLE. See ["Data Interface for Persistent LOBs"](#data-interface-for-persistent-lobs) for the correct way to use SQLT\_CHR and SQLT\_BIN. See ["OTHER DATA TYPES"](#other-data-types) for more information. See also ["Placeholders and Bind Values" in DBI](https://metacpan.org/pod/DBI#Placeholders-and-Bind-Values). - ora\_csform Specify the OCI\_ATTR\_CHARSET\_FORM for the bind value. Valid values are SQLCS\_IMPLICIT (1) and SQLCS\_NCHAR (2). Both those constants can be imported from the DBD::Oracle module. Rarely needed. - ora\_csid Specify the _integer_ OCI\_ATTR\_CHARSET\_ID for the bind value. Character set names can't be used currently. - ora\_maxdata\_size Specify the integer OCI\_ATTR\_MAXDATA\_SIZE for the bind value. May be needed if a character set conversion from client to server causes the data to use more space and so fail with a truncation error. - ora\_maxarray\_numentries Specify the maximum number of array entries to allocate. Used with ORA\_VARCHAR2\_TABLE, ORA\_NUMBER\_TABLE. Define the maximum number of array entries Oracle can pass back to you in OUT variable of type TABLE OF ... . - ora\_internal\_type Specify internal data representation. Currently is supported only for ORA\_NUMBER\_TABLE. ### Optimizing Results #### Prepare Postponed Till Execute The DBD::Oracle module can avoid an explicit 'describe' operation prior to the execution of the statement unless the application requests information about the results (such as $sth->{NAME}). This reduces communication with the server and increases performance (reducing the number of PARSE\_CALLS inside the server). However, it also means that SQL errors are not detected until `execute()` (or $sth->{NAME} etc) is called instead of when `prepare()` is called. Note that if the describe is triggered by the use of $sth->{NAME} or a similar attribute and the describe fails then _an exception is thrown_ even if `RaiseError` is false! Set ["ora\_check\_sql"](#ora_check_sql) to 0 in prepare() to enable this behaviour. ## __bind\_param\_inout__ $rv = $sth->bind_param_inout($param_num, \$scalar, 0); DBD::Oracle fully supports bind\_param\_inout below are some uses for this method. ### __Returning A Value from an INSERT__ Oracle supports an extended SQL insert syntax which will return one or more of the values inserted. This can be particularly useful for single-pass insertion of values with re-used sequence values (avoiding a separate "select seq.nextval from dual" step). $sth = $dbh->prepare(qq{ INSERT INTO foo (id, bar) VALUES (foo_id_seq.nextval, :bar) RETURNING id INTO :id }); $sth->bind_param(":bar", 42); $sth->bind_param_inout(":id", \my $new_id, 99); $sth->execute; print "The id of the new record is $new_id\n"; If you have many columns to bind you can use code like this: @params = (... column values for record to be inserted ...); $sth->bind_param($_, $params[$_-1]) for (1..@params); $sth->bind_param_inout(@params+1, \my $new_id, 99); $sth->execute; If you have many rows to insert you can take advantage of Oracle's built in execute array feature with code like this: my @in_values=('1',2,'3','4',5,'6',7,'8',9,'10'); my @out_values; my @status; my $sth = $dbh->prepare(qq{ INSERT INTO foo (id, bar) VALUES (foo_id_seq.nextval, ?) RETURNING id INTO ? }); $sth->bind_param_array(1,\@in_values); $sth->bind_param_inout_array(2,\@out_values,0,{ora_type => ORA_VARCHAR2}); $sth->execute_array({ArrayTupleStatus=>\@status}) or die "error inserting"; foreach my $id (@out_values){ print 'returned id='.$id.'\n'; } Which will return all the ids into @out\_values. - __Note:__ - This will only work for numbered (?) placeholders, - The third parameter of bind\_param\_inout\_array, (0 in the example), "maxlen" is required by DBI but not used by DBD::Oracle - The "ora\_type" attribute is not needed but only ORA\_VARCHAR2 will work. ### Returning A Recordset DBD::Oracle does not currently support binding a PL/SQL table (aka array) as an IN OUT parameter to any Perl data structure. You cannot therefore call a PL/SQL function or procedure from DBI that uses a non-atomic datatype as either a parameter, or a return value. However, if you are using Oracle 9.0.1 or later, you can make use of table (or pipelined) functions. For example, assume you have the existing PL/SQL Package : CREATE OR REPLACE PACKAGE Array_Example AS -- TYPE tRec IS RECORD ( Col1 NUMBER, Col2 VARCHAR2 (10), Col3 DATE) ; -- TYPE taRec IS TABLE OF tRec INDEX BY BINARY_INTEGER ; -- FUNCTION Array_Func RETURN taRec ; -- END Array_Example ; CREATE OR REPLACE PACKAGE BODY Array_Example AS -- FUNCTION Array_Func RETURN taRec AS -- l_Ret taRec ; -- BEGIN FOR i IN 1 .. 5 LOOP l_Ret (i).Col1 := i ; l_Ret (i).Col2 := 'Row : ' || i ; l_Ret (i).Col3 := TRUNC (SYSDATE) + i ; END LOOP ; RETURN l_Ret ; END ; -- END Array_Example ; / Currently, there is no way to directly call the function Array\_Example.Array\_Func from DBI. However, by making the following relatively painless additions, its not only possible, but extremely efficient. First, you need to create database object types that correspond to the record and table types in the package. From the above example, these would be : CREATE OR REPLACE TYPE tArray_Example__taRec AS OBJECT ( Col1 NUMBER, Col2 VARCHAR2 (10), Col3 DATE ) ; CREATE OR REPLACE TYPE taArray_Example__taRec AS TABLE OF tArray_Example__taRec ; Now, assuming the existing function needs to remain unchanged (it is probably being called from other PL/SQL code), we need to add a new function to the package. Here's the new package specification and body : CREATE OR REPLACE PACKAGE Array_Example AS -- TYPE tRec IS RECORD ( Col1 NUMBER, Col2 VARCHAR2 (10), Col3 DATE) ; -- TYPE taRec IS TABLE OF tRec INDEX BY BINARY_INTEGER ; -- FUNCTION Array_Func RETURN taRec ; FUNCTION Array_Func_DBI RETURN taArray_Example__taRec PIPELINED ; -- END Array_Example ; CREATE OR REPLACE PACKAGE BODY Array_Example AS -- FUNCTION Array_Func RETURN taRec AS l_Ret taRec ; BEGIN FOR i IN 1 .. 5 LOOP l_Ret (i).Col1 := i ; l_Ret (i).Col2 := 'Row : ' || i ; l_Ret (i).Col3 := TRUNC (SYSDATE) + i ; END LOOP ; RETURN l_Ret ; END ; FUNCTION Array_Func_DBI RETURN taArray_Example__taRec PIPELINED AS l_Set taRec ; BEGIN l_Set := Array_Func ; FOR i IN l_Set.FIRST .. l_Set.LAST LOOP PIPE ROW ( tArray_Example__taRec ( l_Set (i).Col1, l_Set (i).Col2, l_Set (i).Col3 ) ) ; END LOOP ; RETURN ; END ; -- END Array_Example ; As you can see, the new function is very simple. Now, it is a simple matter of calling the function as a straight-forward SELECT from your DBI code. From the above example, the code would look something like this : my $sth = $dbh->prepare('SELECT * FROM TABLE(Array_Example.Array_Func_DBI)'); $sth->execute; while ( my ($col1, $col2, $col3) = $sth->fetchrow_array { ... } ### __SYS.DBMS\_SQL datatypes__ DBD::Oracle has built-in support for __SYS.DBMS\_SQL.VARCHAR2\_TABLE__ and __SYS.DBMS\_SQL.NUMBER\_TABLE__ datatypes. The simple example is here: my $statement=' DECLARE tbl SYS.DBMS_SQL.VARCHAR2_TABLE; BEGIN tbl := :mytable; :cc := tbl.count(); tbl(1) := \'def\'; tbl(2) := \'ijk\'; :mytable := tbl; END; '; my $sth=$dbh->prepare( $statement ); my @arr=( "abc","efg","hij" ); $sth->bind_param_inout(":mytable", \\@arr, 10, { ora_type => ORA_VARCHAR2_TABLE, ora_maxarray_numentries => 100 } ) ; $sth->bind_param_inout(":cc", \$cc, 100 ); $sth->execute(); print "Result: cc=",$cc,"\n", "\tarr=",Data::Dumper::Dumper(\@arr),"\n"; - __Note:__ - Take careful note that we use '\\\\@arr' here because the 'bind\_param\_inout' will only take a reference to a scalar. ### __ORA\_VARCHAR2\_TABLE__ SYS.DBMS\_SQL.VARCHAR2\_TABLE object is always bound to array reference. ( in bind\_param() and bind\_param\_inout() ). When you bind array, you need to specify full buffer size for OUT data. So, there are two parameters: _max\_len_ (specified as 3rd argument of bind\_param\_inout() ), and _ora\_maxarray\_numentries_. They define maximum array entry length and maximum rows, that can be passed to Oracle and back to you. In this example we send array with 1 element with length=3, but allocate space for 100 Oracle array entries with maximum length 10 of each. So, you can get no more than 100 array entries with length <= 10. If you set _max\_len_ to zero, maximum array entry length is calculated as maximum length of entry of array bound. If 0 < _max\_len_ < length( $some\_element ), truncation occur. If you set _ora\_maxarray\_numentries_ to zero, current (at bind time) bound array length is used as maximum. If 0 < _ora\_maxarray\_numentries_ < scalar(@array), not all array entries are bound. ### __ORA\_NUMBER\_TABLE__ SYS.DBMS\_SQL.NUMBER\_TABLE object handling is much alike ORA\_VARCHAR2\_TABLE. The main difference is internal data representation. Currently 2 types of bind is allowed : as C-integer, or as C-double type. To select one of them, you may specify additional bind parameter _ora\_internal\_type_ as either __SQLT\_INT__ or __SQLT\_FLT__ for C-integer and C-double types. Integer size is architecture-specific and is usually 32 or 64 bit. Double is standard IEEE 754 type. _ora\_internal\_type_ defaults to double (SQLT\_FLT). _max\_len_ is ignored for OCI\_NUMBER\_TABLE. Currently, you cannot bind full native Oracle NUMBER(38). If you really need, send request to dbi-dev list. The usage example is here: $statement=' DECLARE tbl SYS.DBMS_SQL.NUMBER_TABLE; BEGIN tbl := :mytable; :cc := tbl(2); tbl(4) := -1; tbl(5) := -2; :mytable := tbl; END; '; $sth=$dbh->prepare( $statement ); if( ! defined($sth) ){ die "Prepare error: ",$dbh->errstr,"\n"; } @arr=( 1,"2E0","3.5" ); # note, that ora_internal_type defaults to SQLT_FLT for ORA_NUMBER_TABLE . if( not $sth->bind_param_inout(":mytable", \\@arr, 10, { ora_type => ORA_NUMBER_TABLE, ora_maxarray_numentries => (scalar(@arr)+2), ora_internal_type => SQLT_FLT } ) ){ die "bind :mytable error: ",$dbh->errstr,"\n"; } $cc=undef; if( not $sth->bind_param_inout(":cc", \$cc, 100 ) ){ die "bind :cc error: ",$dbh->errstr,"\n"; } if( not $sth->execute() ){ die "Execute failed: ",$dbh->errstr,"\n"; } print "Result: cc=",$cc,"\n", "\tarr=",Data::Dumper::Dumper(\@arr),"\n"; The result is like: Result: cc=2 arr=$VAR1 = [ '1', '2', '3.5', '-1', '-2' ]; If you change bind type to __SQLT\_INT__, like: ora_internal_type => SQLT_INT you get: Result: cc=2 arr=$VAR1 = [ 1, 2, 3, -1, -2 ]; ## __bind\_param\_inout\_array__ DBD::Oracle supports this undocumented feature of DBI. See ["Returning A Value from an INSERT"](#returning-a-value-from-an-insert) for an example. ## __bind\_param\_array__ $rv = $sth->bind_param_array($param_num, $array_ref_or_value) $rv = $sth->bind_param_array($param_num, $array_ref_or_value, $bind_type) $rv = $sth->bind_param_array($param_num, $array_ref_or_value, \%attr) Binds an array of values to a placeholder, so that each is used in turn by a call to the ["execute\_array"](#execute_array) method. ## __execute__ $rv = $sth->execute(@bind_values); Perform whatever processing is necessary to execute the prepared statement. ## __execute\_array__ $tuples = $sth->execute_array() or die $sth->errstr; $tuples = $sth->execute_array(\%attr) or die $sth->errstr; $tuples = $sth->execute_array(\%attr, @bind_values) or die $sth->errstr; ($tuples, $rows) = $sth->execute_array(\%attr) or die $sth->errstr; ($tuples, $rows) = $sth->execute_array(\%attr, @bind_values) or die $sth->errstr; Execute a prepared statement once for each item in a passed-in hashref, or items that were previously bound via the ["bind\_param\_array"](#bind_param_array) method. See the DBI documentation for more details. DBD::Oracle takes full advantage of OCI's array interface so inserts and updates using this interface will run very quickly. ## __execute\_for\_fetch__ $tuples = $sth->execute_for_fetch($fetch_tuple_sub); $tuples = $sth->execute_for_fetch($fetch_tuple_sub, \@tuple_status); ($tuples, $rows) = $sth->execute_for_fetch($fetch_tuple_sub); ($tuples, $rows) = $sth->execute_for_fetch($fetch_tuple_sub, \@tuple_status); Used internally by the ["execute\_array"](#execute_array) method, and rarely used directly. See the DBI documentation for more details. ## __fetchrow\_arrayref__ $ary_ref = $sth->fetchrow_arrayref; Fetches the next row of data from the statement handle, and returns a reference to an array holding the column values. Any columns that are NULL are returned as undef within the array. If there are no more rows or if an error occurs, the this method return undef. You should check `$sth->err` afterwards (or use the ["RaiseError"](#raiseerror) attribute) to discover if the undef returned was due to an error. Note that the same array reference is returned for each fetch, so don't store the reference and then use it after a later fetch. Also, the elements of the array are also reused for each row, so take care if you want to take a reference to an element. See also ["bind\_columns"](#bind_columns). ## __fetchrow\_array__ @ary = $sth->fetchrow_array; Similar to the ["fetchrow\_arrayref"](#fetchrow_arrayref) method, but returns a list of column information rather than a reference to a list. Do not use this in a scalar context. ## __fetchrow\_hashref__ $hash_ref = $sth->fetchrow_hashref; $hash_ref = $sth->fetchrow_hashref($name); Fetches the next row of data and returns a hashref containing the name of the columns as the keys and the data itself as the values. Any NULL value is returned as undef value. If there are no more rows or if an error occurs, the this method return undef. You should check `$sth->err` afterwards (or use the ["RaiseError"](#raiseerror) attribute) to discover if the undef returned was due to an error. The optional `$name` argument should be either `NAME`, `NAME_lc` or `NAME_uc`, and indicates what sort of transformation to make to the keys in the hash. By default Oracle uses upper case. ## __fetchall\_arrayref__ $tbl_ary_ref = $sth->fetchall_arrayref(); $tbl_ary_ref = $sth->fetchall_arrayref( $slice ); $tbl_ary_ref = $sth->fetchall_arrayref( $slice, $max_rows ); Returns a reference to an array of arrays that contains all the remaining rows to be fetched from the statement handle. If there are no more rows, an empty arrayref will be returned. If an error occurs, the data read in so far will be returned. Because of this, you should always check `$sth->err` after calling this method, unless ["RaiseError"](#raiseerror) has been enabled. If `$slice` is an array reference, fetchall\_arrayref uses the ["fetchrow\_arrayref"](#fetchrow_arrayref) method to fetch each row as an array ref. If the `$slice` array is not empty then it is used as a slice to select individual columns by perl array index number (starting at 0, unlike column and parameter numbers which start at 1). With no parameters, or if $slice is undefined, fetchall\_arrayref acts as if passed an empty array ref. If `$slice` is a hash reference, fetchall\_arrayref uses ["fetchrow\_hashref"](#fetchrow_hashref) to fetch each row as a hash reference. See the DBI documentation for a complete discussion. ## __fetchall\_hashref__ $hash_ref = $sth->fetchall_hashref( $key_field ); Returns a hashref containing all rows to be fetched from the statement handle. See the DBI documentation for a full discussion. ## __finish__ $rv = $sth->finish; Indicates to DBI that you are finished with the statement handle and are not going to use it again. Only needed when you have not fetched all the possible rows. ## __rows__ $rv = $sth->rows; Returns the number of rows affected for updates, deletes and inserts and -1 for selects. ## __bind\_col__ $rv = $sth->bind_col($column_number, \$var_to_bind); $rv = $sth->bind_col($column_number, \$var_to_bind, \%attr ); $rv = $sth->bind_col($column_number, \$var_to_bind, $bind_type ); Binds a Perl variable and/or some attributes to an output column of a SELECT statement. Column numbers count up from 1. You do not need to bind output columns in order to fetch data. NOTE: DBD::Oracle does not use the `$bind_type` to determine how to bind the column; it uses what Oracle says the data type is. You can however set the StrictlyTyped/DiscardString attributes and these will take effect as these attributes are applied after the column is retrieved. See the DBI documentation for a discussion of the optional parameters `\%attr` and `$bind_type` ## __bind\_columns__ $rv = $sth->bind_columns(@list_of_refs_to_vars_to_bind); Calls the ["bind\_col"](#bind_col) method for each column in the SELECT statement, using the supplied list. ## __dump\_results__ $rows = $sth->dump_results($maxlen, $lsep, $fsep, $fh); Fetches all the rows from the statement handle, calls `DBI::neat_list` for each row, and prints the results to `$fh` (which defaults to `STDOUT`). Rows are separated by `$lsep` (which defaults to a newline). Columns are separated by `$fsep` (which defaults to a comma). The `$maxlen` controls how wide the output can be, and defaults to 35. This method is designed as a handy utility for prototyping and testing queries. Since it uses "neat\_list" to format and edit the string for reading by humans, it is not recommended for data transfer applications. # STATEMENT HANDLE ATTRIBUTES ## __NUM\_OF\_FIELDS__ (integer, read-only) Returns the number of columns returned by the current statement. A number will only be returned for SELECT statements for INSERT, UPDATE, and DELETE statements which contain a RETURNING clause. This method returns undef if called before `execute()`. ## __NUM\_OF\_PARAMS__ (integer, read-only) Returns the number of placeholders in the current statement. ## __NAME__ (arrayref, read-only) Returns an arrayref of column names for the current statement. This method will only work for SELECT statements, for SHOW statements, and for INSERT, UPDATE, and DELETE statements which contain a RETURNING clause. This method returns undef if called before `execute()`. ## __NAME\_lc__ (arrayref, read-only) The same as the `NAME` attribute, except that all column names are forced to lower case. ## __NAME\_uc__ (arrayref, read-only) The same as the `NAME` attribute, except that all column names are forced to upper case. ## __NAME\_hash__ (hashref, read-only) Similar to the `NAME` attribute, but returns a hashref of column names instead of an arrayref. The names of the columns are the keys of the hash, and the values represent the order in which the columns are returned, starting at 0. This method returns undef if called before `execute()`. ## __NAME\_lc\_hash__ (hashref, read-only) The same as the `NAME_hash` attribute, except that all column names are forced to lower case. ## __NAME\_uc\_hash__ (hashref, read-only) The same as the `NAME_hash` attribute, except that all column names are forced to lower case. ## __TYPE__ (arrayref, read-only) Returns an arrayref indicating the data type for each column in the statement. This method returns undef if called before `execute()`. ## __PRECISION__ (arrayref, read-only) Returns an arrayref of integer values for each column returned by the statement. The number indicates the precision for `NUMERIC` columns, the size in number of characters for `CHAR` and `VARCHAR` columns, and for all other types of columns it returns the number of _bytes_. This method returns undef if called before `execute()`. ## __SCALE__ (arrayref, read-only) Returns an arrayref of integer values for each column returned by the statement. The number indicates the scale of the that column. The only type that will return a value is `NUMERIC`. This method returns undef if called before `execute()`. ## __NULLABLE__ (arrayref, read-only) Returns an arrayref of integer values for each column returned by the statement. The number indicates if the column is nullable or not. 0 = not nullable, 1 = nullable, 2 = unknown. This method returns undef if called before `execute()`. ## __Database__ (dbh, read-only) Returns the database handle this statement handle was created from. ## __ParamValues__ (hash ref, read-only) Returns a reference to a hash containing the values currently bound to placeholders. If the "named parameters" type of placeholders are being used (such as ":foo"), then the keys of the hash will be the names of the placeholders (without the colon). If the "dollar sign numbers" type of placeholders are being used, the keys of the hash will be the numbers, without the dollar signs. If the "question mark" type is used, integer numbers will be returned, starting at one and increasing for every placeholder. If this method is called before ["execute"](#execute), the literal values passed in are returned. If called after ["execute"](#execute), then the quoted versions of the values are returned. ## __ParamTypes__ (hash ref, read-only) Returns a reference to a hash containing the type names currently bound to placeholders. The keys are the same as returned by the ParamValues method. The values are hashrefs containing a single key value pair, in which the key is either 'TYPE' if the type has a generic SQL equivalent, and 'pg\_type' if the type can only be expressed by a Postgres type. The value is the internal number corresponding to the type originally passed in. (Placeholders that have not yet been bound will return undef as the value). This allows the output of ParamTypes to be passed back to the ["bind\_param"](#bind_param) method. ## __Statement__ (string, read-only) Returns the statement string passed to the most recent "prepare" method called in this database handle, even if that method failed. This is especially useful where "RaiseError" is enabled and the exception handler checks $@ and sees that a `prepare` method call failed. ## __RowsInCache__ Returns the number of un-fetched rows in the cache for selects. # SCROLLABLE CURSORS Oracle supports the concept of a 'Scrollable Cursor' which is defined as a 'Result Set' where the rows can be fetched either sequentially or non-sequentially. One can fetch rows forward, backwards, from any given position or the n-th row from the current position in the result set. Rows are numbered sequentially starting at one and client-side caching of the partial or entire result set can improve performance by limiting round trips to the server. Oracle does not support DML type operations with scrollable cursors so you are limited to simple 'Select' operations only. As well you can not use this functionality with remote mapped queries or if the LONG datatype is part of the select list. However, LOBSs, CLOBSs, and BLOBs do work as do all the regular bind, and fetch methods. Only use scrollable cursors if you really have a good reason to. They do use up considerable more server and client resources and have poorer response times than non-scrolling cursors. ## Enabling Scrollable Cursors To enable this functionality you must first import the 'Fetch Orientation' and the 'Execution Mode' constants by using; use DBD::Oracle qw(:ora_fetch_orient :ora_exe_modes); Next you will have to tell DBD::Oracle that you will be using scrolling by setting the ora\_exe\_mode attribute on the statement handle to 'OCI\_STMT\_SCROLLABLE\_READONLY' with the prepare method; $sth=$dbh->prepare($SQL,{ora_exe_mode=>OCI_STMT_SCROLLABLE_READONLY}); When the statement is executed you will then be able to use 'ora\_fetch\_scroll' method to get a row or you can still use any of the other fetch methods but with a poorer response time than if you used a non-scrolling cursor. As well scrollable cursors are compatible with any applicable bind methods. ## Scrollable Cursor Methods The following driver-specific methods are used with scrollable cursors. - ora\_scroll\_position $position = $sth->ora_scroll_position(); This method returns the current position (row number) attribute of the result set. Prior to the first fetch this value is 0. This is the only time this value will be 0 after the first fetch the value will be set, so you can use this value to test if any rows have been fetched. The minimum value will always be 1 after the first fetch. The maximum value will always be the total number of rows in the record set. - ora\_fetch\_scroll $ary_ref = $sth->ora_fetch_scroll($fetch_orient,$fetch_offset); Works the same as `fetchrow_arrayref`, excepts one passes in a 'Fetch Orientation' constant and a fetch\_offset value which will then determine the row that will be fetched. It returns the row as a list containing the field values. Null fields are returned as _undef_ values in the list. The valid orientation constant and fetch offset values combination are detailed below OCI_FETCH_CURRENT, fetches the current row, the fetch offset value is ignored. OCI_FETCH_NEXT, fetches the next row from the current position, the fetch offset value is ignored. OCI_FETCH_FIRST, fetches the first row, the fetch offset value is ignored. OCI_FETCH_LAST, fetches the last row, the fetch offset value is ignored. OCI_FETCH_PRIOR, fetches the previous row from the current position, the fetch offset value is ignored. OCI_FETCH_ABSOLUTE, fetches the row that is specified by the fetch offset value. OCI_FETCH_ABSOLUTE, and a fetch offset value of 1 is equivalent to a OCI_FETCH_FIRST. OCI_FETCH_ABSOLUTE, and a fetch offset value of 0 is equivalent to a OCI_FETCH_CURRENT. OCI_FETCH_RELATIVE, fetches the row relative from the current position as specified by the fetch offset value. OCI_FETCH_RELATIVE, and a fetch offset value of 0 is equivalent to a OCI_FETCH_CURRENT. OCI_FETCH_RELATIVE, and a fetch offset value of 1 is equivalent to a OCI_FETCH_NEXT. OCI_FETCH_RELATIVE, and a fetch offset value of -1 is equivalent to a OCI_FETCH_PRIOR. The effect that a ora\_fetch\_scroll method call has on the current\_positon attribute is detailed below. OCI_FETCH_CURRENT, has no effect on the current_positon attribute. OCI_FETCH_NEXT, increments current_positon attribute by 1 OCI_FETCH_NEXT, when at the last row in the record set does not change current_positon attribute, it is equivalent to a OCI_FETCH_CURRENT OCI_FETCH_FIRST, sets the current_positon attribute to 1. OCI_FETCH_LAST, sets the current_positon attribute to the total number of rows in the record set. OCI_FETCH_PRIOR, decrements current_positon attribute by 1. OCI_FETCH_PRIOR, when at the first row in the record set does not change current_positon attribute, it is equivalent to a OCI_FETCH_CURRENT. OCI_FETCH_ABSOLUTE, sets the current_positon attribute to the fetch offset value. OCI_FETCH_ABSOLUTE, and a fetch offset value that is less than 1 does not change current_positon attribute, it is equivalent to a OCI_FETCH_CURRENT. OCI_FETCH_ABSOLUTE, and a fetch offset value that is greater than the number of records in the record set, does not change current_positon attribute, it is equivalent to a OCI_FETCH_CURRENT. OCI_FETCH_RELATIVE, sets the current_positon attribute to (current_positon attribute + fetch offset value). OCI_FETCH_RELATIVE, and a fetch offset value that makes the current position less than 1, does not change fetch offset value so it is equivalent to a OCI_FETCH_CURRENT. OCI_FETCH_RELATIVE, and a fetch offset value that makes it greater than the number of records in the record set, does not change fetch offset value so it is equivalent to a OCI_FETCH_CURRENT. The effects of the differing orientation constants on the first fetch (current\_postion attribute at 0) are as follows. OCI_FETCH_CURRENT, dose not fetch a row or change the current_positon attribute. OCI_FETCH_FIRST, fetches row 1 and sets the current_positon attribute to 1. OCI_FETCH_LAST, fetches the last row in the record set and sets the current_positon attribute to the total number of rows in the record set. OCI_FETCH_NEXT, equivalent to a OCI_FETCH_FIRST. OCI_FETCH_PRIOR, equivalent to a OCI_FETCH_CURRENT. OCI_FETCH_ABSOLUTE, and a fetch offset value that is less than 1 is equivalent to a OCI_FETCH_CURRENT. OCI_FETCH_ABSOLUTE, and a fetch offset value that is greater than the number of records in the record set is equivalent to a OCI_FETCH_CURRENT. OCI_FETCH_RELATIVE, and a fetch offset value that is less than 1 is equivalent to a OCI_FETCH_CURRENT. OCI_FETCH_RELATIVE, and a fetch offset value that makes it greater than the number of records in the record set, is equivalent to a OCI_FETCH_CURRENT. ## Scrollable Cursor Usage Given a simple code like this: use DBI; use DBD::Oracle qw(:ora_types :ora_fetch_orient :ora_exe_modes); my $dbh = DBI->connect($dsn, $dbuser, ''); my $SQL = "select id, first_name, last_name from employee"; my $sth=$dbh->prepare($SQL,{ora_exe_mode=>OCI_STMT_SCROLLABLE_READONLY}); $sth->execute(); my $value; and one assumes that the number of rows returned from the query is 20, the code snippets below will illustrate the use of ora\_fetch\_scroll method; - Fetching the Last Row $value = $sth->ora_fetch_scroll(OCI_FETCH_LAST,0); print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n"; print "current scroll position=".$sth->ora_scroll_position()."\n"; The current\_positon attribute to will be 20 after this snippet. This is also a way to get the number of rows in the record set, however, if the record set is large this could take some time. - Fetching the Current Row $value = $sth->ora_fetch_scroll(OCI_FETCH_CURRENT,0); print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n"; print "current scroll position=".$sth->ora_scroll_position()."\n"; The current\_positon attribute will still be 20 after this snippet. - Fetching the First Row $value = $sth->ora_fetch_scroll(OCI_FETCH_FIRST,0); print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n"; print "current scroll position=".$sth->ora_scroll_position()."\n"; The current\_positon attribute will be 1 after this snippet. - Fetching the Next Row for(my $i=0;$i<=3;$i++){ $value = $sth->ora_fetch_scroll(OCI_FETCH_NEXT,0); print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n"; } print "current scroll position=".$sth->ora_scroll_position()."\n"; The current\_positon attribute will be 5 after this snippet. - Fetching the Prior Row for(my $i=0;$i<=3;$i++){ $value = $sth->ora_fetch_scroll(OCI_FETCH_PRIOR,0); print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n"; } print "current scroll position=".$sth->ora_scroll_position()."\n"; The current\_positon attribute will be 1 after this snippet. - Fetching the 10th Row $value = $sth->ora_fetch_scroll(OCI_FETCH_ABSOLUTE,10); print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n"; print "current scroll position=".$sth->ora_scroll_position()."\n"; The current\_positon attribute will be 10 after this snippet. - Fetching the 10th to 14th Row for(my $i=10;$i<15;$i++){ $value = $sth->ora_fetch_scroll(OCI_FETCH_ABSOLUTE,$i); print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n"; } print "current scroll position=".$sth->ora_scroll_position()."\n"; The current\_positon attribute will be 14 after this snippet. - Fetching the 14th to 10th Row for(my $i=14;$i>9;$i--){ $value = $sth->ora_fetch_scroll(OCI_FETCH_ABSOLUTE,$i); print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n"; } print "current scroll position=".$sth->ora_scroll_position()."\n"; The current\_positon attribute will be 10 after this snippet. - Fetching the 5th Row From the Present Position. $value = $sth->ora_fetch_scroll(OCI_FETCH_RELATIVE,5); print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n"; print "current scroll position=".$sth->ora_scroll_position()."\n"; The current\_positon attribute will be 15 after this snippet. - Fetching the 9th Row Prior From the Present Position $value = $sth->ora_fetch_scroll(OCI_FETCH_RELATIVE,-9); print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n"; print "current scroll position=".$sth->ora_scroll_position()."\n"; The current\_positon attribute will be 6 after this snippet. - Use Finish $sth->finish(); When using scrollable cursors it is required that you use the $sth->finish() method when you are done with the cursor as this type of cursor has to be explicitly cancelled on the server. If you do not do this you may cause resource problems on your database. # LOBS AND LONGS The key to working with LOBs (CLOB, BLOBs) is to remember the value of an Oracle LOB column is not the content of the LOB. It's a 'LOB Locator' which, after being selected or inserted needs extra processing to read or write the content of the LOB. There are also legacy LONG types (LONG, LONG RAW, VARCHAR2) which are presently deprecated by Oracle but are still in use. These LONG types do not utilize a 'LOB Locator' and also are more limited in functionality than CLOB or BLOB fields. DBD::Oracle now offers three interfaces to LOB and LONG data, - ["Data Interface for Persistent LOBs"](#data-interface-for-persistent-lobs) With this interface DBD::Oracle handles your data directly utilizing regular OCI calls, Oracle itself takes care of the LOB Locator operations in the case of BLOBs and CLOBs treating them exactly as if they were the same as the legacy LONG or LONG RAW types. - ["Data Interface for LOB Locators"](#data-interface-for-lob-locators) With this interface DBD::Oracle handles your data utilizing LOB Locator OCI calls so it only works with CLOB and BLOB datatypes. With this interface DBD::Oracle takes care of the LOB Locator operations for you. - ["LOB Locator Method Interface"](#lob-locator-method-interface) This allows the user direct access to the LOB Locator methods, so you have to take case of the LOB Locator operations yourself. Generally speaking the interface that you will chose will be dependent on what end you are trying to achieve. All have their benefits and drawbacks. One point to remember when working with LOBs (CLOBs, BLOBs) is if your LOB column can be in one of three states; - NULL The table cell is created, but the cell holds no locator or value. If your LOB field is in this state then there is no LOB Locator that DBD::Oracle can work so if your encounter a DBD::Oracle::db::ora_lob_read: locator is not of type OCILobLocatorPtr error when working with a LOB. You can correct this by using an SQL UPDATE statement to reset the LOB column to a non-NULL (or empty LOB) value with either EMPTY\_BLOB or EMPTY\_CLOB as in this example; UPDATE lob_example SET bindata=EMPTY_BLOB() WHERE bindata IS NULL. - Empty A LOB instance with a locator exists in the cell, but it has no value. The length of the LOB is zero. In this case DBD::Oracle will return 'undef' for the field. - Populated A LOB instance with a locator and a value exists in the cell. You actually get the LOB value. ## Data Interface for Persistent LOBs This is the original interface for LONG and LONG RAW datatypes and from Oracle 9iR1 and later the OCI API was extended to work directly with the other LOB datatypes. In other words you can treat all LOB type data (BLOB, CLOB) as if it was a LONG, LONG RAW, or VARCHAR2. So you can perform INSERT, UPDATE, fetch, bind, and define operations on LOBs using the same techniques you would use on other datatypes that store character or binary data. In some cases there are fewer round trips to the server as no 'LOB Locators' are used, normally one can get an entire LOB is a single round trip. ### Simple Fetch for LONGs and LONG RAWs As the name implies this is the simplest way to use this interface. DBD::Oracle just attempts to get your LONG datatypes as a single large piece. There are no special settings, simply set the database handle's 'LongReadLen' attribute to a value that will be the larger than the expected size of the LONG or LONG RAW. If the size of the LONG or LONG RAW exceeds the 'LongReadLen' DBD::Oracle will return a 'ORA-24345: A Truncation' error. To stop this set the database handle's 'LongTruncOk' attribute to '1'. The maximum value of 'LongReadLen' seems to be dependent on the physical memory limits of the box that Oracle is running on. You have most likely reached this limit if you run into an 'ORA-01062: unable to allocate memory for define buffer' error. One solution is to set the size of 'LongReadLen' to a lower value. For example give this table; CREATE TABLE test_long ( id NUMBER, long1 long) this code; $dbh->{LongReadLen} = 2*1024*1024; #2 meg $SQL='select p_id,long1 from test_long'; $sth=$dbh->prepare($SQL); $sth->execute(); while (my ( $p_id,$long )=$sth->fetchrow()){ print "p_id=".$p_id."\n"; print "long=".$long."\n"; } Will select out all of the long1 fields in the table as long as they are all under 2MB in length. A value in long1 longer than this will throw an error. Adding this line; $dbh->{LongTruncOk}=1; before the execute will return all the long1 fields but they will be truncated at 2MBs. ### Using ora\_ncs\_buff\_mtpl When getting CLOBs and NCLOBs in or out of Oracle, the Server will translate from the Server's NCharSet to the Client's. If they happen to be the same or at least compatible then all of these actions are a 1 char to 1 char bases. Thus if you set your LongReadLen buffer to 10\_000\_000 you will get up to 10\_000\_000 char. However if the Server has to translate from one NCharSet to another it will use bytes for conversion. The buffer value is set to 4 \* LONG\_READ\_LEN which was very wasteful as you might only be asking for 10\_000\_000 bytes but you were actually using 40\_000\_000 bytes of buffer under the hood. You would still get 10\_000\_000 bytes (maybe less characters though) but you are using allot more memory that you need. You can now customize the size of the buffer by setting the 'ora\_ncs\_buff\_mtpl' either on the connection or statement handle. You can also set this as 'ORA\_DBD\_NCS\_BUFFER' OS environment variable so you will have to go back and change all your code if you are getting into trouble. The default value is still set to 4 for backward compatibility. You can lower this value and thus increase the amount of data you can retrieve. If the ora\_ncs\_buff\_mtpl is too small DBD::Oracle will throw and error telling you to increase this buffer by one. If the error is not captured then you may get at some random point later on, usually at a finish() or disconnect() or even a fetch() this error; ORA-03127: no new operations allowed until the active operation ends This is one of the more obscure ORA errors (have some fun and report it to Meta-Link they will scratch their heads for hours) If you get this, simply increment the ora\_ncs\_buff\_mtpl by one until it goes away. This should greatly increase your ability to select very large CLOBs or NCLOBs, by freeing up a large block of memory. You can tune this value by setting ora\_oci\_success\_warn which will display the following OCILobRead field 2 of 3 SUCCESS: csform 1 (SQLCS_IMPLICIT), LOBlen 10240(characters), LongReadLen 20(characters), BufLen 80(characters), Got 28(characters) In the case above the query Got 28 characters (well really only 20 characters of 28 bytes) so we could use ora\_ncs\_buff\_mtpl=>2 (20\*2=40) thus saving 40bytes of memory. ### Simple Fetch for CLOBs and BLOBs To use this interface for CLOBs and LOBs datatypes set the 'ora\_pers\_lob' attribute of the statement handle to '1' with the prepare method, as well set the database handle's 'LongReadLen' attribute to a value that will be the larger than the expected size of the LOB. If the size of the LOB exceeds the 'LongReadLen' DBD::Oracle will return a 'ORA-24345: A Truncation' error. To stop this set the database handle's 'LongTruncOk' attribute to '1'. The maximum value of 'LongReadLen' seems to be dependent on the physical memory limits of the box that Oracle is running on in the same way that LONGs and LONG RAWs are. For CLOBs and NCLOBs the limit is 64k chars if there is no truncation, this is an internal OCI limit complain to them if you want it changed. However if you CLOB is longer than this and also larger than the 'LongReadLen' than the 'LongReadLen' in chars is returned. It seems with BLOBs you are not limited by the 64k. For example give this table; CREATE TABLE test_lob (id NUMBER, clob1 CLOB, clob2 CLOB, blob1 BLOB, blob2 BLOB) this code; $dbh->{LongReadLen} = 2*1024*1024; #2 meg $SQL='select p_id,lob_1,lob_2,blob_2 from test_lobs'; $sth=$dbh->prepare($SQL,{ora_pers_lob=>1}); $sth->execute(); while (my ( $p_id,$log,$log2,$log3,$log4 )=$sth->fetchrow()){ print "p_id=".$p_id."\n"; print "clob1=".$clob1."\n"; print "clob2=".$clob2."\n"; print "blob1=".$blob2."\n"; print "blob2=".$blob2."\n"; } Will select out all of the LOBs in the table as long as they are all under 2MB in length. Longer lobs will throw an error. Adding this line; $dbh->{LongTruncOk}=1; before the execute will return all the lobs but they will be truncated at 2MBs. ### Piecewise Fetch with Callback With a piecewise callback fetch DBD::Oracle sets up a function that will 'callback' to the DB during the fetch and gets your LOB (LONG, LONG RAW, CLOB, BLOB) piece by piece. To use this interface set the 'ora\_clbk\_lob' attribute of the statement handle to '1' with the prepare method. Next set the 'ora\_piece\_size' to the size of the piece that you want to return on the callback. Finally set the database handle's 'LongReadLen' attribute to a value that will be the larger than the expected size of the LOB. Like the ["Simple Fetch for LONGs and LONG RAWs"](#simple-fetch-for-longs-and-long-raws) and ["Simple Fetch for CLOBs and BLOBs"](#simple-fetch-for-clobs-and-blobs) the if the size of the LOB exceeds the is 'LongReadLen' you can use the 'LongTruncOk' attribute to truncate the LOB or set the 'LongReadLen' to a higher value. With this interface the value of 'ora\_piece\_size' seems to be constrained by the same memory limit as found on the Simple Fetch interface. If you encounter an 'ORA-01062' error try setting the value of 'ora\_piece\_size' to a smaller value. The value for 'LongReadLen' is dependent on the version and settings of the Oracle DB you are using. In theory it ranges from 8GBs in 9iR1 up to 128 terabytes with 11g but you will also be limited by the physical memory of your PERL instance. Using the table from the last example this code; $dbh->{LongReadLen} = 20*1024*1024; #20 meg $SQL='select p_id,lob_1,lob_2,blob_2 from test_lobs'; $sth=$dbh->prepare($SQL,{ora_clbk_lob=>1,ora_piece_size=>5*1024*1024}); $sth->execute(); while (my ( $p_id,$log,$log2,$log3,$log4 )=$sth->fetchrow()){ print "p_id=".$p_id."\n"; print "clob1=".$clob1."\n"; print "clob2=".$clob2."\n"; print "blob1=".$blob2."\n"; print "blob2=".$blob2."\n"; } Will select out all of the LOBs in the table as long as they are all under 20MB in length. If the LOB is longer than 5MB (ora\_piece\_size) DBD::Oracle will fetch it in at least 2 pieces to a maximum of 4 pieces (4\*5MB=20MB). Like the Simple Fetch examples Lobs longer than 20MB will throw an error. Using the table from the first example (LONG) this code; $dbh->{LongReadLen} = 20*1024*1024; #2 meg $SQL='select p_id,long1 from test_long'; $sth=$dbh->prepare($SQL,{ora_clbk_lob=>1,ora_piece_size=>5*1024*1024}); $sth->execute(); while (my ( $p_id,$long )=$sth->fetchrow()){ print "p_id=".$p_id."\n"; print "long=".$long."\n"; } Will select all of the long1 fields from table as long as they are is under 20MB in length. If the long1 filed is longer than 5MB (ora\_piece\_size) DBD::Oracle will fetch it in at least 2 pieces to a maximum of 4 pieces (4\*5MB=20MB). Like the other examples long1 fields longer than 20MB will throw an error. #### Piecewise Fetch with Polling With a polling piecewise fetch DBD::Oracle iterates (Polls) over the LOB during the fetch getting your LOB (LONG, LONG RAW, CLOB, BLOB) piece by piece. To use this interface set the 'ora\_piece\_lob' attribute of the statement handle to '1' with the prepare method. Next set the 'ora\_piece\_size' to the size of the piece that you want to return on the callback. Finally set the database handle's 'LongReadLen' attribute to a value that will be the larger than the expected size of the LOB. Like the ["Piecewise Fetch with Callback"](#piecewise-fetch-with-callback) and Simple Fetches if the size of the LOB exceeds the is 'LongReadLen' you can use the 'LongTruncOk' attribute to truncate the LOB or set the 'LongReadLen' to a higher value. With this interface the value of 'ora\_piece\_size' seems to be constrained by the same memory limit as found on the ["Piecewise Fetch with Callback"](#piecewise-fetch-with-callback). Using the table from the example above this code; $dbh->{LongReadLen} = 20*1024*1024; #20 meg $SQL='select p_id,lob_1,lob_2,blob_2 from test_lobs'; $sth=$dbh->prepare($SQL,{ora_piece_lob=>1,ora_piece_size=>5*1024*1024}); $sth->execute(); while (my ( $p_id,$log,$log2,$log3,$log4 )=$sth->fetchrow()){ print "p_id=".$p_id."\n"; print "clob1=".$clob1."\n"; print "clob2=".$clob2."\n"; print "blob1=".$blob2."\n"; print "blob2=".$blob2."\n"; } Will select out all of the LOBs in the table as long as they are all under 20MB in length. If the LOB is longer than 5MB (ora\_piece\_size) DBD::Oracle will fetch it in at least 2 pieces to a maximum of 4 pieces (4\*5MB=20MB). Like the other fetch methods LOBs longer than 20MB will throw an error. Finally with this code; $dbh->{LongReadLen} = 20*1024*1024; #2 meg $SQL='select p_id,long1 from test_long'; $sth=$dbh->prepare($SQL,{ora_piece_lob=>1,ora_piece_size=>5*1024*1024}); $sth->execute(); while (my ( $p_id,$long )=$sth->fetchrow()){ print "p_id=".$p_id."\n"; print "long=".$long."\n"; } Will select all of the long1 fields from table as long as they are is under 20MB in length. If the long1 field is longer than 5MB (ora\_piece\_size) DBD::Oracle will fetch it in at least 2 pieces to a maximum of 4 pieces (4\*5MB=20MB). Like the other examples long1 fields longer than 20MB will throw an error. ### Binding for Updates and Inserts for CLOBs and BLOBs To bind for updates and inserts all that is required to use this interface is to set the statement handle's prepare method 'ora\_type' attribute to 'SQLT\_CHR' in the case of CLOBs and NCLOBs or 'SQLT\_BIN' in the case of BLOBs as in this example for an insert; my $in_clob = "\n"; $in_clob .= " $_\n" for 1 .. 10_000; $in_clob .= "\n"; my $in_blob ="0101" for 1 .. 10_000; $SQL='insert into test_lob3@tpgtest (id,clob1,clob2, blob1,blob2) values(?,?,?,?,?)'; $sth=$dbh->prepare($SQL ); $sth->bind_param(1,3); $sth->bind_param(2,$in_clob,{ora_type=>SQLT_CHR}); $sth->bind_param(3,$in_clob,{ora_type=>SQLT_CHR}); $sth->bind_param(4,$in_blob,{ora_type=>SQLT_BIN}); $sth->bind_param(5,$in_blob,{ora_type=>SQLT_BIN}); $sth->execute(); So far the only limit reached with this form of insert is the LOBs must be under 2GB in size. ### Support for Remote LOBs; Starting with Oracle 10gR2 the interface for Persistent LOBs was expanded to support remote LOBs (access over a dblink). Given a database called 'lob\_test' that has a 'LINK' defined like this; CREATE DATABASE LINK link_test CONNECT TO test_lobs IDENTIFIED BY tester USING 'lob_test'; to a remote database called 'test\_lobs', the following code will work; $dbh = DBI->connect('dbi:Oracle:','test@lob_test','test'); $dbh->{LongReadLen} = 2*1024*1024; #2 meg $SQL='select p_id,lob_1,lob_2,blob_2 from test_lobs@link_test'; $sth=$dbh->prepare($SQL,{ora_pers_lob=>1}); $sth->execute(); while (my ( $p_id,$log,$log2,$log3,$log4 )=$sth->fetchrow()){ print "p_id=".$p_id."\n"; print "clob1=".$clob1."\n"; print "clob2=".$clob2."\n"; print "blob1=".$blob2."\n"; print "blob2=".$blob2."\n"; } Below are the limitations of Remote LOBs; - Queries involving more than one database are not supported; so the following returns an error: SELECT t1.lobcol, a2.lobcol FROM t1, t2.lobcol@dbs2 a2 W WHERE LENGTH(t1.lobcol) = LENGTH(a2.lobcol); as does: SELECT t1.lobcol FROM t1@dbs1 UNION ALL SELECT t2.lobcol FROM t2@dbs2; - DDL commands are not supported; so the following returns an error: CREATE VIEW v AS SELECT lob_col FROM tab@dbs; - Only binds and defines for data going into remote persistent LOBs are supported. so that parameter passing in PL/SQL where CHAR data is bound or defined for remote LOBs is not allowed . These statements all produce errors: SELECT foo() FROM table1@dbs2; SELECT foo()@dbs INTO char_val FROM DUAL; SELECT XMLType().getclobval FROM table1@dbs2; - If the remote object is a view such as CREATE VIEW v AS SELECT foo() FROM ... the following would not work: SELECT * FROM v@dbs2; - Limited PL/SQL parameter passing PL/SQL parameter passing is not allowed where the actual argument is a LOB type and the remote argument is one of VARCHAR2, NVARCHAR2, CHAR, NCHAR, or RAW. - RETURNING INTO does not support implicit conversions between CHAR and CLOB. so the following returns an error: SELECT t1.lobcol as test, a2.lobcol FROM t1, t2.lobcol@dbs2 a2 RETURNING test ## Locator Data Interface ### Simple Usage When fetching LOBs with this interface a 'LOB Locator' is created then used to get the lob with the LongReadLen and LongTruncOk attributes. The value for 'LongReadLen' is dependent on the version and settings of the Oracle DB you are using. In theory it ranges from 8GBs in 9iR1 up to 128 terabytes with 11g but you will also be limited by the physical memory of your PERL instance. When inserting or updating LOBs some _major_ magic has to be performed behind the scenes to make it transparent. Basically the driver has to insert a 'LOB Locator' and then refetch the newly inserted LOB Locator before being able to write the data into it. However, it works well most of the time, and I've made it as fast as possible, just one extra server-round-trip per insert or update after the first. For the time being, only single-row LOB updates are supported. To insert or update a large LOB using a placeholder, DBD::Oracle has to know in advance that it is a LOB type. So you need to say: $sth->bind_param($field_num, $lob_value, { ora_type => ORA_CLOB }); The ORA\_CLOB and ORA\_BLOB constants can be imported using use DBD::Oracle qw(:ora_types); or use the corresponding integer values (112 and 113). One further wrinkle: for inserts and updates of LOBs, DBD::Oracle has to be able to tell which parameters relate to which table fields. In all cases where it can possibly work it out for itself, it does, however, if there are multiple LOB fields of the same type in the table then you need to tell it which field each LOB param relates to: $sth->bind_param($idx, $value, { ora_type=>ORA_CLOB, ora_field=>'foo' }); There are some limitations inherent in the way DBD::Oracle makes typical LOB operations simple by hiding the LOB Locator processing: - Can't read/write LOBs in chunks (except via DBMS_LOB.WRITEAPPEND in PL/SQL) - To INSERT a LOB, you need UPDATE privilege. The alternative is to disable the automatic LOB Locator processing. If ["ora\_auto\_lob"](#ora_auto_lob) is 0 in prepare(), you can fetch the LOB Locators and do all the work yourself using the ora\_lob\_\*() methods. See the ["Data Interface for LOB Locators"](#data-interface-for-lob-locators) section below. ### LOB support in PL/SQL LOB Locators can be passed to PL/SQL calls by binding them to placeholders with the proper `ora_type`. If ["ora\_auto\_lob"](#ora_auto_lob) is true, output LOB parameters will be automatically returned as strings. If the Oracle driver has support for temporary LOBs (Oracle 9i and higher), strings can be bound to input LOB placeholders and will be automatically converted to LOBs. Example: # Build a large XML document, bind it as a CLOB, # extract elements through PL/SQL and return as a CLOB # $dbh is a connected database handle # output will be large local $dbh->{LongReadLen} = 1_000_000; my $in_clob = "\n"; $in_clob .= " $_\n" for 1 .. 10_000; $in_clob .= "\n"; my $out_clob; my $sth = $dbh->prepare(<bind_param( ':in', $in_clob, { ora_type => ORA_CLOB } ); $sth->bind_param_inout( ':out', \$out_clob, 0, { ora_type => ORA_CLOB } ); $sth->execute; If you ever get an ORA-01691 unable to extend lob segment sss.ggg by nnn in tablespace ttt error, while attempting to insert a LOB, this means the Oracle user has insufficient space for LOB you are trying to insert. One solution it to use "alter database datafile 'sss.ggg' resize Mnnn" to increase the available memory for LOBs. ## Persistent & Locator Interface Caveats Now that one has the option of using the Persistent or the Locator interface for LOBs the questions arises which one to use. For starters, if you want to access LOBs over a dblink you will have to use the Persistent interface so that choice is simple. The question of which one to use after that is a little more tricky. It basically boils down to a choice between LOB size and speed. The Callback and Polling piecewise fetches are very very slow when compared to the Simple and the Locator fetches but they can handle very large blocks of data. Given a situation where a large LOB is to be read the Locator fetch may time out while either of the piecewise fetches may not. With the Simple fetch you are limited by physical memory of your server but it runs a little faster than the Locator, as there are fewer round trips to the server. So if you have small LOBs and need to save a little bandwidth this is the one to use. It you are going after large LOBs then the Locator interface is the one to use. If you need to update more than a single row of with LOB data then the Persistent interface can do it while the Locator can't. If you encounter a situation where you have to access the legacy LOBs (LONG, LONG RAW) and the values are to large for you system then you can use the Callback or Polling piecewise fetches to get all of the data. Not all of the Persistent interface has been implemented yet, the following are not supported; 1) Piecewise, polling and callback binds for INSERT and UPDATE operations. 2) Piecewise array binds for SELECT, INSERT and UPDATE operations. Most of the time you should just use the ["Locator Data Interface"](#locator-data-interface) as this is in one that has the best combination of speed and size. All this being said if you are doing some critical programming I would use the ["Data Interface for LOB Locators"](#data-interface-for-lob-locators) as this gives you very fine grain control of your LOBs, of course the code for this will be somewhat more involved. ## Data Interface for LOB Locators The following driver-specific methods let you manipulate "LOB Locators" directly. To select a LOB locator directly set the if the `ora_auto_lob` attribute to false, or alternatively they can be returned via PL/SQL procedure calls. (If using a DBI version earlier than 1.36 they must be called via the func() method. Note that methods called via func() don't honour RaiseError etc, and so it's important to check $dbh->err after each call. It's recommended that you upgrade to DBI 1.38 or later.) Note that LOB locators are only valid while the statement handle that created them is valid. When all references to the original statement handle are lost, the handle is destroyed and the locators are freed. - ora\_lob\_read $data = $dbh->ora_lob_read($lob_locator, $offset, $length); Read a portion of the LOB. $offset starts at 1. Uses the Oracle OCILobRead function. NOTE: DBD::Oracle post 1.46 will return undef for any read lob if the length specified in the ora\_lob\_read is 0. See RT 55028. This avoids the potential problem with empty lobs (created with empty\_clob) which return a length of 0 from ora\_lob\_length and prior to 1.46 a call to ora\_lob\_read with a 0 length would segfault. - ora\_lob\_write $rc = $dbh->ora_lob_write($lob_locator, $offset, $data); Write/overwrite a portion of the LOB. $offset starts at 1. Uses the Oracle OCILobWrite function. - ora\_lob\_append $rc = $dbh->ora_lob_append($lob_locator, $data); Append $data to the LOB. Uses the Oracle OCILobWriteAppend function. - ora\_lob\_trim $rc = $dbh->ora_lob_trim($lob_locator, $length); Trims the length of the LOB to $length. Uses the Oracle OCILobTrim function. - ora\_lob\_length $length = $dbh->ora_lob_length($lob_locator); Returns the length of the LOB. Uses the Oracle OCILobGetLength function. - ora\_lob\_is\_init $is_init = $dbh->ora_lob_is_init($lob_locator); Returns true(1) if the Lob Locator is initialized false(0) if it is not, or 'undef' if there is an error. Uses the Oracle OCILobLocatorIsInit function. - ora\_lob\_chunk\_size $chunk_size = $dbh->ora_lob_chunk_size($lob_locator); Returns the chunk size of the LOB. Uses the Oracle OCILobGetChunkSize function. For optimal performance, Oracle recommends reading from and writing to a LOB in batches using a multiple of the LOB chunk size. In Oracle 10g and before, when all defaults are in place, this chunk size defaults to 8k (8192). ### LOB Locator Method Examples _Note:_ Make sure you first read the note in the section above about multi-byte character set issues with these methods. The following examples demonstrate the usage of LOB Locators to read, write, and append data, and to query the size of large data. The following examples assume a table containing two large object columns, one binary and one character, with a primary key column, defined as follows: CREATE TABLE lob_example ( lob_id INTEGER PRIMARY KEY, bindata BLOB, chardata CLOB ) It also assumes a sequence for use in generating unique lob\_id field values, defined as follows: CREATE SEQUENCE lob_example_seq ### Example: Inserting a new row with large data Unless enough memory is available to store and bind the entire LOB data for insert all at once, the LOB columns must be written interactively, piece by piece. In the case of a new row, this is performed by first inserting a row, with empty values in the LOB columns, then modifying the row by writing the large data interactively to the LOB columns using their LOB locators as handles. The insert statement must create token values in the LOB columns. Here, we use the empty string for both the binary and character large object columns 'bindata' and 'chardata'. After the INSERT statement, a SELECT statement is used to acquire LOB locators to the 'bindata' and 'chardata' fields of the newly inserted row. Because these LOB locators are subsequently written, they must be acquired from a select statement containing the clause 'FOR UPDATE' (LOB locators are only valid within the transaction that fetched them, so can't be used effectively if AutoCommit is enabled). my $lob_id = $dbh->selectrow_array( <<" SQL" ); SELECT lob_example_seq.nextval FROM DUAL SQL my $sth = $dbh->prepare( <<" SQL" ); INSERT INTO lob_example ( lob_id, bindata, chardata ) VALUES ( ?, EMPTY_BLOB(),EMPTY_CLOB() ) SQL $sth->execute( $lob_id ); $sth = $dbh->prepare( <<" SQL", { ora_auto_lob => 0 } ); SELECT bindata, chardata FROM lob_example WHERE lob_id = ? FOR UPDATE SQL $sth->execute( $lob_id ); my ( $bin_locator, $char_locator ) = $sth->fetchrow_array(); $sth->finish(); open BIN_FH, "/binary/data/source" or die; open CHAR_FH, "/character/data/source" or die; my $chunk_size = $dbh->ora_lob_chunk_size( $bin_locator ); # BEGIN WRITING BIN_DATA COLUMN my $offset = 1; # Offsets start at 1, not 0 my $length = 0; my $buffer = ''; while( $length = read( BIN_FH, $buffer, $chunk_size ) ) { $dbh->ora_lob_write( $bin_locator, $offset, $buffer ); $offset += $length; } # BEGIN WRITING CHAR_DATA COLUMN $chunk_size = $dbh->ora_lob_chunk_size( $char_locator ); $offset = 1; # Offsets start at 1, not 0 $length = 0; $buffer = ''; while( $length = read( CHAR_FH, $buffer, $chunk_size ) ) { $dbh->ora_lob_write( $char_locator, $offset, $buffer ); $offset += $length; } In this example we demonstrate the use of ora\_lob\_write() interactively to append data to the columns 'bin\_data' and 'char\_data'. Had we used ora\_lob\_append(), we could have saved ourselves the trouble of keeping track of the offset into the lobs. The snippet of code beneath the comment 'BEGIN WRITING BIN\_DATA COLUMN' could look as follows: my $buffer = ''; while ( read( BIN_FH, $buffer, $chunk_size ) ) { $dbh->ora_lob_append( $bin_locator, $buffer ); } The scalar variables $offset and $length are no longer needed, because ora\_lob\_append() keeps track of the offset for us. ### Example: Updating an existing row with large data In this example, we demonstrate a technique for overwriting a portion of a blob field with new binary data. The blob data before and after the section overwritten remains unchanged. Hence, this technique could be used for updating fixed length subfields embedded in a binary field. my $lob_id = 5; # Arbitrary row identifier, for example $sth = $dbh->prepare( <<" SQL", { ora_auto_lob => 0 } ); SELECT bindata FROM lob_example WHERE lob_id = ? FOR UPDATE SQL $sth->execute( $lob_id ); my ( $bin_locator ) = $sth->fetchrow_array(); my $offset = 100234; my $data = "This string will overwrite a portion of the blob"; $dbh->ora_lob_write( $bin_locator, $offset, $data ); After running this code, the row where lob\_id = 5 will contain, starting at position 100234 in the bin\_data column, the string "This string will overwrite a portion of the blob". ### Example: Streaming character data from the database In this example, we demonstrate a technique for streaming data from the database to a file handle, in this case STDOUT. This allows more data to be read in and written out than could be stored in memory at a given time. my $lob_id = 17; # Arbitrary row identifier, for example $sth = $dbh->prepare( <<" SQL", { ora_auto_lob => 0 } ); SELECT chardata FROM lob_example WHERE lob_id = ? SQL $sth->execute( $lob_id ); my ( $char_locator ) = $sth->fetchrow_array(); my $chunk_size = 1034; # Arbitrary chunk size, for example my $offset = 1; # Offsets start at 1, not 0 while(1) { my $data = $dbh->ora_lob_read( $char_locator, $offset, $chunk_size ); last unless length $data; print STDOUT $data; $offset += $chunk_size; } Notice that the select statement does not contain the phrase "FOR UPDATE". Because we are only reading from the LOB Locator returned, and not modifying the LOB it refers to, the select statement does not require the "FOR UPDATE" clause. A word of caution when using the data returned from an ora\_lob\_read in a conditional statement. for example if the code below; while( my $data = $dbh->ora_lob_read( $char_locator, $offset, $chunk_size ) ) { print STDOUT $data; $offset += $chunk_size; } was used with a chunk size of 4096 against a blob that requires more than 1 chunk to return the data and the last chunk is one byte long and contains a zero (ASCII 48) you will miss this last byte as $data will contain 0 which PERL will see as false and not print it out. ### Example: Truncating existing large data In this example, we truncate the data already present in a large object column in the database. Specifically, for each row in the table, we truncate the 'bindata' value to half its previous length. After acquiring a LOB Locator for the column, we query its length, then we trim the length by half. Because we modify the large objects with the call to ora\_lob\_trim(), we must select the LOB locators 'FOR UPDATE'. my $sth = $dbh->prepare( <<" SQL", { ora_auto_lob => 0 } ); SELECT bindata FROM lob_example FOR UPATE SQL $sth->execute(); while( my ( $bin_locator ) = $sth->fetchrow_array() ) { my $binlength = $dbh->ora_lob_length( $bin_locator ); if( $binlength > 0 ) { $dbh->ora_lob_trim( $bin_locator, $binlength/2 ); } } # SPACES AND PADDING ## Trailing Spaces Only the Oracle OCI 8 strips trailing spaces from VARCHAR placeholder values and uses Nonpadded Comparison Semantics with the result. This causes trouble if the spaces are needed for comparison with a CHAR value or to prevent the value from becoming '' which Oracle treats as NULL. Look for Blank-padded Comparison Semantics and Nonpadded Comparison Semantics in Oracle's SQL Reference or Server SQL Reference for more details. To preserve trailing spaces in placeholder values for Oracle clients that use OCI 8, either change the default placeholder type with ["ora\_ph\_type"](#ora_ph_type) or the placeholder type for a particular call to ["bind" in DBI](https://metacpan.org/pod/DBI#bind) or ["bind\_param\_inout" in DBI](https://metacpan.org/pod/DBI#bind_param_inout) with ["ora\_type"](#ora_type) or `TYPE`. Using [ORA\_CHAR](https://metacpan.org/pod/ORA_CHAR) with [ora\_type](https://metacpan.org/pod/ora_type) or `SQL_CHAR` with `TYPE` allows the placeholder to be used with Padded Comparison Semantics if the value it is being compared to is a CHAR, NCHAR, or literal. Please remember that using spaces as a value or at the end of a value makes visually distinguishing values with different numbers of spaces difficult and should be avoided. Oracle Clients that use OCI 9.2 do not strip trailing spaces. ## Padded Char Fields Oracle Clients after OCI 9.2 will automatically pad CHAR placeholder values to the size of the CHAR. As the default placeholder type value in DBD::Oracle is ORA\_VARCHAR2 to access this behaviour you will have to change the default placeholder type with ["ora\_ph\_type"](#ora_ph_type) or placeholder type for a particular call with ["bind" in DBI](https://metacpan.org/pod/DBI#bind) or ["bind\_param\_inout" in DBI](https://metacpan.org/pod/DBI#bind_param_inout) with ["ORA\_CHAR"](#ora_char). # UNICODE DBD::Oracle now supports Unicode UTF-8. There are, however, a number of issues you should be aware of, so please read all this section carefully. In this section we'll discuss "Perl and Unicode", then "Oracle and Unicode", and finally "DBD::Oracle and Unicode". Information about Unicode in general can be found at: [http://www.unicode.org/](http://www.unicode.org/). It is well worth reading because there are many misconceptions about Unicode and you may be holding some of them. ## Perl and Unicode Perl began implementing Unicode with version 5.6, but the implementation did not mature until version 5.8 and later. If you plan to use Unicode you are _strongly_ urged to use Perl 5.8.2 or later and to _carefully_ read the Perl documentation on Unicode: perldoc perluniintro # in Perl 5.8 or later perldoc perlunicode And then read it again. Perl's internal Unicode format is UTF-8 which corresponds to the Oracle character set called AL32UTF8. ## Oracle and Unicode Oracle supports many characters sets, including several different forms of Unicode. These include: AL16UTF16 => valid for NCHAR columns (CSID=2000) UTF8 => valid for NCHAR columns (CSID=871), deprecated AL32UTF8 => valid for NCHAR and CHAR columns (CSID=873) When you create an Oracle database, you must specify the DATABASE character set (used for DDL, DML and CHAR datatypes) and the NATIONAL character set (used for NCHAR and NCLOB types). The character sets used in your database can be found using: $hash_ref = $dbh->ora_nls_parameters() $database_charset = $hash_ref->{NLS_CHARACTERSET}; $national_charset = $hash_ref->{NLS_NCHAR_CHARACTERSET}; The Oracle 9.2 and later default for the national character set is AL16UTF16. The default for the database character set is often US7ASCII. Although many experienced DBAs will consider an 8bit character set like WE8ISO8859P1 or WE8MSWIN1252. To use any character set with Oracle other than US7ASCII, requires that the NLS\_LANG environment variable be set. See the ["Oracle UTF8 is not UTF-8"](#oracle-utf8-is-not-utf-8) section below. You are strongly urged to read the Oracle Internationalization documentation specifically with respect the choices and trade offs for creating a databases for use with international character sets. Oracle uses the NLS\_LANG environment variable to indicate what character set is being used on the client. When fetching data Oracle will convert from whatever the database character set is to the client character set specified by NLS\_LANG. Similarly, when sending data to the database Oracle will convert from the character set specified by NLS\_LANG to the database character set. The NLS\_NCHAR environment variable can be used to define a different character set for 'national' (NCHAR) character types. Both UTF8 and AL32UTF8 can be used in NLS\_LANG and NLS\_NCHAR. For example: NLS_LANG=AMERICAN_AMERICA.UTF8 NLS_LANG=AMERICAN_AMERICA.AL32UTF8 NLS_NCHAR=UTF8 NLS_NCHAR=AL32UTF8 ## Oracle UTF8 is not UTF-8 AL32UTF8 should be used in preference to UTF8 if it works for you, which it should for Oracle 9.2 or later. If you're using an old version of Oracle that doesn't support AL32UTF8 then you should avoid using any Unicode characters that require surrogates, in other words characters beyond the Unicode BMP (Basic Multilingual Plane). That's because the character set that Oracle calls "UTF8" doesn't conform to the UTF-8 standard in its handling of surrogate characters. Technically the encoding that Oracle calls "UTF8" is known as "CESU-8". Here are a couple of extracts from [http://www.unicode.org/reports/tr26/](http://www.unicode.org/reports/tr26/): CESU-8 is useful in 8-bit processing environments where binary collation with UTF-16 is required. It is designed and recommended for use only within products requiring this UTF-16 binary collation equivalence. It is not intended nor recommended for open interchange. As a very small percentage of characters in a typical data stream are expected to be supplementary characters, there is a strong possibility that CESU-8 data may be misinterpreted as UTF-8. Therefore, all use of CESU-8 outside closed implementations is strongly discouraged, such as the emittance of CESU-8 in output files, markup language or other open transmission forms. Oracle uses this internally because it collates (sorts) in the same order as UTF16, which is the basis of Oracle's internal collation definitions. Rather than change UTF8 for clients Oracle chose to define a new character set called "AL32UTF8" which does conform to the UTF-8 standard. (The AL32UTF8 character set can't be used on the server because it would break collation.) Because of that, for the rest of this document we'll use "AL32UTF8". If you're using an Oracle version below 9.2 you'll need to use "UTF8" until you upgrade. ## DBD::Oracle and Unicode DBD::Oracle Unicode support has been implemented for Oracle versions 9 or greater, and Perl version 5.6 or greater (though we _strongly_ suggest that you use Perl 5.8.2 or later). You can check which Oracle version your DBD::Oracle was built with by importing the `ORA_OCI` constant from DBD::Oracle. __Fetching Data__ Any data returned from Oracle to DBD::Oracle in the AL32UTF8 character set will be marked as UTF-8 to ensure correct handling by Perl. For Oracle to return data in the AL32UTF8 character set the NLS\_LANG or NLS\_NCHAR environment variable _must_ be set as described in the previous section. When fetching NCHAR, NVARCHAR, or NCLOB data from Oracle, DBD::Oracle will set the Perl UTF-8 flag on the returned data if either NLS\_NCHAR is AL32UTF8, or NLS\_NCHAR is not set and NLS\_LANG is AL32UTF8. When fetching other character data from Oracle, DBD::Oracle will set the Perl UTF-8 flag on the returned data if NLS\_LANG is AL32UTF8. __Sending Data using Placeholders__ Data bound to a placeholder is assumed to be in the default client character set (specified by NLS\_LANG) except for a few special cases. These are listed here with the highest precedence first: If the `ora_csid` attribute is given to bind\_param() then that is passed to Oracle and takes precedence. If the value is a Perl Unicode string (UTF-8) then DBD::Oracle ensures that Oracle uses the Unicode character set, regardless of the NLS\_LANG and NLS\_NCHAR settings. If the placeholder is for inserting an NCLOB then the client NLS\_NCHAR character set is used. (That's useful but inconsistent with the other behaviour so may change. Best to be explicit by using the `ora_csform` attribute.) If the `ora_csform` attribute is given to bind\_param() then that determines if the value should be assumed to be in the default (NLS\_LANG) or NCHAR (NLS\_NCHAR) client character set. use DBD::Oracle qw( SQLCS_IMPLICIT SQLCS_NCHAR ); ... $sth->bind_param(1, $value, { ora_csform => SQLCS_NCHAR }); or $dbh->{ora_ph_csform} = SQLCS_NCHAR; # default for all future placeholders Binding with bind\_param\_array and execute\_array is also UTF-8 compatible in the same way. If you attempt to insert UTF-8 data into a non UTF-8 Oracle instance or with an non UTF-8 NCHAR or NVARCHAR the insert will still happen but a error code of 0 will be returned with the following warning; DBD Oracle Warning: You have mixed utf8 and non-utf8 in an array bind in parameter#1. This may result in corrupt data. The Query charset id=1, name=US7ASCII The warning will report the parameter number and the NCHAR setting that the query is running. __Sending Data using SQL__ Oracle assumes the SQL statement is in the default client character set (as specified by NLS\_LANG). So Unicode strings containing non-ASCII characters should not be used unless the default client character set is AL32UTF8. ## DBD::Oracle and Other Character Sets and Encodings The only multi-byte Oracle character set supported by DBD::Oracle is "AL32UTF8" (and "UTF8"). Single-byte character sets should work well. # OBJECT & COLLECTION DATA TYPES Oracle databases allow for the creation of object oriented like user-defined types. There are two types of objects, Embedded--an object stored in a column of a regular table and REF--an object that uses the REF retrieval mechanism. DBD::Oracle supports only the 'selection' of embedded objects of the following types OBJECT, VARRAY and TABLE in any combination. Support is seamless and recursive, meaning you need only supply a simple SQL statement to get all the values in an embedded object. You can either get the values as an array of scalars or they can be returned into a DBD::Oracle::Object. Array example, given this type and table; CREATE OR REPLACE TYPE "PHONE_NUMBERS" as varray(10) of varchar(30); CREATE TABLE "CONTACT" ( "COMPANYNAME" VARCHAR2(40), "ADDRESS" VARCHAR2(100), "PHONE_NUMBERS" "PHONE_NUMBERS" ) The code to access all the data in the table could be something like this; my $sth = $dbh->prepare('SELECT * FROM CONTACT'); $sth->execute; while ( my ($company, $address, $phone) = $sth->fetchrow()) { print "Company: ".$company."\n"; print "Address: ".$address."\n"; print "Phone #: "; foreach my $items (@$phone){ print $items.", "; } print "\n"; } Note that values in PHONE\_NUMBERS are returned as an array reference '@$phone'. As stated before DBD::Oracle will automatically drill into the embedded object and extract all of the data as reference arrays of scalars. The example below has OBJECT type embedded in a TABLE type embedded in an SQL TABLE; CREATE OR REPLACE TYPE GRADELIST AS TABLE OF NUMBER; CREATE OR REPLACE TYPE STUDENT AS OBJECT( NAME VARCHAR2(60), SOME_GRADES GRADELIST); CREATE OR REPLACE TYPE STUDENTS_T AS TABLE OF STUDENT; CREATE TABLE GROUPS( GRP_ID NUMBER(4), GRP_NAME VARCHAR2(10), STUDENTS STUDENTS_T) NESTED TABLE STUDENTS STORE AS GROUP_STUDENTS_TAB (NESTED TABLE SOME_GRADES STORE AS GROUP_STUDENT_GRADES_TAB); The following code will access all of the embedded data; $SQL='select grp_id,grp_name,students as my_students_test from groups'; $sth=$dbh->prepare($SQL); $sth->execute(); while (my ($grp_id,$grp_name,$students)=$sth->fetchrow()){ print "Group ID#".$grp_id." Group Name =".$grp_name."\n"; foreach my $student (@$students){ print "Name:".$student->[0]."\n"; print "Marks:"; foreach my $grades (@$student->[1]){ foreach my $marks (@$grades){ print $marks.","; } } print "\n"; } print "\n"; } Object example, given this object and table; CREATE OR REPLACE TYPE Person AS OBJECT ( name VARCHAR2(20), age INTEGER) ) NOT FINAL; CREATE TYPE Employee UNDER Person ( salary NUMERIC(8,2) ); CREATE TABLE people (id INTEGER, obj Person); INSERT INTO people VALUES (1, Person('Black', 25)); INSERT INTO people VALUES (2, Employee('Smith', 44, 5000)); The following code will access the data; $dbh{'ora_objects'} =>1; $sth = $dbh->prepare("select * from people order by id"); $sth->execute(); # object are fetched as instance of DBD::Oracle::Object my ($id1, $obj1) = $sth->fetchrow(); my ($id2, $obj2) = $sth->fetchrow(); # get full type-name of object print $obj1->type_name."44\n"; # 'TEST.PERSON' is printed print $obj2->type_name."4\n"; # 'TEST.EMPLOYEE' is printed # get attribute NAME from object print $obj1->attr('NAME')."3\n"; # 'Black' is printed print $obj2->attr('NAME')."3\n"; # 'Smith' is printed # get all atributes as hash reference my $h1 = $obj1->attr; # returns {'NAME' => 'Black', 'AGE' => 25} my $h2 = $obj2->attr; # returns {'NAME' => 'Smith', 'AGE' => 44, # 'SALARY' => 5000 } # get all attributes (names and values) as array my @a1 = $obj1->attributes; # returns ('NAME', 'Black', 'AGE', 25) my @a2 = $obj2->attributes; # returns ('NAME', 'Smith', 'AGE', 44, # 'SALARY', 5000 ) So far DBD::Oracle has been tested on a table with 20 embedded Objects, Varrays and Tables nested to 10 levels. Any NULL values found in the embedded object will be returned as 'undef'. # OTHER DATA TYPES DBD::Oracle does not _explicitly_ support most Oracle datatypes. It simply asks Oracle to return them as strings and Oracle does so. Mostly. Similarly when binding placeholder values DBD::Oracle binds them as strings and Oracle converts them to the appropriate type, such as DATE, when used. Some of these automatic conversions to and from strings use NLS settings to control the formatting for output and the parsing for input. The most common example is the DATE type. The default NLS format for DATE might be DD-MON-YYYY and so when a DATE type is fetched that's how Oracle will format the date. NLS settings also control the default parsing of strings into DATE values. An error will be generated if the contents of the string don't match the NLS format. If you're dealing in dates which don't match the default NLS format then you can either change the default NLS format or, more commonly, use TO\_CHAR(field, "format") and TO\_DATE(?, "format") to explicitly specify formats for converting to and from strings. A slightly more subtle problem can occur with NUMBER types. The default NLS settings might format numbers with a fullstop ("`.`") to separate thousands and a comma ("`,`") as the decimal point. Perl will generate warnings and use incorrect values when numbers, returned and formatted as strings in this way by Oracle, are used in a numeric context. You could explicitly convert each numeric value using the TO\_CHAR(...) function but that gets tedious very quickly. The best fix is to change the NLS settings. That can be done for an individual connection by doing: $dbh->do("ALTER SESSION SET NLS_NUMERIC_CHARACTERS = '.,'"); There are some types, like BOOLEAN, that Oracle does not automatically convert to or from strings (pity). These need to be converted explicitly using SQL or PL/SQL functions. Examples: # DATE values my $sth0 = $dbh->prepare( <= TO_DATE( ?, ? ) SQL_END $sth0->execute( 'YYYY-MM-DD HH24:MI:SS', "2003", 'YYYY' ); # BOOLEAN values my $sth2 = $dbh->prepare( <bind_param( ":i0", $i0 ); $sth2->bind_param( ":i1", $i1 ); $sth2->bind_param_inout( ":o0", \$o0, 32 ); $sth2->bind_param_inout( ":o1", \$o1, 32 ); $sth2->execute(); foreach ( $i0, $b0, $o0, $i1, $b1, $o1 ) { $_ = "(undef)" if ! defined $_; } print "$i0 to $o0, $i1 to $o1\n"; # Result is : "'' to '(undef)', 'Something else' to '1'" ## Support for Insert of XMLType (ORA\_XMLTYPE) Inserting large XML data sets into tables with XMLType fields is now supported by DBD::Oracle. The only special requirement is the use of bind\_param() with an attribute hash parameter that specifies ora\_type as ORA\_XMLTYPE. For example with a table like this; create table books (book_id number, book_xml XMLType); one can insert data using this code $SQL='insert into books values (1,:p_xml)'; $xml= ' Programming the Perl DBI The Cheetah Book T. Bunce Alligator Descartes ... '; my $sth =$dbh-> prepare($SQL); $sth-> bind_param("p_xml", $xml, { ora_type => ORA_XMLTYPE }); $sth-> execute(); In the above case we will assume that $xml has 10000 Book nodes and is over 32k in size and is well formed XML. This will also work for XML that is smaller than 32k as well. Attempting to insert malformed XML will cause an error. ## Binding Cursors Cursors can be returned from PL/SQL blocks, either from stored functions (or procedures with OUT parameters) or from direct `OPEN` statements, as shown below: use DBI; use DBD::Oracle qw(:ora_types); my $dbh = DBI->connect(...); my $sth1 = $dbh->prepare(q{ BEGIN OPEN :cursor FOR SELECT table_name, tablespace_name FROM user_tables WHERE tablespace_name = :space; END; }); $sth1->bind_param(":space", "USERS"); my $sth2; $sth1->bind_param_inout(":cursor", \$sth2, 0, { ora_type => ORA_RSET } ); $sth1->execute; # $sth2 is now a valid DBI statement handle for the cursor while ( my @row = $sth2->fetchrow_array ) { ... } The only special requirement is the use of `bind_param_inout()` with an attribute hash parameter that specifies `ora_type` as `ORA_RSET`. If you don't do that you'll get an error from the `execute()` like: "ORA-06550: line X, column Y: PLS-00306: wrong number or types of arguments in call to ...". Here's an alternative form using a function that returns a cursor. This example uses the pre-defined weak (or generic) REF CURSOR type SYS\_REFCURSOR. This is an Oracle 9 feature. # Create the function that returns a cursor $dbh->do(q{ CREATE OR REPLACE FUNCTION sp_ListEmp RETURN SYS_REFCURSOR AS l_cursor SYS_REFCURSOR; BEGIN OPEN l_cursor FOR select ename, empno from emp ORDER BY ename; RETURN l_cursor; END; }); # Use the function that returns a cursor my $sth1 = $dbh->prepare(q{BEGIN :cursor := sp_ListEmp; END;}); my $sth2; $sth1->bind_param_inout(":cursor", \$sth2, 0, { ora_type => ORA_RSET } ); $sth1->execute; # $sth2 is now a valid DBI statement handle for the cursor while ( my @row = $sth2->fetchrow_array ) { ... } A cursor obtained from PL/SQL as above may be passed back to PL/SQL by binding for input, as shown in this example, which explicitly closes a cursor: my $sth3 = $dbh->prepare("BEGIN CLOSE :cursor; END;"); $sth3->bind_param(":cursor", $sth2, { ora_type => ORA_RSET } ); $sth3->execute; It is not normally necessary to close a cursor explicitly in this way. Oracle will close the cursor automatically at the first client-server interaction after the cursor statement handle is destroyed. An explicit close may be desirable if the reference to the cursor handle from the PL/SQL statement handle delays the destruction of the cursor handle for too long. This reference remains until the PL/SQL handle is re-bound, re-executed or destroyed. NOTE: From DBD::Oracle 1.57 functions or procedures returning SYS\_REFCURSORs which have not been opened (are still in the initialised state) will return undef for the cursor statement handle e.g., in the example above if the sp\_ListEmp function simply returned l\_cursor instead of opening it. This means you can have a function/procedure which can elect to open the cursor or not, Before this change if you called a function/procedure which returned a SYS\_REFCURSOR which was not opened DBD::Oracle would error in the execute for a OCIAttrGet on the uninitialised cursor. See the `curref.pl` script in the Oracle.ex directory in the DBD::Oracle source distribution for a complete working example. ## Fetching Nested Cursors Oracle supports the use of select list expressions of type REF CURSOR. These may be explicit cursor expressions - `CURSOR(SELECT ...)`, or calls to PL/SQL functions which return REF CURSOR values. The values of these expressions are known as nested cursors. The value returned to a Perl program when a nested cursor is fetched is a statement handle. This statement handle is ready to be fetched from. It should not (indeed, must not) be executed. Oracle imposes a restriction on the order of fetching when nested cursors are used. Suppose `$sth1` is a handle for a select statement involving nested cursors, and `$sth2` is a nested cursor handle fetched from `$sth1`. `$sth2` can only be fetched from while `$sth1` is still active, and the row containing `$sth2` is still current in `$sth1`. Any attempt to fetch another row from `$sth1` renders all nested cursor handles previously fetched from `$sth1` defunct. Fetching from such a defunct handle results in an error with the message `ERROR nested cursor is defunct (parent row is no longer current)`. This means that the `fetchall...` or `selectall...` methods are not useful for queries returning nested cursors. By the time such a method returns, all the nested cursor handles it has fetched will be defunct. It is necessary to use an explicit fetch loop, and to do all the fetching of nested cursors within the loop, as the following example shows: use DBI; my $dbh = DBI->connect(...); my $sth = $dbh->prepare(q{ SELECT dname, CURSOR( SELECT ename FROM emp WHERE emp.deptno = dept.deptno ORDER BY ename ) FROM dept ORDER BY dname }); $sth->execute; while ( my ($dname, $nested) = $sth->fetchrow_array ) { print "$dname\n"; while ( my ($ename) = $nested->fetchrow_array ) { print " $ename\n"; } } The cursor returned by the function `sp_ListEmp` defined in the previous section can be fetched as a nested cursor as follows: my $sth = $dbh->prepare(q{SELECT sp_ListEmp FROM dual}); $sth->execute; my ($nested) = $sth->fetchrow_array; while ( my @row = $nested->fetchrow_array ) { ... } ## Pre-fetching Nested Cursors By default, DBD::Oracle pre-fetches rows in order to reduce the number of round trips to the server. For queries which do not involve nested cursors, the number of pre-fetched rows is controlled by the DBI database handle attribute `RowCacheSize` (q.v.). In Oracle, server side open cursors are a controlled resource, limited in number, on a per session basis, to the value of the initialization parameter `OPEN_CURSORS`. Nested cursors count towards this limit. Each nested cursor in the current row counts 1, as does each nested cursor in a pre-fetched row. Defunct nested cursors do not count. An Oracle specific database handle attribute, `ora_max_nested_cursors`, further controls pre-fetching for queries involving nested cursors. For each statement handle, the total number of nested cursors in pre-fetched rows is limited to the value of this parameter. The default value is 0, which disables pre-fetching for queries involving nested cursors. # PL/SQL Examples Most of these PL/SQL examples come from: Eric Bartley . /* * PL/SQL to create package with stored procedures invoked by * Perl examples. Execute using sqlplus. * * Use of "... OR REPLACE" prevents failure in the event that the * package already exists. */ CREATE OR REPLACE PACKAGE plsql_example IS PROCEDURE proc_np; PROCEDURE proc_in ( err_code IN NUMBER ); PROCEDURE proc_in_inout ( test_num IN NUMBER, is_odd IN OUT NUMBER ); FUNCTION func_np RETURN VARCHAR2; END plsql_example; / CREATE OR REPLACE PACKAGE BODY plsql_example IS PROCEDURE proc_np IS whoami VARCHAR2(20) := NULL; BEGIN SELECT USER INTO whoami FROM DUAL; END; PROCEDURE proc_in ( err_code IN NUMBER ) IS BEGIN RAISE_APPLICATION_ERROR(err_code, 'This is a test.'); END; PROCEDURE proc_in_inout ( test_num IN NUMBER, is_odd IN OUT NUMBER ) IS BEGIN is_odd := MOD(test_num, 2); END; FUNCTION func_np RETURN VARCHAR2 IS ret_val VARCHAR2(20); BEGIN SELECT USER INTO ret_val FROM DUAL; RETURN ret_val; END; END plsql_example; / /* End PL/SQL for example package creation. */ use DBI; my($db, $csr, $ret_val); $db = DBI->connect('dbi:Oracle:database','user','password') or die "Unable to connect: $DBI::errstr"; # So we don't have to check every DBI call we set RaiseError. # See the DBI docs now if you're not familiar with RaiseError. $db->{RaiseError} = 1; # Example 1 Eric Bartley # # Calling a PLSQL procedure that takes no parameters. This shows you the # basic's of what you need to execute a PLSQL procedure. Just wrap your # procedure call in a BEGIN END; block just like you'd do in SQL*Plus. # # p.s. If you've used SQL*Plus's exec command all it does is wrap the # command in a BEGIN END; block for you. $csr = $db->prepare(q{ BEGIN PLSQL_EXAMPLE.PROC_NP; END; }); $csr->execute; # Example 2 Eric Bartley # # Now we call a procedure that has 1 IN parameter. Here we use bind_param # to bind out parameter to the prepared statement just like you might # do for an INSERT, UPDATE, DELETE, or SELECT statement. # # I could have used positional placeholders (e.g. :1, :2, etc.) or # ODBC style placeholders (e.g. ?), but I prefer Oracle's named # placeholders (but few DBI drivers support them so they're not portable). my $err_code = -20001; $csr = $db->prepare(q{ BEGIN PLSQL_EXAMPLE.PROC_IN(:err_code); END; }); $csr->bind_param(":err_code", $err_code); # PROC_IN will RAISE_APPLICATION_ERROR which will cause the execute to 'fail'. # Because we set RaiseError, the DBI will croak (die) so we catch that with eval. eval { $csr->execute; }; print 'After proc_in: $@=',"'$@', errstr=$DBI::errstr, ret_val=$ret_val\n"; # Example 3 Eric Bartley # # Building on the last example, I've added 1 IN OUT parameter. We still # use a placeholders in the call to prepare, the difference is that # we now call bind_param_inout to bind the value to the place holder. # # Note that the third parameter to bind_param_inout is the maximum size # of the variable. You normally make this slightly larger than necessary. # But note that the Perl variable will have that much memory assigned to # it even if the actual value returned is shorter. my $test_num = 5; my $is_odd; $csr = $db->prepare(q{ BEGIN PLSQL_EXAMPLE.PROC_IN_INOUT(:test_num, :is_odd); END; }); # The value of $test_num is _copied_ here $csr->bind_param(":test_num", $test_num); $csr->bind_param_inout(":is_odd", \$is_odd, 1); # The execute will automagically update the value of $is_odd $csr->execute; print "$test_num is ", ($is_odd) ? "odd - ok" : "even - error!", "\n"; # Example 4 Eric Bartley # # What about the return value of a PLSQL function? Well treat it the same # as you would a call to a function from SQL*Plus. We add a placeholder # for the return value and bind it with a call to bind_param_inout so # we can access it's value after execute. my $whoami = ""; $csr = $db->prepare(q{ BEGIN :whoami := PLSQL_EXAMPLE.FUNC_NP; END; }); $csr->bind_param_inout(":whoami", \$whoami, 20); $csr->execute; print "Your database user name is $whoami\n"; $db->disconnect; You can find more examples in the t/plsql.t file in the DBD::Oracle source directory. Oracle 9.2 appears to have a bug where a variable bound with bind\_param\_inout() that isn't assigned to by the executed PL/SQL block may contain garbage. See [http://www.mail-archive.com/dbi-users@perl.org/msg18835.html](http://www.mail-archive.com/dbi-users@perl.org/msg18835.html) ## Avoid Using "SQL Call" Avoid using the "SQL Call" statement with DBD:Oracle as you might find that DBD::Oracle will not raise an exception in some case. Specifically if you use "SQL Call" to run a procedure all "No data found" exceptions will be quietly ignored and returned as null. According to Oracle support this is part of the same mechanism where; select (select * from dual where 0=1) from dual returns a null value rather than an exception. # CONTRIBUTING If you'd like DBD::Oracle to do something new or different the best way to make that happen is to do it yourself and email to dbi-dev@perl.org a patch of the source code (using 'diff' - see below) that shows the changes. ## How to create a patch using Subversion The DBD::Oracle source code is maintained using Subversion (a replacement for CVS, see [http://subversion.tigris.org/](http://subversion.tigris.org/)). To access the source you'll need to install a Subversion client. Then, to get the source code, do: svn checkout http://svn.perl.org/modules/dbd-oracle/trunk If it prompts for a username and password use your perl.org account if you have one, else just 'guest' and 'guest'. The source code will be in a new subdirectory called `trunk`. To keep informed about changes to the source you can send an empty email to dbd-oracle-changes-subscribe@perl.org after which you'll get an email with the change log message and diff of each change checked-in to the source. After making your changes you can generate a patch file, but before you do, make sure your source is still upto date using: svn update If you get any conflicts reported you'll need to fix them first. Then generate the patch file from within the `trunk` directory using: svn diff > foo.patch Read the patch file, as a sanity check, and then email it to dbi-dev@perl.org. ## How to create a patch without Subversion Unpack a fresh copy of the distribution: tar xfz DBD-Oracle-1.40.tar.gz Rename the newly created top level directory: mv DBD-Oracle-1.40 DBD-Oracle-1.40.your_foo Edit the contents of DBD-Oracle-1.40.your\_foo/\* till it does what you want. Test your changes and then remove all temporary files: make test && make distclean Go back to the directory you originally unpacked the distribution: cd .. Unpack _another_ copy of the original distribution you started with: tar xfz DBD-Oracle-1.40.tar.gz Then create a patch file by performing a recursive `diff` on the two top level directories: diff -r -u DBD-Oracle-1.40 DBD-Oracle-1.40.your_foo > DBD-Oracle-1.40.your_foo.patch ## Speak before you patch For anything non-trivial or possibly controversial it's a good idea to discuss (on dbi-dev@perl.org) the changes you propose before actually spending time working on them. Otherwise you run the risk of them being rejected because they don't fit into some larger plans you may not be aware of. ## GitHub repository A git mirror of the subversion is also available at \`https://github.com/yanick/DBD-Oracle\`. # WHICH VERSION OF DBD::ORACLE IS FOR ME? From version 1.25 onwards DBD::Oracle only support Oracle clients 9.2 or greater. Support for ProC connections was dropped in 1.29. If you are still stuck with an older version of Oracle or its client you might want to look at the table below. +---------------------+-----------------------------------------------------+ | | Oracle Version | +---------------------+----+-------------+---------+------+--------+--------+ | DBD::Oracle Version | <8 | 8.0.3~8.0.6 | 8iR1~R2 | 8iR3 | 9i | 9.2~11 | +---------------------+----+-------------+---------+------+--------+--------+ | 0.1~16 | Y | Y | Y | Y | Y | Y | +---------------------+----+-------------+---------+------+--------+--------+ | 1.17 | Y | Y | Y | Y | Y | Y | +---------------------+----+-------------+---------+------+--------+--------+ | 1.18 | N | N | N | Y | Y | Y | +---------------------+----+-------------+---------+------+--------+--------+ | 1.19 | N | N | N | Y | Y | Y | +---------------------+----+-------------+---------+------+--------+--------+ | 1.20 | N | N | N | Y | Y | Y | +---------------------+----+-------------+---------+------+--------+--------+ | 1.21~1.24 | N | N | N | N | Y | Y | +---------------------+----+-------------+---------+------+--------+--------+ | 1.25+ | N | N | N | N | N | Y | +---------------------+----+-------------+---------+------+--------+--------+ As there are dozens of different versions of Oracle's clients this list does not include all of them, just the major released versions of Oracle. Note that one can still connect to any Oracle version with the older DBD::Oracle versions the only problem you will have is that some of the newer OCI and Oracle features available in later DBD::Oracle releases will not be available to you. So to make a short story a little longer: 1. If you are using Oracle 7 or early 8 DB and you can manage to get a 9 client and you can use any DBD::Oracle version. 2. If you have to use an Oracle 7 client then DBD::Oracle 1.17 should work 3. Same thing for 8 up to R2, use 1.17, if you are lucky and have the right patch-set you might go with 1.18. 4. For 8iR3 you can use any of the DBD::Oracle versions up to 1.21. Again this depends on your patch-set, If you run into trouble go with 1.19 5. After 9.2 you can use any version you want. 6. It seems that the 10g client can only connect to 9 and 11 DBs while the 9 can go back to 7 and even get to 10. I am not sure what the 11g client can connect to. # BUGS AND LIMITATIONS There is a known problem with the 11.2g Oracle client and the `DBMS_LOB.GETLENGTH()` PL/SQL function. See [https://rt.cpan.org/Public/Bug/Display.html?id=69350](https://rt.cpan.org/Public/Bug/Display.html?id=69350) for the details. # SEE ALSO - [DBI](https://metacpan.org/pod/DBI) http://search.cpan.org/~timb/DBD-Oracle/MANIFEST for all files in the DBD::Oracle source distribution including the examples in the Oracle.ex directory - DBD::Oracle Tutorial http://www.pythian.com/blogs/wp-content/uploads/introduction-dbd-oracle.html - Oracle Instant Client http://www.oracle.com/technology/tech/oci/instantclient/index.html - Oracle on Linux http://www.ixora.com.au/ - Free Oracle Tools and Links ora\_explain supplied and installed with DBD::Oracle. http://www.orafaq.com/ http://vonnieda.org/oracletool/ - Commercial Oracle Tools and Links Assorted tools and references for general information. No recommendation implied. http://www.platinum.com http://www.SoftTreeTech.com Also PL/Vision from RevealNet and Steven Feuerstein, and "Q" from Savant Corporation. # AUTHORS DBI by Tim Bunce [http://www.tim.bunce.name](http://www.tim.bunce.name). The original `DBD::Oracle` was by Tim Bunce. Maintained as of release 1.17 (February 2006) by John Scoles, then Yanick Champoux, under the auspice of the Pythian Group ([http://www.pythian.com](http://www.pythian.com)). # ACKNOWLEDGEMENTS A great many people have helped with DBD::Oracle over the 17 years between 1994 and 2011. Far too many to name, but we thank them all. Many are named in the Changes file. # COPYRIGHT The DBD::Oracle module is Copyright (c) 1994-2006 Tim Bunce. Ireland. The DBD::Oracle module is Copyright (c) 2006-2011 John Scoles (The Pythian Group). Canada. The DBD::Oracle module is Copyright (c) 2011 John Scoles. Canada. The DBD::Oracle module is free open source software; you can redistribute it and/or modify it under the same terms as Perl 5. # AUTHORS - Tim Bunce - John Scoles - Yanick Champoux - Martin J. Evans # COPYRIGHT AND LICENSE This software is copyright (c) 1994 by Tim Bunce. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. DBD-Oracle-1.74/CONTRIBUTING.mkd0000644000175000017500000000610112326332111015153 0ustar yanickyanick# CONTRIBUTING Thank you for considering contributing to DBD-Oracle. This file contains instructions that will help you work with the source code. ## Repository branches structure The two main branches of this repository are: * **master** The main development branch. This branch has to be processed by Dist::Zilla to generate the code as it will appear in the CPAN distribution. See the next section for more details. * **releases** Contains the code as it appears on CPAN. Each official release is also tagged with its version. ## Working on the master branch The distribution is managed with [Dist::Zilla][distzilla]. This means than many of the usual files you might expect are not in the repository, but are generated at release time. However, you can run tests directly using the 'prove' tool: ``` bash $ prove -l $ prove -lv t/some_test_file.t $ prove -lvr t/ ``` In most cases, 'prove' is entirely sufficent for you to test any patches you have. You may need to satisfy some dependencies. The easiest way to satisfy dependencies is to install the last release -- this is available at https://metacpan.org/release/DBD-Oracle. If you use cpanminus, you can do it without downloading the tarball first: ``` bash $ cpanm --reinstall --installdeps --with-recommends DBD::Oracle ``` Dist::Zilla is a very powerful authoring tool, but requires a number of author-specific plugins. If you would like to use it for contributing, install it from CPAN, then run one of the following commands, depending on your CPAN client: ``` bash $ cpan `dzil authordeps --missing` $ dzil authordeps --missing | cpanm ``` You should then also install any additional requirements not needed by the dzil build but may be needed by tests or other development: ``` bash # cpan `dzil listdeps --author --missing` $ dzil listdeps --author --missing | cpanm ``` You can also do this via cpanm directly: ``` bash $ cpanm --reinstall --installdeps --with-develop --with-recommends DBD::Oracle ``` Once installed, here are some dzil commands you might try: ``` bash $ dzil build $ dzil test $ dzil test --release $ dzil xtest $ dzil listdeps --json $ dzil build --notgz ``` ## This Is Complicated. Is There an Easier Way? Actually, yes there is. You can also work directly on the `releases` branch, which corresponds to the code is generated by Dist::Zilla and correspond to what is uploaded to CPAN. It won't contain any of the changes brought to the codebase since the last CPAN release, but for a small patch that shouldn't be a problem. ## Sending Patches The code for this distribution is hosted on [GitHub][repository]. You can submit bug reports via the [repository's issue track][bugtracker]. You can also submit code changes by forking the repository, pushing your code changes to your clone, and then submitting a pull request. Detailed instructions for doing that is available here: * https://help.github.com/ * https://help.github.com/articles/creating-a-pull-request [distzilla]: http://dzil.org/. [repository]: https://github.com/pythian/DBD-Oracle/ [bugtracker]: https://github.com/pythian/DBD-Oracle/issues DBD-Oracle-1.74/INSTALL0000644000175000017500000000165412326332111013610 0ustar yanickyanick This is the Perl distribution DBD-Oracle. Installing DBD-Oracle is straightforward. ## Installation with cpanm If you have cpanm, you only need one line: % cpanm DBD::Oracle If you are installing into a system-wide directory, you may need to pass the "-S" flag to cpanm, which uses sudo to install the module: % cpanm -S DBD::Oracle ## Installing with the CPAN shell Alternatively, if your CPAN shell is set up, you should just be able to do: % cpan DBD::Oracle ## Manual installation As a last resort, you can manually install it. Download the tarball, untar it, then build it: % perl Makefile.PL % make && make test Then install it: % make install If you are installing into a system-wide directory, you may need to run: % sudo make install ## Documentation DBD-Oracle documentation is available as POD. You can run perldoc from a shell to read the documentation: % perldoc DBD::Oracle DBD-Oracle-1.74/Oracle.xs0000644000175000017500000004516712326332111014347 0ustar yanickyanick#include "Oracle.h" #define BIND_PARAM_INOUT_ALLOW_ARRAY DBISTATE_DECLARE; MODULE = DBD::Oracle PACKAGE = DBD::Oracle I32 constant(name=Nullch) char *name ALIAS: ORA_VARCHAR2 = ORA_VARCHAR2 ORA_NUMBER = ORA_NUMBER ORA_STRING = ORA_STRING ORA_LONG = ORA_LONG ORA_ROWID = ORA_ROWID ORA_DATE = ORA_DATE ORA_RAW = ORA_RAW ORA_LONGRAW = ORA_LONGRAW ORA_CHAR = ORA_CHAR ORA_CHARZ = ORA_CHARZ ORA_MLSLABEL = 105 ORA_XMLTYPE = ORA_XMLTYPE ORA_CLOB = ORA_CLOB ORA_BLOB = ORA_BLOB ORA_RSET = ORA_RSET ORA_VARCHAR2_TABLE = ORA_VARCHAR2_TABLE ORA_NUMBER_TABLE = ORA_NUMBER_TABLE ORA_SYSDBA = 0x0002 ORA_SYSOPER = 0x0004 ORA_SYSASM = 0x8000 ORA_SYSBACKUP = 0x00020000 ORA_SYSDG = 0x00040000 ORA_SYSKM = 0x00080000 SQLCS_IMPLICIT = SQLCS_IMPLICIT SQLCS_NCHAR = SQLCS_NCHAR SQLT_INT = SQLT_INT SQLT_FLT = SQLT_FLT OCI_BATCH_MODE = 0x01 OCI_EXACT_FETCH = 0x02 OCI_KEEP_FETCH_STATE = 0x04 OCI_DESCRIBE_ONLY = 0x10 OCI_COMMIT_ON_SUCCESS = 0x20 OCI_NON_BLOCKING = 0x40 OCI_BATCH_ERRORS = 0x80 OCI_PARSE_ONLY = 0x100 OCI_SHOW_DML_WARNINGS = 0x400 OCI_FETCH_CURRENT = OCI_FETCH_CURRENT OCI_FETCH_NEXT = OCI_FETCH_NEXT OCI_FETCH_FIRST = OCI_FETCH_FIRST OCI_FETCH_LAST = OCI_FETCH_LAST OCI_FETCH_PRIOR = OCI_FETCH_PRIOR OCI_FETCH_ABSOLUTE = OCI_FETCH_ABSOLUTE OCI_FETCH_RELATIVE = OCI_FETCH_RELATIVE OCI_FO_END = OCI_FO_END OCI_FO_ABORT = OCI_FO_ABORT OCI_FO_REAUTH = OCI_FO_REAUTH OCI_FO_BEGIN = OCI_FO_BEGIN OCI_FO_ERROR = OCI_FO_ERROR OCI_FO_NONE = OCI_FO_NONE OCI_FO_SESSION = OCI_FO_SESSION OCI_FO_SELECT = OCI_FO_SELECT OCI_FO_TXNAL = OCI_FO_TXNAL OCI_FO_RETRY = OCI_FO_RETRY OCI_STMT_SCROLLABLE_READONLY = 0x08 OCI_PRELIM_AUTH = 0x00000008 OCI_DBSTARTUPFLAG_FORCE = 0x00000001 OCI_DBSTARTUPFLAG_RESTRICT = 0x00000002 OCI_DBSHUTDOWN_TRANSACTIONAL = 1 OCI_DBSHUTDOWN_TRANSACTIONAL_LOCAL = 2 OCI_DBSHUTDOWN_IMMEDIATE = 3 OCI_DBSHUTDOWN_ABORT = 4 OCI_DBSHUTDOWN_FINAL = 5 SQLT_CHR = SQLT_CHR SQLT_BIN = SQLT_BIN CODE: if (!ix) { if (!name) name = GvNAME(CvGV(cv)); croak("Unknown DBD::Oracle constant '%s'", name); } else RETVAL = ix; OUTPUT: RETVAL void ORA_OCI() CODE: SV *sv = sv_newmortal(); sv_setnv(sv, atof(ORA_OCI_VERSION)); /* 9.1! see docs */ sv_setpv(sv, ORA_OCI_VERSION); /* 9.10.11.12 */ SvNOK_on(sv); /* dualvar hack */ ST(0) = sv; void ora_env_var(name) char *name CODE: char buf[1024]; char *p = ora_env_var(name, buf, sizeof(buf)-1); SV *sv = sv_newmortal(); if (p) sv_setpv(sv, p); ST(0) = sv; #if defined(__CYGWIN32__) || defined(__CYGWIN64__) void ora_cygwin_set_env(name, value) char * name char * value CODE: ora_cygwin_set_env(name, value); #endif /* __CYGWIN32__ */ INCLUDE: Oracle.xsi MODULE = DBD::Oracle PACKAGE = DBD::Oracle::st void ora_stmt_type(sth) SV * sth PREINIT: D_imp_sth(sth); CODE: { XSRETURN_IV( imp_sth->stmt_type); } void ora_stmt_type_name(sth) SV * sth PREINIT: D_imp_sth(sth); CODE: char *p = oci_stmt_type_name(imp_sth->stmt_type); SV *sv = sv_newmortal(); if (p) sv_setpv(sv, p); ST(0) = sv; void ora_scroll_position(sth) SV * sth PREINIT: D_imp_sth(sth); CODE: { XSRETURN_IV( imp_sth->fetch_position); } void ora_fetch_scroll(sth,fetch_orient,fetch_offset) SV * sth IV fetch_orient IV fetch_offset PREINIT: D_imp_sth(sth); CODE: { AV *av; imp_sth->fetch_orient=fetch_orient; imp_sth->fetch_offset=fetch_offset; av = dbd_st_fetch(sth,imp_sth); imp_sth->fetch_offset = 1; /* default back to 1 for fetch */ imp_sth->fetch_orient=OCI_FETCH_NEXT; /* default back to fetch next */ ST(0) = (av) ? sv_2mortal(newRV((SV *)av)) : &PL_sv_undef; } void ora_bind_param_inout_array(sth, param, av_ref, maxlen, attribs) SV * sth SV * param SV * av_ref IV maxlen SV * attribs CODE: { IV sql_type = 0; D_imp_sth(sth); SV *av_value; if (!SvROK(av_ref) || SvTYPE(SvRV(av_ref)) != SVt_PVAV) croak("bind_param_inout_array needs a reference to a array value"); av_value = av_ref; if (SvREADONLY(av_value)) croak("Modification of a read-only value attempted"); if (attribs) { if (SvNIOK(attribs)) { sql_type = SvIV(attribs); attribs = Nullsv; } else { SV **svp; DBD_ATTRIBS_CHECK("bind_param", sth, attribs); DBD_ATTRIB_GET_IV(attribs, "ora_type",4, svp, sql_type); } } ST(0) = dbd_bind_ph(sth, imp_sth, param,av_value, sql_type, attribs, TRUE, maxlen) ? &PL_sv_yes : &PL_sv_no; } void ora_fetch(sth) SV * sth PPCODE: /* fetchrow: but with scalar fetch returning NUM_FIELDS for Oraperl */ /* This code is called _directly_ by Oraperl.pm bypassing the DBI. */ /* as a result we have to do some things ourselves (like calling */ /* CLEAR_ERROR) and we loose the tracing that the DBI offers :-( */ D_imp_sth(sth); AV *av; int debug = DBIc_DEBUGIV(imp_sth); if (DBIS->debug > debug) debug = DBIS->debug; DBIh_CLEAR_ERROR(imp_sth); if (GIMME == G_SCALAR) { /* XXX Oraperl */ /* This non-standard behaviour added only to increase the */ /* performance of the oraperl emulation layer (Oraperl.pm) */ if (!imp_sth->done_desc && !dbd_describe(sth, imp_sth)) XSRETURN_UNDEF; XSRETURN_IV(DBIc_NUM_FIELDS(imp_sth)); } if (debug >= 2) PerlIO_printf(DBILOGFP, " -> ora_fetch\n"); av = dbd_st_fetch(sth, imp_sth); if (av) { int num_fields = AvFILL(av)+1; int i; EXTEND(sp, num_fields); for(i=0; i < num_fields; ++i) { PUSHs(AvARRAY(av)[i]); } if (debug >= 2) PerlIO_printf(DBILOGFP, " <- (...) [%d items]\n", num_fields); } else { if (debug >= 2) PerlIO_printf(DBILOGFP, " <- () [0 items]\n"); } if (debug >= 2 && SvTRUE(DBIc_ERR(imp_sth))) PerlIO_printf(DBILOGFP, " !! ERROR: %s %s", neatsvpv(DBIc_ERR(imp_sth),0), neatsvpv(DBIc_ERRSTR(imp_sth),0)); void ora_execute_array(sth, tuples, exe_count, tuples_status, err_count, cols=&PL_sv_undef) SV * sth SV * tuples IV exe_count SV * tuples_status SV * cols SV * err_count PREINIT: D_imp_sth(sth); int retval; CODE: /* XXX Need default bindings if any phs are so far unbound(?) */ /* XXX this code is duplicated in selectrow_arrayref above */ if (DBIc_ROW_COUNT(imp_sth) > 0) /* reset for re-execute */ DBIc_ROW_COUNT(imp_sth) = 0; retval = ora_st_execute_array(sth, imp_sth, tuples, tuples_status, cols, (ub4)exe_count,err_count); /* XXX Handle return value ... like DBI::execute_array(). */ /* remember that dbd_st_execute must return <= -2 for error */ if (retval == 0) /* ok with no rows affected */ XST_mPV(0, "0E0"); /* (true but zero) */ else if (retval < -1) /* -1 == unknown number of rows */ XST_mUNDEF(0); /* <= -2 means error */ else XST_mIV(0, retval); /* typically 1, rowcount or -1 */ void cancel(sth) SV * sth CODE: D_imp_sth(sth); ST(0) = dbd_st_cancel(sth, imp_sth) ? &PL_sv_yes : &PL_sv_no; MODULE = DBD::Oracle PACKAGE = DBD::Oracle::db void ora_db_startup(dbh, attribs) SV *dbh SV *attribs PREINIT: D_imp_dbh(dbh); sword status; #if defined(ORA_OCI_102) ub4 mode; ub4 flags; OCIAdmin *admhp; STRLEN svp_len; text *str; #endif CODE: #if defined(ORA_OCI_102) SV **svp; mode = OCI_DEFAULT; DBD_ATTRIB_GET_IV(attribs, "ora_mode", 8, svp, mode); flags = OCI_DEFAULT; DBD_ATTRIB_GET_IV(attribs, "ora_flags", 9, svp, flags); admhp = (OCIAdmin*)0; if ((svp=DBD_ATTRIB_GET_SVP(attribs, "ora_pfile", 9)) && SvOK(*svp)) { if (!SvPOK(*svp)) croak("ora_pfile is not a string"); str = (text*)SvPV(*svp, svp_len); OCIHandleAlloc(imp_dbh->envhp, (dvoid**)&admhp, (ub4)OCI_HTYPE_ADMIN, (size_t)0, (dvoid**)0); OCIAttrSet_log_stat(imp_dbh, (dvoid*)admhp, (ub4)OCI_HTYPE_ADMIN, (dvoid*)str, (ub4)svp_len, (ub4)OCI_ATTR_ADMIN_PFILE, (OCIError*)imp_dbh->errhp, status); } OCIDBStartup_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, admhp, mode, flags, status); if (status != OCI_SUCCESS) { oci_error(dbh, imp_dbh->errhp, status, "OCIDBStartup"); ST(0) = &PL_sv_undef; } else { ST(0) = &PL_sv_yes; } if (admhp) OCIHandleFree_log_stat(imp_dbh, (dvoid*)admhp, (ub4)OCI_HTYPE_ADMIN, status); #else croak("OCIDBStartup not available"); #endif void ora_db_shutdown(dbh, attribs) SV *dbh SV *attribs PREINIT: D_imp_dbh(dbh); sword status; #if defined(ORA_OCI_102) ub4 mode; OCIAdmin *admhp; #endif CODE: #if defined(ORA_OCI_102) SV **svp; mode = OCI_DEFAULT; DBD_ATTRIB_GET_IV(attribs, "ora_mode", 8, svp, mode); admhp = (OCIAdmin*)0; OCIDBShutdown_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, admhp, mode, status); if (status != OCI_SUCCESS) { oci_error(dbh, imp_dbh->errhp, status, "OCIDBShutdown"); ST(0) = &PL_sv_undef; } else { ST(0) = &PL_sv_yes; } #else croak("OCIDBShutdown not available"); #endif void ora_can_taf(dbh) SV *dbh PREINIT: D_imp_dbh(dbh); sword status; ub4 can_taf = 0; CODE: #ifdef OCI_ATTR_TAF_ENABLED OCIAttrGet_log_stat(imp_dbh, imp_dbh->srvhp, OCI_HTYPE_SERVER, &can_taf, NULL, OCI_ATTR_TAF_ENABLED, imp_dbh->errhp, status); if (status != OCI_SUCCESS) { # else if ( 1 ) { # endif oci_error(dbh, imp_dbh->errhp, status, "OCIAttrGet OCI_ATTR_TAF_ENABLED"); XSRETURN_IV(0); } else { XSRETURN_IV(can_taf); } void ora_ping(dbh) SV *dbh PREINIT: D_imp_dbh(dbh); sword status; #if defined(ORA_OCI_102) ub4 vernum; #endif text buf[2]; CODE: /*when OCIPing not available,*/ /*simply does a call to OCIServerVersion which should make 1 round trip*/ /*later I will replace this with the actual OCIPing command*/ /*This will work if the DB goes down, */ /*If the listener goes down it is another case as the Listener is needed to establish the connection not maintain it*/ /*so we should stay connected but we cannot get nay new connections*/ { /* RT 69059 - despite OCIPing being introduced in 10.2 * it is not available in all versions of 10.2 for AIX * e.g., 10.2.0.4 does not have it and 10.2.0.5 does * see http://comments.gmane.org/gmane.comp.lang.perl.modules.dbi.general/16206 * We don't do versions to that accuracy so for AIX you have * to wait until 11.2 for OCIPing. * * Further comments on dbi-dev * "DBD::Oracle RTs a summary and request for help" suggested it * was Oracle bug 5759845 and fixes in 10.2.0.2. */ #if !defined(ORA_OCI_102) || (defined(_AIX) && !defined(ORA_OCI_112)) OCIServerVersion_log_stat(imp_dbh, imp_dbh->svchp,imp_dbh->errhp,buf,2,OCI_HTYPE_SVCCTX,status); #else vernum = ora_db_version(dbh,imp_dbh); /* OCIPing causes server failures if called against server ver < 10.2 */ if (((int)((vernum>>24) & 0xFF) < 10 ) || (((int)((vernum>>24) & 0xFF) == 10 ) && ((int)((vernum>>20) & 0x0F) < 2 ))){ OCIServerVersion_log_stat(imp_dbh, imp_dbh->svchp,imp_dbh->errhp,buf,2,OCI_HTYPE_SVCCTX,status); } else { OCIPing_log_stat(imp_dbh, imp_dbh->svchp,imp_dbh->errhp,status); } #endif if (status != OCI_SUCCESS){ XSRETURN_IV(0); } else { XSRETURN_IV(1); } } void reauthenticate(dbh, uid, pwd) SV * dbh char * uid char * pwd CODE: D_imp_dbh(dbh); ST(0) = ora_db_reauthenticate(dbh, imp_dbh, uid, pwd) ? &PL_sv_yes : &PL_sv_no; void ora_lob_write(dbh, locator, offset, data) SV *dbh OCILobLocator *locator UV offset SV *data PREINIT: D_imp_dbh(dbh); ub4 amtp; STRLEN data_len; /* bytes not chars */ dvoid *bufp; sword status; ub2 csid; ub1 csform; CODE: csid = 0; csform = SQLCS_IMPLICIT; bufp = SvPV(data, data_len); amtp = data_len; /* if locator is CLOB and data is UTF8 and not in bytes pragma */ /* if (0 && SvUTF8(data) && !IN_BYTES) { amtp = sv_len_utf8(data); } */ /* added by lab: */ /* LAB do something about length here? see above comment */ OCILobCharSetForm_log_stat(imp_dbh, imp_dbh->envhp, imp_dbh->errhp, locator, &csform, status ); if (status != OCI_SUCCESS) { oci_error(dbh, imp_dbh->errhp, status, "OCILobCharSetForm"); ST(0) = &PL_sv_undef; return; } #ifdef OCI_ATTR_CHARSET_ID /* Effectively only used so AL32UTF8 works properly */ OCILobCharSetId_log_stat(imp_dbh, imp_dbh->envhp, imp_dbh->errhp, locator, &csid, status ); if (status != OCI_SUCCESS) { oci_error(dbh, imp_dbh->errhp, status, "OCILobCharSetId"); ST(0) = &PL_sv_undef; return; } #endif /* OCI_ATTR_CHARSET_ID */ /* if data is utf8 but charset isn't then switch to utf8 csid */ csid = (SvUTF8(data) && !CS_IS_UTF8(csid)) ? utf8_csid : CSFORM_IMPLIED_CSID(csform); OCILobWrite_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, locator, &amtp, (ub4)offset, bufp, (ub4)data_len, OCI_ONE_PIECE, NULL, NULL, (ub2)0, csform , status); if (status != OCI_SUCCESS) { oci_error(dbh, imp_dbh->errhp, status, "OCILobWrite"); ST(0) = &PL_sv_undef; } else { ST(0) = &PL_sv_yes; } void ora_lob_append(dbh, locator, data) SV *dbh OCILobLocator *locator SV *data PREINIT: D_imp_dbh(dbh); ub4 amtp; STRLEN data_len; /* bytes not chars */ dvoid *bufp; sword status; #if !defined(OCI_HTYPE_DIRPATH_FN_CTX) /* Oracle is < 9.0 */ ub4 startp; #endif ub1 csform; ub2 csid; CODE: csid = 0; csform = SQLCS_IMPLICIT; bufp = SvPV(data, data_len); amtp = data_len; /* if locator is CLOB and data is UTF8 and not in bytes pragma */ /* if (1 && SvUTF8(data) && !IN_BYTES) */ /* added by lab: */ /* LAB do something about length here? see above comment */ OCILobCharSetForm_log_stat(imp_dbh, imp_dbh->envhp, imp_dbh->errhp, locator, &csform, status ); if (status != OCI_SUCCESS) { oci_error(dbh, imp_dbh->errhp, status, "OCILobCharSetForm"); ST(0) = &PL_sv_undef; return; } #ifdef OCI_ATTR_CHARSET_ID /* Effectively only used so AL32UTF8 works properly */ OCILobCharSetId_log_stat(imp_dbh, imp_dbh->envhp, imp_dbh->errhp, locator, &csid, status ); if (status != OCI_SUCCESS) { oci_error(dbh, imp_dbh->errhp, status, "OCILobCharSetId"); ST(0) = &PL_sv_undef; return; } #endif /* OCI_ATTR_CHARSET_ID */ /* if data is utf8 but charset isn't then switch to utf8 csid */ csid = (SvUTF8(data) && !CS_IS_UTF8(csid)) ? utf8_csid : CSFORM_IMPLIED_CSID(csform); OCILobWriteAppend_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, locator, &amtp, bufp, (ub4)data_len, OCI_ONE_PIECE, NULL, NULL, csid, csform, status); if (status != OCI_SUCCESS) { oci_error(dbh, imp_dbh->errhp, status, "OCILobWriteAppend"); ST(0) = &PL_sv_undef; } else { ST(0) = &PL_sv_yes; } void ora_lob_read(dbh, locator, offset, length) SV *dbh OCILobLocator *locator UV offset UV length PREINIT: D_imp_dbh(dbh); ub4 amtp; STRLEN bufp_len; SV *dest_sv; dvoid *bufp; sword status; ub1 csform; CODE: csform = SQLCS_IMPLICIT; /* NOTE, if length is 0 this will create an empty SV of undef see RT55028 */ dest_sv = sv_2mortal(newSV(length*4)); /*LAB: crude hack that works... tim did it else where XXX */ if (length > 0) { SvPOK_on(dest_sv); bufp_len = SvLEN(dest_sv); /* XXX bytes not chars? (lab: yes) */ bufp = SvPVX(dest_sv); amtp = length; /* if utf8 and clob/nclob: in: chars, out: bytes */ /* http://www.lc.leidenuniv.nl/awcourse/oracle/appdev.920/a96584/oci16m40.htm#427818 */ /* if locator is CLOB and data is UTF8 and not in bytes pragma */ /* if (0 && SvUTF8(dest_sv) && !IN_BYTES) { amtp = sv_len_utf8(dest_sv); } */ /* added by lab: */ OCILobCharSetForm_log_stat(imp_dbh, imp_dbh->envhp, imp_dbh->errhp, locator, &csform, status ); if (status != OCI_SUCCESS) { oci_error(dbh, imp_dbh->errhp, status, "OCILobCharSetForm"); dest_sv = &PL_sv_undef; return; } { /* see rt 75163 */ boolean is_open; OCILobFileIsOpen_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, locator, &is_open, status); if (status == OCI_SUCCESS && !is_open) { OCILobFileOpen_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, locator, (ub1)OCI_FILE_READONLY, status); if (status != OCI_SUCCESS) { oci_error(dbh, imp_dbh->errhp, status, "OCILobFileOpen"); dest_sv = &PL_sv_undef; } } } OCILobRead_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, locator, &amtp, (ub4)offset, /* offset starts at 1 */ bufp, (ub4)bufp_len, 0, 0, (ub2)0, csform, status); if (status != OCI_SUCCESS) { oci_error(dbh, imp_dbh->errhp, status, "OCILobRead"); dest_sv = &PL_sv_undef; } else { SvCUR(dest_sv) = amtp; /* always bytes here */ *SvEND(dest_sv) = '\0'; if (csform){ if (CSFORM_IMPLIES_UTF8(csform)){ SvUTF8_on(dest_sv); } } } } /* length > 0 */ ST(0) = dest_sv; void ora_lob_trim(dbh, locator, length) SV *dbh OCILobLocator *locator UV length PREINIT: D_imp_dbh(dbh); sword status; CODE: OCILobTrim_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, locator, length, status); if (status != OCI_SUCCESS) { oci_error(dbh, imp_dbh->errhp, status, "OCILobTrim"); ST(0) = &PL_sv_undef; } else { ST(0) = &PL_sv_yes; } void ora_lob_is_init(dbh, locator) SV *dbh OCILobLocator *locator PREINIT: D_imp_dbh(dbh); sword status; boolean is_init = 0; CODE: OCILobLocatorIsInit_log_stat(imp_dbh, imp_dbh->envhp,imp_dbh->errhp,locator,&is_init,status); if (status != OCI_SUCCESS) { oci_error(dbh, imp_dbh->errhp, status, "OCILobLocatorIsInit ora_lob_is_init"); ST(0) = &PL_sv_undef; } else { ST(0) = sv_2mortal(newSVuv(is_init)); } void ora_lob_length(dbh, locator) SV *dbh OCILobLocator *locator PREINIT: D_imp_dbh(dbh); sword status; ub4 len = 0; CODE: OCILobGetLength_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, locator, &len, status); if (status != OCI_SUCCESS) { oci_error(dbh, imp_dbh->errhp, status, "OCILobGetLength ora_lob_length"); ST(0) = &PL_sv_undef; } else { ST(0) = sv_2mortal(newSVuv(len)); } void ora_lob_chunk_size(dbh, locator) SV *dbh OCILobLocator *locator PREINIT: D_imp_dbh(dbh); sword status; ub4 chunk_size = 0; CODE: OCILobGetChunkSize_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, locator, &chunk_size, status); if (status != OCI_SUCCESS) { oci_error(dbh, imp_dbh->errhp, status, "OCILobGetChunkSize"); ST(0) = &PL_sv_undef; } else { ST(0) = sv_2mortal(newSVuv(chunk_size)); } MODULE = DBD::Oracle PACKAGE = DBD::Oracle::dr void init_oci(drh) SV * drh CODE: D_imp_drh(drh); dbd_init_oci(DBIS) ; dbd_init_oci_drh(imp_drh) ; DBD-Oracle-1.74/CONTRIBUTORS0000644000175000017500000000146712326332111014441 0ustar yanickyanick # DBD-ORACLE CONTRIBUTORS # This is the (likely incomplete) list of people who have helped make this distribution what it is, either via code contributions, patches, bug reports, help with troubleshooting, etc. A huge thank to all of them. * David E. Wheeler * David Perry * David Steinbrunner * Gwen Shapira * Joe Crotty * Michael Portnoy * StephenCIQG * cjardine * gregor herrmann * jurl * lbaxter * robert DBD-Oracle-1.74/META.json0000644000175000017500000000565412326332111014204 0ustar yanickyanick{ "abstract" : "Oracle database driver for the DBI module", "author" : [ "Tim Bunce ", "John Scoles ", "Yanick Champoux ", "Martin J. Evans " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 5.014, CPAN::Meta::Converter version 2.140640", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "DBD-Oracle", "prereqs" : { "configure" : { "requires" : { "DBI" : "1.51", "ExtUtils::MakeMaker" : "6.30" } }, "develop" : { "requires" : { "version" : "0.9901" } }, "runtime" : { "requires" : { "DBI" : "0", "DynaLoader" : "0", "Exporter" : "0", "perl" : "5.006", "strict" : "0", "warnings" : "0" } }, "test" : { "requires" : { "B" : "0", "Carp" : "0", "Data::Dumper" : "0", "Devel::Peek" : "0", "Encode" : "0", "Math::BigInt" : "0", "Test::More" : "0.88", "Thread::Semaphore" : "0", "lib" : "0", "utf8" : "0", "vars" : "0" } } }, "provides" : { "DBD::Oracle" : { "file" : "lib/DBD/Oracle.pm", "version" : "1.74" }, "DBD::Oracle::GetInfo" : { "file" : "lib/DBD/Oracle/GetInfo.pm", "version" : "1.74" }, "DBD::Oracle::Object" : { "file" : "lib/DBD/Oracle/Object.pm", "version" : "1.74" } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/pythian/DBD-Oracle/issues" }, "homepage" : "http://search.cpan.org/dist/DBD-Oracle/", "repository" : { "type" : "git", "url" : "https://github.com/pythian/DBD-Oracle.git", "web" : "https://github.com/pythian/DBD-Oracle" } }, "version" : "1.74", "x_authority" : "cpan:PYTHIAN", "x_contributors" : [ "David E. Wheeler ", "David Perry ", "David Steinbrunner ", "Gwen Shapira ", "Joe Crotty ", "Michael Portnoy ", "StephenCIQG ", "cjardine ", "gregor herrmann ", "jurl ", "lbaxter ", "robert " ], "x_help_wanted" : [ "developer", "documenter", "tester" ] } DBD-Oracle-1.74/oci8.c0000644000175000017500000052735012326332111013573 0ustar yanickyanick/* vim:sw=4:ts=8 oci8.c Copyright (c) 1998-2006 Tim Bunce Ireland Copyright (c) 2006-2008 John Scoles (The Pythian Group), Canada See the COPYRIGHT section in the Oracle.pm file for terms. */ #include "Oracle.h" #ifdef UTF8_SUPPORT #include #endif #define sv_set_undef(sv) if (SvROK(sv)) sv_unref(sv); else SvOK_off(sv) DBISTATE_DECLARE; int describe_obj_by_tdo(SV *sth,imp_sth_t *imp_sth,fbh_obj_t *obj,ub2 level ); int dump_struct(imp_sth_t *imp_sth,fbh_obj_t *obj,int level); /* char * dbd_yes_no(int yes_no) { dTHX; if (yes_no) { return "Yes"; } return "No"; } */ void dbd_init_oci(dbistate_t *dbistate) { dTHX; DBIS = dbistate; } void dbd_init_oci_drh(imp_drh_t * imp_drh) { dTHX; imp_drh->ora_long = perl_get_sv("Oraperl::ora_long", GV_ADDMULTI); imp_drh->ora_trunc = perl_get_sv("Oraperl::ora_trunc", GV_ADDMULTI); imp_drh->ora_cache = perl_get_sv("Oraperl::ora_cache", GV_ADDMULTI); imp_drh->ora_cache_o = perl_get_sv("Oraperl::ora_cache_o", GV_ADDMULTI); } /* char * oci_sql_function_code_name(int sqlfncode) { dTHX; SV *sv; switch (sqlfncode) { case 1 : return "CREATE TABLE"; case 3 : return "INSERT"; case 4 : return "SELECT"; case 5 : return "UPDATE"; case 8 : return "DROP TABLE"; case 9 : return "DELETE"; } sv = sv_2mortal(newSVpv("",0)); sv_grow(sv, 50); sprintf(SvPVX(sv),"(UNKNOWN SQL FN Code %d)", sqlfncode); return SvPVX(sv); } */ /* char * oci_ptype_name(int ptype) { dTHX; SV *sv; switch (ptype) { case OCI_PTYPE_UNK: return "UNKNOWN"; case OCI_PTYPE_TABLE: return "TABLE"; case OCI_PTYPE_VIEW: return "VIEW"; case OCI_PTYPE_PROC: return "PROCEDURE"; case OCI_PTYPE_FUNC: return "FUNCTION"; case OCI_PTYPE_PKG: return "PACKAGE"; case OCI_PTYPE_TYPE: return "USER DEFINED TYPE"; case OCI_PTYPE_SYN: return "SYNONYM"; case OCI_PTYPE_SEQ: return "SEQUENCE"; case OCI_PTYPE_COL: return "COLUMN"; case OCI_PTYPE_ARG: return "ARGUMENT"; case OCI_PTYPE_LIST: return "LIST"; case OCI_PTYPE_TYPE_ATTR: return "USER-DEFINED TYPE'S ATTRIBUTE"; case OCI_PTYPE_TYPE_COLL: return "COLLECTION TYPE'S ELEMENT"; case OCI_PTYPE_TYPE_METHOD: return "USER-DEFINED TYPE'S METHOD"; case OCI_PTYPE_TYPE_ARG: return "USER-DEFINED TYPE METHOD'S ARGUMENT"; case OCI_PTYPE_TYPE_RESULT: return "USER-DEFINED TYPE METHOD'S RESULT"; case OCI_PTYPE_SCHEMA: return "SCHEMA"; case OCI_PTYPE_DATABASE: return "DATABASE"; } sv = sv_2mortal(newSVpv("",0)); sv_grow(sv, 50); sprintf(SvPVX(sv),"(UNKNOWN PTYPE Code %d)", ptype); return SvPVX(sv); } */ char * oci_exe_mode(ub4 mode) { dTHX; SV *sv; switch (mode) { /*----------------------- Execution Modes -----------------------------------*/ case OCI_DEFAULT: return "DEFAULT"; case OCI_BATCH_MODE: return "BATCH_MODE"; /* batch the oci stmt for exec */ case OCI_EXACT_FETCH: return "EXACT_FETCH"; /* fetch exact rows specified */ case OCI_STMT_SCROLLABLE_READONLY : return "STMT_SCROLLABLE_READONLY"; case OCI_DESCRIBE_ONLY: return "DESCRIBE_ONLY"; /* only describe the statement */ case OCI_COMMIT_ON_SUCCESS: return "COMMIT_ON_SUCCESS"; /* commit, if successful exec */ case OCI_NON_BLOCKING: return "NON_BLOCKING"; /* non-blocking */ case OCI_BATCH_ERRORS: return "BATCH_ERRORS"; /* batch errors in array dmls */ case OCI_PARSE_ONLY: return "PARSE_ONLY"; /* only parse the statement */ case OCI_SHOW_DML_WARNINGS: return "SHOW_DML_WARNINGS"; /* case OCI_RESULT_CACHE: return "RESULT_CACHE"; hint to use query caching only 11 so wait this one out*/ /* case OCI_NO_RESULT_CACHE : return "NO_RESULT_CACHE"; hint to bypass query caching*/ } sv = sv_2mortal(newSVpv("",0)); sv_grow(sv, 50); sprintf(SvPVX(sv),"(UNKNOWN OCI EXECUTE MODE %d)", mode); return SvPVX(sv); } /* SQL Types we support for placeholders basically we support types that can be returned as strings */ char * sql_typecode_name(int dbtype) { dTHX; SV *sv; switch(dbtype) { case 0: return "DEFAULT (varchar)"; case 1: return "VARCHAR"; case 2: return "NVARCHAR2"; case 5: return "STRING"; case 8: return "LONG"; case 21: return "BINARY FLOAT os-endian"; case 22: return "BINARY DOUBLE os-endian"; case 23: return "RAW"; case 24: return "LONG RAW"; case 96: return "CHAR"; case 97: return "CHARZ"; case 100: return "BINARY FLOAT oracle-endian"; case 101: return "BINARY DOUBLE oracle-endian"; case 106: return "MLSLABEL"; case 102: return "SQLT_CUR OCI 7 cursor variable"; case 112: return "SQLT_CLOB / long"; case 113: return "SQLT_BLOB / long"; case 116: return "SQLT_RSET OCI 8 cursor variable"; case ORA_VARCHAR2_TABLE:return "ORA_VARCHAR2_TABLE"; case ORA_NUMBER_TABLE: return "ORA_NUMBER_TABLE"; case ORA_XMLTYPE: return "ORA_XMLTYPE or SQLT_NTY";/* SQLT_NTY must be carefull here as its value (108) is the same for an embedded object Well realy only XML clobs not embedded objects */ } sv = sv_2mortal(newSVpv("",0)); sv_grow(sv, 50); sprintf(SvPVX(sv),"(UNKNOWN SQL TYPECODE %d)", dbtype); return SvPVX(sv); } char * oci_typecode_name(int typecode){ dTHX; SV *sv; switch (typecode) { case OCI_TYPECODE_INTERVAL_YM: return "INTERVAL_YM"; case OCI_TYPECODE_INTERVAL_DS: return "NTERVAL_DS"; case OCI_TYPECODE_TIMESTAMP_TZ: return "TIMESTAMP_TZ"; case OCI_TYPECODE_TIMESTAMP_LTZ: return "TIMESTAMP_LTZ"; case OCI_TYPECODE_TIMESTAMP: return "TIMESTAMP"; case OCI_TYPECODE_DATE: return "DATE"; case OCI_TYPECODE_CLOB: return "CLOB"; case OCI_TYPECODE_BLOB: return "BLOB"; case OCI_TYPECODE_BFILE: return "BFILE"; case OCI_TYPECODE_RAW: return "RAW"; case OCI_TYPECODE_CHAR: return "CHAR"; case OCI_TYPECODE_VARCHAR: return "VARCHAR"; case OCI_TYPECODE_VARCHAR2: return "VARCHAR2"; case OCI_TYPECODE_SIGNED8: return "SIGNED8"; case OCI_TYPECODE_UNSIGNED8: return "DECLARE"; case OCI_TYPECODE_UNSIGNED16 : return "UNSIGNED8"; case OCI_TYPECODE_UNSIGNED32 : return "UNSIGNED32"; case OCI_TYPECODE_REAL : return "REAL"; case OCI_TYPECODE_DOUBLE : return "DOUBLE"; case OCI_TYPECODE_INTEGER : return "INT"; case OCI_TYPECODE_SIGNED16 : return "SHORT"; case OCI_TYPECODE_SIGNED32 : return "LONG"; case OCI_TYPECODE_DECIMAL : return "DECIMAL"; case OCI_TYPECODE_FLOAT : return "FLOAT"; case OCI_TYPECODE_NUMBER : return "NUMBER"; case OCI_TYPECODE_SMALLINT: return "SMALLINT"; case OCI_TYPECODE_OBJECT: return "OBJECT"; case OCI_TYPECODE_OPAQUE: return "XMLTYPE~OPAQUE"; case OCI_TYPECODE_VARRAY: return "VARRAY"; case OCI_TYPECODE_TABLE: return "TABLE"; case OCI_TYPECODE_NAMEDCOLLECTION: return "NAMEDCOLLECTION"; } sv = sv_2mortal(newSVpv("",0)); sv_grow(sv, 50); sprintf(SvPVX(sv),"(UNKNOWN OCI TYPECODE %d)", typecode); return SvPVX(sv); } char * oci_status_name(sword status) { dTHX; SV *sv; switch (status) { case OCI_SUCCESS: return "SUCCESS"; case OCI_SUCCESS_WITH_INFO: return "SUCCESS_WITH_INFO"; case OCI_NEED_DATA: return "NEED_DATA"; case OCI_NO_DATA: return "NO_DATA"; case OCI_ERROR: return "ERROR"; case OCI_INVALID_HANDLE: return "INVALID_HANDLE"; case OCI_STILL_EXECUTING: return "STILL_EXECUTING"; case OCI_CONTINUE: return "CONTINUE"; } sv = sv_2mortal(newSVpv("",0)); sv_grow(sv, 50); sprintf(SvPVX(sv),"(UNKNOWN OCI STATUS %d)", status); return SvPVX(sv); } /* the various modes used in OCI */ char * oci_define_options(ub4 options) { dTHX; SV *sv; switch (options) { /*------------------------Bind and Define Options----------------------------*/ case OCI_DEFAULT: return "DEFAULT"; case OCI_DYNAMIC_FETCH: return "DYNAMIC_FETCH"; /* fetch dynamically */ } sv = sv_2mortal(newSVpv("",0)); sv_grow(sv, 50); sprintf(SvPVX(sv),"(UNKNOWN OCI DEFINE MODE %d)", options); return SvPVX(sv); } char * oci_bind_options(ub4 options) { dTHX; SV *sv; switch (options) { /*------------------------Bind and Define Options----------------------------*/ case OCI_DEFAULT: return "DEFAULT"; case OCI_SB2_IND_PTR: return "SB2_IND_PTR"; /* unused */ case OCI_DATA_AT_EXEC: return "DATA_AT_EXEC"; /* data at execute time */ case OCI_PIECEWISE: return "PIECEWISE"; /* piecewise DMLs or fetch */ /* case OCI_BIND_SOFT: return "BIND_SOFT"; soft bind or define */ /* case OCI_DEFINE_SOFT: return "DEFINE_SOFT"; soft bind or define */ /* case OCI_IOV: return ""; 11g only release 1.23 me thinks For scatter gather bind/define */ } sv = sv_2mortal(newSVpv("",0)); sv_grow(sv, 50); sprintf(SvPVX(sv),"(UNKNOWN BIND MODE %d)", options); return SvPVX(sv); } /* the various modes used in OCI */ char * oci_mode(ub4 mode) { dTHX; SV *sv; switch (mode) { case 3: return "THREADED | OBJECT"; case OCI_DEFAULT: return "DEFAULT"; /* the default value for parameters and attributes */ /*-------------OCIInitialize Modes / OCICreateEnvironment Modes -------------*/ case OCI_THREADED: return "THREADED"; /* appl. in threaded environment */ case OCI_OBJECT: return "OBJECT"; /* application in object environment */ case OCI_EVENTS: return "EVENTS"; /* application is enabled for events */ case OCI_SHARED: return "SHARED"; /* the application is in shared mode */ /* The following *TWO* are only valid for OCICreateEnvironment call */ case OCI_NO_UCB: return "NO_UCB "; /* No user callback called during ini */ case OCI_NO_MUTEX: return "NO_MUTEX"; /* the environment handle will not be protected by a mutex internally */ case OCI_SHARED_EXT: return "SHARED_EXT"; /* Used for shared forms */ case OCI_ALWAYS_BLOCKING:return "ALWAYS_BLOCKING"; /* all connections always blocking */ case OCI_USE_LDAP: return "USE_LDAP"; /* allow LDAP connections */ case OCI_REG_LDAPONLY: return "REG_LDAPONLY"; /* only register to LDAP */ case OCI_UTF16: return "UTF16"; /* mode for all UTF16 metadata */ case OCI_AFC_PAD_ON: return "AFC_PAD_ON"; /* turn on AFC blank padding when rlenp present */ case OCI_NEW_LENGTH_SEMANTICS: return "NEW_LENGTH_SEMANTICS"; /* adopt new length semantics the new length semantics, always bytes, is used by OCIEnvNlsCreate */ case OCI_NO_MUTEX_STMT: return "NO_MUTEX_STMT"; /* Do not mutex stmt handle */ case OCI_MUTEX_ENV_ONLY: return "MUTEX_ENV_ONLY"; /* Mutex only the environment handle */ /* case OCI_SUPPRESS_NLS_VALIDATION:return "SUPPRESS_NLS_VALIDATION"; suppress nls validation*/ /* nls validation suppression is on by default;*/ /* use OCI_ENABLE_NLS_VALIDATION to disable it */ /* case OCI_MUTEX_TRY: return "MUTEX_TRY"; try and acquire mutex */ /* case OCI_NCHAR_LITERAL_REPLACE_ON: return "NCHAR_LITERAL_REPLACE_ON"; nchar literal replace on */ /* case OCI_NCHAR_LITERAL_REPLACE_OFF:return "NCHAR_LITERAL_REPLACE_OFF"; nchar literal replace off*/ /* case OCI_ENABLE_NLS_VALIDATION: return "ENABLE_NLS_VALIDATION"; enable nls validation */ /*------------------------OCIConnectionpoolCreate Modes----------------------*/ case OCI_CPOOL_REINITIALIZE: return "CPOOL_REINITIALIZE"; /*--------------------------------- OCILogon2 Modes -------------------------*/ /*case OCI_LOGON2_SPOOL: return "LOGON2_SPOOL"; Use session pool */ case OCI_LOGON2_CPOOL: return "LOGON2_CPOOL"; /* Use connection pool */ /*case OCI_LOGON2_STMTCACHE: return "LOGON2_STMTCACHE"; Use Stmt Caching */ case OCI_LOGON2_PROXY: return "LOGON2_PROXY"; /* Proxy authentiaction */ /*------------------------- OCISessionPoolCreate Modes ----------------------*/ /*case OCI_SPC_REINITIALIZE: return "SPC_REINITIALIZE"; Reinitialize the session pool */ /*case OCI_SPC_HOMOGENEOUS: return "SPC_HOMOGENEOUS"; ""; Session pool is homogeneneous */ /*case OCI_SPC_STMTCACHE: return "SPC_STMTCACHE"; Session pool has stmt cache */ /*case OCI_SPC_NO_RLB: return "SPC_NO_RLB "; Do not enable Runtime load balancing. */ /*--------------------------- OCISessionGet Modes ---------------------------*/ /*case OCI_SESSGET_SPOOL: return "SESSGET_SPOOL"; SessionGet called in SPOOL mode */ /*case OCI_SESSGET_CPOOL: return "SESSGET_CPOOL"; SessionGet called in CPOOL mode */ /*case OCI_SESSGET_STMTCACHE: return "SESSGET_STMTCACHE"; Use statement cache */ /*case OCI_SESSGET_CREDPROXY: return "SESSGET_CREDPROXY"; SessionGet called in proxy mode */ /*case OCI_SESSGET_CREDEXT: return "SESSGET_CREDEXT"; */ case OCI_SESSGET_SPOOL_MATCHANY:return "SESSGET_SPOOL_MATCHANY"; /*case OCI_SESSGET_PURITY_NEW: return "SESSGET_PURITY_NEW"; case OCI_SESSGET_PURITY_SELF: return "SESSGET_PURITY_SELF"; */ } sv = sv_2mortal(newSVpv("",0)); sv_grow(sv, 50); sprintf(SvPVX(sv),"(UNKNOWN OCI MODE %d)", mode); return SvPVX(sv); } char * oci_stmt_type_name(int stmt_type) { dTHX; SV *sv; switch (stmt_type) { case OCI_STMT_SELECT: return "SELECT"; case OCI_STMT_UPDATE: return "UPDATE"; case OCI_STMT_DELETE: return "DELETE"; case OCI_STMT_INSERT: return "INSERT"; case OCI_STMT_CREATE: return "CREATE"; case OCI_STMT_DROP: return "DROP"; case OCI_STMT_ALTER: return "ALTER"; case OCI_STMT_BEGIN: return "BEGIN"; case OCI_STMT_DECLARE: return "DECLARE"; } sv = sv_2mortal(newSVpv("",0)); sv_grow(sv, 50); sprintf(SvPVX(sv),"(STMT TYPE %d)", stmt_type); return SvPVX(sv); } char * oci_col_return_codes(int rc) { dTHX; SV *sv; switch (rc) { case 1406: return "TRUNCATED"; case 0: return "OK"; case 1405: return "NULL"; case 1403: return "NO DATA"; } sv = sv_2mortal(newSVpv("",0)); sv_grow(sv, 50); sprintf(SvPVX(sv),"UNKNOWN RC=%d)", rc); return SvPVX(sv); } char * oci_hdtype_name(ub4 hdtype) { dTHX; SV *sv; switch (hdtype) { /* Handles */ case OCI_HTYPE_ENV: return "OCI_HTYPE_ENV"; case OCI_HTYPE_ERROR: return "OCI_HTYPE_ERROR"; case OCI_HTYPE_SVCCTX: return "OCI_HTYPE_SVCCTX"; case OCI_HTYPE_STMT: return "OCI_HTYPE_STMT"; case OCI_HTYPE_BIND: return "OCI_HTYPE_BIND"; case OCI_HTYPE_DEFINE: return "OCI_HTYPE_DEFINE"; case OCI_HTYPE_DESCRIBE: return "OCI_HTYPE_DESCRIBE"; case OCI_HTYPE_SERVER: return "OCI_HTYPE_SERVER"; case OCI_HTYPE_SESSION: return "OCI_HTYPE_SESSION"; case OCI_HTYPE_CPOOL: return "OCI_HTYPE_CPOOL"; case OCI_HTYPE_SPOOL: return "OCI_HTYPE_SPOOL"; /*case OCI_HTYPE_AUTHINFO: return "OCI_HTYPE_AUTHINFO";*/ /* Descriptors */ case OCI_DTYPE_LOB: return "OCI_DTYPE_LOB"; case OCI_DTYPE_SNAP: return "OCI_DTYPE_SNAP"; case OCI_DTYPE_RSET: return "OCI_DTYPE_RSET"; case OCI_DTYPE_PARAM: return "OCI_DTYPE_PARAM"; case OCI_DTYPE_ROWID: return "OCI_DTYPE_ROWID"; #ifdef OCI_DTYPE_REF case OCI_DTYPE_REF: return "OCI_DTYPE_REF"; #endif } sv = sv_2mortal(newSViv((IV)hdtype)); return SvPV(sv,PL_na); } /*used to look up the name of a csform value used only for debugging */ char * oci_csform_name(ub4 attr) { dTHX; SV *sv; switch (attr) { /* CHAR/NCHAR/VARCHAR2/NVARCHAR2/CLOB/NCLOB char set "form" information */ case SQLCS_IMPLICIT: return "SQLCS_IMPLICIT";/* for CHAR, VARCHAR2, CLOB w/o a specified set */ case SQLCS_NCHAR: return "SQLCS_NCHAR";/* for NCHAR, NCHAR VARYING, NCLOB */ case SQLCS_EXPLICIT: return "SQLCS_EXPLICIT";/* for CHAR, etc, with "CHARACTER SET ..." syntax */ case SQLCS_FLEXIBLE: return "SQLCS_FLEXIBLE";/* for PL/SQL "flexible" parameters */ case SQLCS_LIT_NULL: return "SQLCS_LIT_NULL";/* for typecheck of NULL and empty_clob() lits */ } sv = sv_2mortal(newSViv((IV)attr)); return SvPV(sv,PL_na); } /*used to look up the name of a OCI_DTYPE_PARAM Attribute Types used only for debugging */ char * oci_dtype_attr_name(ub4 attr) { dTHX; SV *sv; switch (attr) { /*=======================Describe Handle Parameter Attributes ===============*/ case OCI_ATTR_DATA_SIZE: return "OCI_ATTR_DATA_SIZE"; /* maximum size of the data */ case OCI_ATTR_DATA_TYPE: return "OCI_ATTR_DATA_TYPE"; /* the SQL type of the column/argument */ case OCI_ATTR_DISP_SIZE: return "OCI_ATTR_DISP_SIZE"; /* the display size */ case OCI_ATTR_NAME: return "OCI_ATTR_NAME"; /* the name of the column/argument */ case OCI_ATTR_PRECISION: return "OCI_ATTR_PRECISION"; /* precision if number type */ case OCI_ATTR_SCALE: return "OCI_ATTR_SCALE"; /* scale if number type */ case OCI_ATTR_IS_NULL: return "OCI_ATTR_IS_NULL"; /* is it null ? */ case OCI_ATTR_TYPE_NAME: return "OCI_ATTR_TYPE_NAME"; /* name of the named data type or a package name for package private types */ case OCI_ATTR_SCHEMA_NAME: return "OCI_ATTR_SCHEMA_NAME"; /* the schema name */ case OCI_ATTR_SUB_NAME: return "OCI_ATTR_SUB_NAME"; /* type name if package private type */ case OCI_ATTR_POSITION: return "OCI_ATTR_POSITION"; case OCI_ATTR_CHAR_USED: return "OCI_ATTR_CHAR_USED"; /* char length semantics */ case OCI_ATTR_CHAR_SIZE: return "OCI_ATTR_CHAR_SIZE"; /* char length */ case OCI_ATTR_CHARSET_ID: return "OCI_ATTR_CHARSET_ID"; /* Character Set ID */ case OCI_ATTR_CHARSET_FORM: return "OCI_ATTR_CHARSET_FORM"; /* Character Set Form */ } sv = sv_2mortal(newSViv((IV)attr)); return SvPV(sv,PL_na); } /*used to look up the name of non a OCI_DTYPE_PARAM Attribute Types used only for debugging */ char * oci_attr_name(ub4 attr) { dTHX; SV *sv; switch (attr) { #ifdef ORA_OCI_102 case OCI_ATTR_MODULE: return "OCI_ATTR_MODULE"; /* module for tracing */ case OCI_ATTR_ACTION: return "OCI_ATTR_ACTION"; /* action for tracing */ case OCI_ATTR_CLIENT_INFO: return "OCI_ATTR_CLIENT_INFO"; /* client info */ case OCI_ATTR_COLLECT_CALL_TIME: return "OCI_ATTR_COLLECT_CALL_TIME"; /* collect call time */ case OCI_ATTR_CALL_TIME: return "OCI_ATTR_CALL_TIME"; /* extract call time */ case OCI_ATTR_ECONTEXT_ID: return "OCI_ATTR_ECONTEXT_ID"; /* execution-id context */ case OCI_ATTR_ECONTEXT_SEQ: return "OCI_ATTR_ECONTEXT_SEQ"; /*execution-id sequence num */ /*------------------------------ Session attributes -------------------------*/ case OCI_ATTR_SESSION_STATE: return "OCI_ATTR_SESSION_STATE"; /* session state */ case OCI_ATTR_SESSION_STATETYPE: return "OCI_ATTR_SESSION_STATETYPE"; /* session state type */ case OCI_SESSION_STATELESS_DEF: return "OCI_SESSION_STATELESS_DEF"; /* valid state types */ case OCI_ATTR_SESSION_STATE_CLEARED: return "OCI_ATTR_SESSION_STATE_CLEARED"; /* session state cleared*/ case OCI_ATTR_SESSION_MIGRATED: return "OCI_ATTR_SESSION_MIGRATED"; /* did session migrate*/ case OCI_ATTR_SESSION_PRESERVE_STATE: return "OCI_ATTR_SESSION_PRESERVE_STATE"; /* preserve session state */ #endif #ifdef ORA_OCI_112 case OCI_ATTR_DRIVER_NAME: return "OCI_ATTR_DRIVER_NAME"; /* Driver Name */ #endif case OCI_ATTR_CLIENT_IDENTIFIER: return "OCI_ATTR_CLIENT_IDENTIFIER"; /* value of client id to set*/ /*=============================Attribute Types===============================*/ #ifdef ORA_OCI_112 case OCI_ATTR_PURITY: return "OCI_ATTR_PURITY"; /* for DRCP session purity */ case OCI_ATTR_CONNECTION_CLASS: return "OCI_ATTR_CONNECTION_CLASS"; /* for DRCP connection class */ #endif case OCI_ATTR_FNCODE: return "OCI_ATTR_FNCODE"; /* the OCI function code */ case OCI_ATTR_OBJECT: return "OCI_ATTR_OBJECT"; /* is the environment initialized in object mode */ case OCI_ATTR_NONBLOCKING_MODE: return "OCI_ATTR_NONBLOCKING_MODE"; /* non blocking mode */ case OCI_ATTR_SQLCODE: return "OCI_ATTR_SQLCODE"; /* the SQL verb */ case OCI_ATTR_ENV: return "OCI_ATTR_ENV"; /* the environment handle */ case OCI_ATTR_SERVER: return "OCI_ATTR_SERVER"; /* the server handle*/ case OCI_ATTR_SESSION: return "OCI_ATTR_SESSION"; /* the user session handle*/ case OCI_ATTR_TRANS: return "OCI_ATTR_TRANS"; /* the transaction handle */ case OCI_ATTR_ROW_COUNT: return "OCI_ATTR_ROW_COUNT"; /* the rows processed so far */ case OCI_ATTR_SQLFNCODE: return "OCI_ATTR_SQLFNCODE"; /* the SQL verb of the statement */ case OCI_ATTR_PREFETCH_ROWS: return "OCI_ATTR_PREFETCH_ROWS"; /* sets the number of rows to prefetch */ case OCI_ATTR_NESTED_PREFETCH_ROWS: return "OCI_ATTR_NESTED_PREFETCH_ROWS"; /* the prefetch rows of nested table*/ case OCI_ATTR_PREFETCH_MEMORY: return "OCI_ATTR_PREFETCH_MEMORY"; /* memory limit for rows fetched */ case OCI_ATTR_NESTED_PREFETCH_MEMORY:return "OCI_ATTR_NESTED_PREFETCH_MEMORY"; /* memory limit for nested rows */ case OCI_ATTR_CHAR_COUNT: return "OCI_ATTR_CHAR_COUNT"; /* this specifies the bind and define size in characters */ case OCI_ATTR_PDSCL: return "OCI_ATTR_PDSCL"; /* packed decimal scale*/ /*case OCI_ATTR_FSPRECISION OCI_ATTR_PDSCL:return ""; fs prec for datetime data types */ case OCI_ATTR_PDPRC: return "OCI_ATTR_PDPRC"; /* packed decimal format*/ /*case OCI_ATTR_LFPRECISION OCI_ATTR_PDPRC: return ""; fs prec for datetime data types */ case OCI_ATTR_PARAM_COUNT: return "OCI_ATTR_PARAM_COUNT"; /* number of column in the select list */ case OCI_ATTR_ROWID: return "OCI_ATTR_ROWID"; /* the rowid */ case OCI_ATTR_CHARSET: return "OCI_ATTR_CHARSET"; /* the character set value */ case OCI_ATTR_NCHAR: return "OCI_ATTR_NCHAR"; /* NCHAR type */ case OCI_ATTR_USERNAME: return "OCI_ATTR_USERNAME"; /* username attribute */ case OCI_ATTR_PASSWORD: return "OCI_ATTR_PASSWORD"; /* password attribute */ case OCI_ATTR_STMT_TYPE: return "OCI_ATTR_STMT_TYPE"; /* statement type */ case OCI_ATTR_INTERNAL_NAME: return "OCI_ATTR_INTERNAL_NAME"; /* user friendly global name */ case OCI_ATTR_EXTERNAL_NAME: return "OCI_ATTR_EXTERNAL_NAME"; /* the internal name for global txn */ case OCI_ATTR_XID: return "OCI_ATTR_XID"; /* XOPEN defined global transaction id */ case OCI_ATTR_TRANS_LOCK: return "OCI_ATTR_TRANS_LOCK"; /* */ case OCI_ATTR_TRANS_NAME: return "OCI_ATTR_TRANS_NAME"; /* string to identify a global transaction */ case OCI_ATTR_HEAPALLOC: return "OCI_ATTR_HEAPALLOC"; /* memory allocated on the heap */ case OCI_ATTR_CHARSET_FORM: return "OCI_ATTR_CHARSET_FORM"; /* Character Set Form */ case OCI_ATTR_MAXDATA_SIZE: return "OCI_ATTR_MAXDATA_SIZE"; /* Maximumsize of data on the server */ case OCI_ATTR_CACHE_OPT_SIZE: return "OCI_ATTR_CACHE_OPT_SIZE"; /* object cache optimal size */ case OCI_ATTR_CACHE_MAX_SIZE: return "OCI_ATTR_CACHE_MAX_SIZE"; /* object cache maximum size percentage */ case OCI_ATTR_PINOPTION: return "OCI_ATTR_PINOPTION"; /* object cache default pin option */ case OCI_ATTR_ALLOC_DURATION: return "OCI_ATTR_ALLOC_DURATION"; /* object cache default allocation duration */ case OCI_ATTR_PIN_DURATION: return "OCI_ATTR_PIN_DURATION"; /* object cache default pin duration */ case OCI_ATTR_FDO: return "OCI_ATTR_FDO"; /* Format Descriptor object attribute */ case OCI_ATTR_POSTPROCESSING_CALLBACK: return "OCI_ATTR_POSTPROCESSING_CALLBACK"; /* Callback to process outbind data */ case OCI_ATTR_POSTPROCESSING_CONTEXT: return "OCI_ATTR_POSTPROCESSING_CONTEXT"; /* Callback context to process outbind data */ case OCI_ATTR_ROWS_RETURNED: return "OCI_ATTR_ROWS_RETURNED"; /* Number of rows returned in current iter - for Bind handles */ case OCI_ATTR_FOCBK: return "OCI_ATTR_FOCBK"; /* Failover Callback attribute */ case OCI_ATTR_IN_V8_MODE: return "OCI_ATTR_IN_V8_MODE"; /* is the server/service context in V8 mode */ case OCI_ATTR_LOBEMPTY: return "OCI_ATTR_LOBEMPTY"; /* empty lob ? */ case OCI_ATTR_SESSLANG: return "OCI_ATTR_SESSLANG"; /* session language handle */ case OCI_ATTR_VISIBILITY: return "OCI_ATTR_VISIBILITY"; /* visibility */ case OCI_ATTR_RELATIVE_MSGID: return "OCI_ATTR_RELATIVE_MSGID"; /* relative message id */ case OCI_ATTR_SEQUENCE_DEVIATION: return "OCI_ATTR_SEQUENCE_DEVIATION"; /* sequence deviation */ case OCI_ATTR_CONSUMER_NAME: return "OCI_ATTR_CONSUMER_NAME"; /* consumer name */ case OCI_ATTR_DEQ_MODE: return "OCI_ATTR_DEQ_MODE"; /* dequeue mode */ case OCI_ATTR_NAVIGATION: return "OCI_ATTR_NAVIGATION"; /* navigation */ case OCI_ATTR_WAIT: return "OCI_ATTR_WAIT"; /* wait */ case OCI_ATTR_DEQ_MSGID: return "OCI_ATTR_DEQ_MSGID"; /* dequeue message id */ case OCI_ATTR_PRIORITY: return "OCI_ATTR_PRIORITY"; /* priority */ case OCI_ATTR_DELAY: return "OCI_ATTR_DELAY"; /* delay */ case OCI_ATTR_EXPIRATION: return "OCI_ATTR_EXPIRATION"; /* expiration */ case OCI_ATTR_CORRELATION: return "OCI_ATTR_CORRELATION"; /* correlation id */ case OCI_ATTR_ATTEMPTS: return "OCI_ATTR_ATTEMPTS"; /* # of attempts */ case OCI_ATTR_RECIPIENT_LIST: return "OCI_ATTR_RECIPIENT_LIST"; /* recipient list */ case OCI_ATTR_EXCEPTION_QUEUE: return "OCI_ATTR_EXCEPTION_QUEUE"; /* exception queue name */ case OCI_ATTR_ENQ_TIME: return "OCI_ATTR_ENQ_TIME"; /* enqueue time (only OCIAttrGet) */ case OCI_ATTR_MSG_STATE: return "OCI_ATTR_MSG_STATE"; /* message state (only OCIAttrGet) */ /* NOTE: 64-66 used below */ case OCI_ATTR_AGENT_NAME: return "OCI_ATTR_AGENT_NAME"; /* agent name */ case OCI_ATTR_AGENT_ADDRESS: return "OCI_ATTR_AGENT_ADDRESS"; /* agent address */ case OCI_ATTR_AGENT_PROTOCOL: return "OCI_ATTR_AGENT_PROTOCOL"; /* agent protocol */ case OCI_ATTR_SENDER_ID: return "OCI_ATTR_SENDER_ID"; /* sender id */ case OCI_ATTR_ORIGINAL_MSGID: return "OCI_ATTR_ORIGINAL_MSGID"; /* original message id */ case OCI_ATTR_QUEUE_NAME: return "OCI_ATTR_QUEUE_NAME"; /* queue name */ case OCI_ATTR_NFY_MSGID: return "OCI_ATTR_NFY_MSGID"; /* message id */ case OCI_ATTR_MSG_PROP: return "OCI_ATTR_MSG_PROP"; /* message properties */ case OCI_ATTR_NUM_DML_ERRORS: return "OCI_ATTR_NUM_DML_ERRORS"; /* num of errs in array DML */ case OCI_ATTR_DML_ROW_OFFSET: return "OCI_ATTR_DML_ROW_OFFSET"; /* row offset in the array */ case OCI_ATTR_DATEFORMAT: return "OCI_ATTR_DATEFORMAT"; /* default date format string */ case OCI_ATTR_BUF_ADDR: return "OCI_ATTR_BUF_ADDR"; /* buffer address */ case OCI_ATTR_BUF_SIZE: return "OCI_ATTR_BUF_SIZE"; /* buffer size */ case OCI_ATTR_DIRPATH_MODE: return "OCI_ATTR_DIRPATH_MODE"; /* mode of direct path operation */ case OCI_ATTR_DIRPATH_NOLOG: return "OCI_ATTR_DIRPATH_NOLOG"; /* nologging option */ case OCI_ATTR_DIRPATH_PARALLEL: return "OCI_ATTR_DIRPATH_PARALLEL"; /* parallel (temp seg) option */ case OCI_ATTR_NUM_ROWS: return "OCI_ATTR_NUM_ROWS"; /* number of rows in column array */ /* NOTE that OCI_ATTR_NUM_COLS is a column*/ /* array attribute too.*/ case OCI_ATTR_COL_COUNT: return "OCI_ATTR_COL_COUNT"; /* columns of column array*/ /*processed so far. */ case OCI_ATTR_STREAM_OFFSET: return "OCI_ATTR_STREAM_OFFSET"; /* str off of last row processed*/ /* case OCI_ATTR_SHARED_HEAPALLO: return ""; Shared Heap Allocation Size */ case OCI_ATTR_SERVER_GROUP: return "OCI_ATTR_SERVER_GROUP"; /* server group name */ case OCI_ATTR_MIGSESSION: return "OCI_ATTR_MIGSESSION"; /* migratable session attribute */ case OCI_ATTR_NOCACHE: return "OCI_ATTR_NOCACHE"; /* Temporary LOBs */ case OCI_ATTR_MEMPOOL_SIZE: return "OCI_ATTR_MEMPOOL_SIZE"; /* Pool Size */ case OCI_ATTR_MEMPOOL_INSTNAME: return "OCI_ATTR_MEMPOOL_INSTNAME"; /* Instance name */ case OCI_ATTR_MEMPOOL_APPNAME: return "OCI_ATTR_MEMPOOL_APPNAME"; /* Application name */ case OCI_ATTR_MEMPOOL_HOMENAME: return "OCI_ATTR_MEMPOOL_HOMENAME"; /* Home Directory name */ case OCI_ATTR_MEMPOOL_MODEL: return "OCI_ATTR_MEMPOOL_MODEL"; /* Pool Model (proc,thrd,both)*/ case OCI_ATTR_MODES: return "OCI_ATTR_MODES"; /* Modes */ case OCI_ATTR_SUBSCR_NAME: return "OCI_ATTR_SUBSCR_NAME"; /* name of subscription */ case OCI_ATTR_SUBSCR_CALLBACK: return "OCI_ATTR_SUBSCR_CALLBACK"; /* associated callback */ case OCI_ATTR_SUBSCR_CTX: return "OCI_ATTR_SUBSCR_CTX"; /* associated callback context */ case OCI_ATTR_SUBSCR_PAYLOAD: return "OCI_ATTR_SUBSCR_PAYLOAD"; /* associated payload */ case OCI_ATTR_SUBSCR_NAMESPACE: return "OCI_ATTR_SUBSCR_NAMESPACE"; /* associated namespace */ case OCI_ATTR_PROXY_CREDENTIALS: return "OCI_ATTR_PROXY_CREDENTIALS"; /* Proxy user credentials */ case OCI_ATTR_INITIAL_CLIENT_ROLES: return "OCI_ATTR_INITIAL_CLIENT_ROLES"; /* Initial client role list */ case OCI_ATTR_UNK: return "OCI_ATTR_UNK"; /* unknown attribute */ case OCI_ATTR_NUM_COLS: return "OCI_ATTR_NUM_COLS"; /* number of columns */ case OCI_ATTR_LIST_COLUMNS: return "OCI_ATTR_LIST_COLUMNS"; /* parameter of the column list */ case OCI_ATTR_RDBA: return "OCI_ATTR_RDBA"; /* DBA of the segment header */ case OCI_ATTR_CLUSTERED: return "OCI_ATTR_CLUSTERED"; /* whether the table is clustered */ case OCI_ATTR_PARTITIONED: return "OCI_ATTR_PARTITIONED"; /* whether the table is partitioned */ case OCI_ATTR_INDEX_ONLY: return "OCI_ATTR_INDEX_ONLY"; /* whether the table is index only */ case OCI_ATTR_LIST_ARGUMENTS: return "OCI_ATTR_LIST_ARGUMENTS"; /* parameter of the argument list */ case OCI_ATTR_LIST_SUBPROGRAMS: return "OCI_ATTR_LIST_SUBPROGRAMS"; /* parameter of the subprogram list */ case OCI_ATTR_REF_TDO: return "OCI_ATTR_REF_TDO"; /* REF to the type descriptor */ case OCI_ATTR_LINK: return "OCI_ATTR_LINK"; /* the database link name */ case OCI_ATTR_MIN: return "OCI_ATTR_MIN"; /* minimum value */ case OCI_ATTR_MAX: return "OCI_ATTR_MAX"; /* maximum value */ case OCI_ATTR_INCR: return "OCI_ATTR_INCR"; /* increment value */ case OCI_ATTR_CACHE: return "OCI_ATTR_CACHE"; /* number of sequence numbers cached */ case OCI_ATTR_ORDER: return "OCI_ATTR_ORDER"; /* whether the sequence is ordered */ case OCI_ATTR_HW_MARK: return "OCI_ATTR_HW_MARK"; /* high-water mark */ case OCI_ATTR_TYPE_SCHEMA: return "OCI_ATTR_TYPE_SCHEMA"; /* type's schema name */ case OCI_ATTR_TIMESTAMP: return "OCI_ATTR_TIMESTAMP"; /* timestamp of the object */ case OCI_ATTR_NUM_ATTRS: return "OCI_ATTR_NUM_ATTRS"; /* number of sttributes */ case OCI_ATTR_NUM_PARAMS: return "OCI_ATTR_NUM_PARAMS"; /* number of parameters */ case OCI_ATTR_OBJID: return "OCI_ATTR_OBJID"; /* object id for a table or view */ case OCI_ATTR_PTYPE: return "OCI_ATTR_PTYPE"; /* type of info described by */ case OCI_ATTR_PARAM: return "OCI_ATTR_PARAM"; /* parameter descriptor */ case OCI_ATTR_OVERLOAD_ID: return "OCI_ATTR_OVERLOAD_ID"; /* overload ID for funcs and procs */ case OCI_ATTR_TABLESPACE: return "OCI_ATTR_TABLESPACE"; /* table name space */ case OCI_ATTR_TDO: return "OCI_ATTR_TDO"; /* TDO of a type */ case OCI_ATTR_LTYPE: return "OCI_ATTR_LTYPE"; /* list type */ case OCI_ATTR_PARSE_ERROR_OFFSET: return "OCI_ATTR_PARSE_ERROR_OFFSET";/* Parse Error offset */ case OCI_ATTR_IS_TEMPORARY: return "OCI_ATTR_IS_TEMPORARY"; /* whether table is temporary */ case OCI_ATTR_IS_TYPED: return "OCI_ATTR_IS_TYPED"; /* whether table is typed */ case OCI_ATTR_DURATION: return "OCI_ATTR_DURATION"; /* duration of temporary table */ case OCI_ATTR_IS_INVOKER_RIGHTS: return "OCI_ATTR_IS_INVOKER_RIGHTS";/* is invoker rights */ case OCI_ATTR_OBJ_NAME: return "OCI_ATTR_OBJ_NAME"; /* top level schema obj name */ case OCI_ATTR_OBJ_SCHEMA: return "OCI_ATTR_OBJ_SCHEMA"; /* schema name */ case OCI_ATTR_OBJ_ID: return "OCI_ATTR_OBJ_ID"; /* top level schema object id */ case OCI_ATTR_DIRPATH_SORTED_INDEX: return "OCI_ATTR_DIRPATH_SORTED_INDEX";/* index that data is sorted on */ /* direct path index maint method (see oci8dp.h) */ case OCI_ATTR_DIRPATH_INDEX_MAINT_METHOD: return "OCI_ATTR_DIRPATH_INDEX_MAINT_METHOD";/* parallel load: db file, initial and next extent sizes */ case OCI_ATTR_DIRPATH_FILE: return "OCI_ATTR_DIRPATH_FILE"; /* DB file to load into */ case OCI_ATTR_DIRPATH_STORAGE_INITIAL: return "OCI_ATTR_DIRPATH_STORAGE_INITIAL"; /* initial extent size */ case OCI_ATTR_DIRPATH_STORAGE_NEXT: return "OCI_ATTR_DIRPATH_STORAGE_NEXT"; /* next extent size */ case OCI_ATTR_TRANS_TIMEOUT: return "OCI_ATTR_TRANS_TIMEOUT"; /* transaction timeout */ case OCI_ATTR_SERVER_STATUS: return "OCI_ATTR_SERVER_STATUS"; /* state of the server handle */ case OCI_ATTR_STATEMENT: return "OCI_ATTR_STATEMENT"; /* statement txt in stmt hdl */ /* statement should not be executed in cache*/ /*case OCI_ATTR_NO_CACHE: return "";*/ case OCI_ATTR_DEQCOND: return "OCI_ATTR_DEQCOND"; /* dequeue condition */ case OCI_ATTR_RESERVED_2: return "OCI_ATTR_RESERVED_2"; /* reserved */ case OCI_ATTR_SUBSCR_RECPT: return "OCI_ATTR_SUBSCR_RECPT"; /* recepient of subscription */ case OCI_ATTR_SUBSCR_RECPTPROTO: return "OCI_ATTR_SUBSCR_RECPTPROTO";/* protocol for recepient */ /* 8.2 dpapi support of ADTs */ case OCI_ATTR_DIRPATH_EXPR_TYPE: return "OCI_ATTR_DIRPATH_EXPR_TYPE"; /* expr type of OCI_ATTR_NAME */ case OCI_ATTR_DIRPATH_INPUT: return "OCI_ATTR_DIRPATH_INPUT"; /* input in text or stream format*/ /* case OCI_DIRPATH_INPUT_TEXT: return ""; case OCI_DIRPATH_INPUT_STREAM: return ""; case OCI_DIRPATH_INPUT_UNKNOWN: return ""; */ case OCI_ATTR_LDAP_HOST: return "OCI_ATTR_LDAP_HOST"; /* LDAP host to connect to */ case OCI_ATTR_LDAP_PORT: return "OCI_ATTR_LDAP_PORT"; /* LDAP port to connect to */ case OCI_ATTR_BIND_DN: return "OCI_ATTR_BIND_DN"; /* bind DN */ case OCI_ATTR_LDAP_CRED: return "OCI_ATTR_LDAP_CRED"; /* credentials to connect to LDAP */ case OCI_ATTR_WALL_LOC: return "OCI_ATTR_WALL_LOC"; /* client wallet location */ case OCI_ATTR_LDAP_AUTH: return "OCI_ATTR_LDAP_AUTH"; /* LDAP authentication method */ case OCI_ATTR_LDAP_CTX: return "OCI_ATTR_LDAP_CTX"; /* LDAP adminstration context DN */ case OCI_ATTR_SERVER_DNS: return "OCI_ATTR_SERVER_DNS"; /* list of registration server DNs */ case OCI_ATTR_DN_COUNT: return "OCI_ATTR_DN_COUNT"; /* the number of server DNs */ case OCI_ATTR_SERVER_DN: return "OCI_ATTR_SERVER_DN"; /* server DN attribute */ case OCI_ATTR_MAXCHAR_SIZE: return "OCI_ATTR_MAXCHAR_SIZE"; /* max char size of data */ case OCI_ATTR_CURRENT_POSITION: return "OCI_ATTR_CURRENT_POSITION"; /* for scrollable result sets*/ /* Added to get attributes for ref cursor to statement handle */ case OCI_ATTR_RESERVED_3: return "OCI_ATTR_RESERVED_3"; /* reserved */ case OCI_ATTR_RESERVED_4: return "OCI_ATTR_RESERVED_4"; /* reserved */ case OCI_ATTR_DIRPATH_FN_CTX: return ""; /* fn ctx ADT attrs or args */ case OCI_ATTR_DIGEST_ALGO: return "OCI_ATTR_DIRPATH_FN_CTX"; /* digest algorithm */ case OCI_ATTR_CERTIFICATE: return "OCI_ATTR_CERTIFICATE"; /* certificate */ case OCI_ATTR_SIGNATURE_ALGO: return "OCI_ATTR_SIGNATURE_ALGO"; /* signature algorithm */ case OCI_ATTR_CANONICAL_ALGO: return "OCI_ATTR_CANONICAL_ALGO"; /* canonicalization algo. */ case OCI_ATTR_PRIVATE_KEY: return "OCI_ATTR_PRIVATE_KEY"; /* private key */ case OCI_ATTR_DIGEST_VALUE: return "OCI_ATTR_DIGEST_VALUE"; /* digest value */ case OCI_ATTR_SIGNATURE_VAL: return "OCI_ATTR_SIGNATURE_VAL"; /* signature value */ case OCI_ATTR_SIGNATURE: return "OCI_ATTR_SIGNATURE"; /* signature */ /* attributes for setting OCI stmt caching specifics in svchp */ case OCI_ATTR_STMTCACHESIZE : return "OCI_ATTR_STMTCACHESIZE"; /* size of the stm cache */ /* --------------------------- Connection Pool Attributes ------------------ */ case OCI_ATTR_CONN_NOWAIT: return "OCI_ATTR_CONN_NOWAIT"; case OCI_ATTR_CONN_BUSY_COUNT: return "OCI_ATTR_CONN_BUSY_COUNT"; case OCI_ATTR_CONN_OPEN_COUNT: return "OCI_ATTR_CONN_OPEN_COUNT"; case OCI_ATTR_CONN_TIMEOUT: return "OCI_ATTR_CONN_TIMEOUT"; case OCI_ATTR_STMT_STATE: return "OCI_ATTR_STMT_STATE"; case OCI_ATTR_CONN_MIN: return "OCI_ATTR_CONN_MIN"; case OCI_ATTR_CONN_MAX: return "OCI_ATTR_CONN_MAX"; case OCI_ATTR_CONN_INCR: return "OCI_ATTR_CONN_INCR"; case OCI_ATTR_DIRPATH_OID: return "OCI_ATTR_DIRPATH_OID"; /* loading into an OID col */ case OCI_ATTR_NUM_OPEN_STMTS: return "OCI_ATTR_NUM_OPEN_STMTS"; /* open stmts in session */ case OCI_ATTR_DESCRIBE_NATIVE: return "OCI_ATTR_DESCRIBE_NATIVE"; /* get native info via desc */ case OCI_ATTR_BIND_COUNT: return "OCI_ATTR_BIND_COUNT"; /* number of bind postions */ case OCI_ATTR_HANDLE_POSITION: return "OCI_ATTR_HANDLE_POSITION"; /* pos of bind/define handle */ case OCI_ATTR_RESERVED_5: return "OCI_ATTR_RESERVED_5"; /* reserverd */ case OCI_ATTR_SERVER_BUSY: return "OCI_ATTR_SERVER_BUSY"; /* call in progress on server*/ case OCI_ATTR_DIRPATH_SID: return "OCI_ATTR_DIRPATH_SID"; /* loading into an SID col */ /* notification presentation for recipient */ case OCI_ATTR_SUBSCR_RECPTPRES: return "OCI_ATTR_SUBSCR_RECPTPRES"; case OCI_ATTR_TRANSFORMATION: return "OCI_ATTR_TRANSFORMATION"; /* AQ message transformation */ case OCI_ATTR_ROWS_FETCHED: return "OCI_ATTR_ROWS_FETCHED"; /* rows fetched in last call */ /* --------------------------- Snapshot attributes ------------------------- */ case OCI_ATTR_SCN_BASE: return "OCI_ATTR_SCN_BASE"; /* snapshot base */ case OCI_ATTR_SCN_WRAP: return "OCI_ATTR_SCN_WRAP"; /* snapshot wrap */ /* --------------------------- Miscellanous attributes --------------------- */ case OCI_ATTR_RESERVED_6: return "OCI_ATTR_RESERVED_6"; /* reserved */ case OCI_ATTR_READONLY_TXN: return "OCI_ATTR_READONLY_TXN"; /* txn is readonly */ case OCI_ATTR_RESERVED_7: return "OCI_ATTR_RESERVED_7"; /* reserved */ case OCI_ATTR_ERRONEOUS_COLUMN: return "OCI_ATTR_ERRONEOUS_COLUMN"; /* position of erroneous col */ case OCI_ATTR_RESERVED_8: return "OCI_ATTR_RESERVED_8"; /* reserved */ /* -------------------- 8.2 dpapi support of ADTs continued ---------------- */ case OCI_ATTR_DIRPATH_OBJ_CONSTR: return "OCI_ATTR_DIRPATH_OBJ_CONSTR"; /* obj type of subst obj tbl */ /************************FREE attribute 207 *************************/ /************************FREE attribute 208 *************************/ case OCI_ATTR_ENV_UTF16: return "OCI_ATTR_ENV_UTF16"; /* is env in utf16 mode? */ case OCI_ATTR_RESERVED_9: return "OCI_ATTR_RESERVED_9"; /* reserved for TMZ */ case OCI_ATTR_RESERVED_10: return "OCI_ATTR_RESERVED_10"; /* reserved */ /* Attr to allow setting of the stream version PRIOR to calling Prepare */ case OCI_ATTR_DIRPATH_STREAM_VERSION: return "OCI_ATTR_DIRPATH_STREAM_VERSION"; /* version of the stream*/ /* case OCI_ATTR_RESERVED_11: return "OCI_ATTR_RESERVED_11"; reserved */ case OCI_ATTR_RESERVED_12: return "OCI_ATTR_RESERVED_12"; /* reserved */ case OCI_ATTR_RESERVED_13: return "OCI_ATTR_RESERVED_13"; /* reserved */ /* OCI_ATTR_RESERVED_14 */ #ifdef OCI_ATTR_RESERVED_15 case OCI_ATTR_RESERVED_15: return "OCI_ATTR_RESERVED_15"; /* reserved */ #endif #ifdef OCI_ATTR_RESERVED_16 case OCI_ATTR_RESERVED_16: return "OCI_ATTR_RESERVED_16"; /* reserved */ #endif } sv = sv_2mortal(newSViv((IV)attr)); return SvPV(sv,PL_na); } /*used to look up the name of a fetchtype constant used only for debugging */ char * oci_fetch_options(ub4 fetchtype) { dTHX; SV *sv; switch (fetchtype) { /* fetch options */ case OCI_FETCH_CURRENT: return "OCI_FETCH_CURRENT"; case OCI_FETCH_NEXT: return "OCI_FETCH_NEXT"; case OCI_FETCH_FIRST: return "OCI_FETCH_FIRST"; case OCI_FETCH_LAST: return "OCI_FETCH_LAST"; case OCI_FETCH_PRIOR: return "OCI_FETCH_PRIOR"; case OCI_FETCH_ABSOLUTE: return "OCI_FETCH_ABSOLUTE"; case OCI_FETCH_RELATIVE: return "OCI_FETCH_RELATIVE"; } sv = sv_2mortal(newSViv((IV)fetchtype)); return SvPV(sv,PL_na); } static sb4 oci_error_get(imp_xxh_t *imp_xxh, OCIError *errhp, sword status, char *what, SV *errstr, int debug) { dTHX; text errbuf[1024]; ub4 recno = 0; sb4 errcode = 0; sb4 eg_errcode = 0; sword eg_status; if (!SvOK(errstr)) sv_setpv(errstr,""); if (!errhp) { sv_catpv(errstr, oci_status_name(status)); if (what) { sv_catpv(errstr, " "); sv_catpv(errstr, what); } return status; } while( ++recno && OCIErrorGet_log_stat(imp_xxh, errhp, recno, (text*)NULL, &eg_errcode, errbuf, (ub4)sizeof(errbuf), OCI_HTYPE_ERROR, eg_status) != OCI_NO_DATA && eg_status != OCI_INVALID_HANDLE && recno < 100) { if (debug >= 4 || recno>1/*XXX temp*/) PerlIO_printf(DBIc_LOGPIO(imp_xxh), " OCIErrorGet after %s (er%ld:%s): %d, %ld: %s\n", what ? what : "", (long)recno, (eg_status==OCI_SUCCESS) ? "ok" : oci_status_name(eg_status), status, (long)eg_errcode, errbuf); errcode = eg_errcode; sv_catpv(errstr, (char*)errbuf); if (*(SvEND(errstr)-1) == '\n') --SvCUR(errstr); } if (what || status != OCI_ERROR) { sv_catpv(errstr, (debug<0) ? " (" : " (DBD "); sv_catpv(errstr, oci_status_name(status)); if (what) { sv_catpv(errstr, ": "); sv_catpv(errstr, what); } sv_catpv(errstr, ")"); } return errcode; } int oci_error_err(SV *h, OCIError *errhp, sword status, char *what, sb4 force_err) { dTHX; D_imp_xxh(h); sb4 errcode; SV *errstr_sv = sv_newmortal(); SV *errcode_sv = sv_newmortal(); errcode = oci_error_get(imp_xxh, errhp, status, what, errstr_sv, DBIc_DBISTATE(imp_xxh)->debug); if (CSFORM_IMPLIES_UTF8(SQLCS_IMPLICIT)) { #ifdef sv_utf8_decode sv_utf8_decode(errstr_sv); #else SvUTF8_on(errstr_sv); #endif } /* DBIc_ERR *must* be SvTRUE (for RaiseError etc), some */ /* errors, like OCI_INVALID_HANDLE, don't set errcode. */ if (force_err) errcode = force_err; if (status == OCI_SUCCESS_WITH_INFO) errcode = 0; /* record as a "warning" for DBI>=1.43 */ else if (errcode == 0) errcode = (status != 0) ? status : -10000; sv_setiv(errcode_sv, errcode); DBIh_SET_ERR_SV(h, imp_xxh, errcode_sv, errstr_sv, &PL_sv_undef, &PL_sv_undef); return 0; /* always returns 0 */ } char * ora_sql_error(imp_sth_t *imp_sth, char *msg) { dTHX; #ifdef OCI_ATTR_PARSE_ERROR_OFFSET D_imp_dbh_from_sth; SV *msgsv, *sqlsv; char buf[99]; sword status = 0; ub2 parse_error_offset = 0; OCIAttrGet_stmhp_stat(imp_sth, &parse_error_offset, 0, OCI_ATTR_PARSE_ERROR_OFFSET, status); imp_dbh->parse_error_offset = parse_error_offset; if (!parse_error_offset) return msg; sprintf(buf,"error possibly near <*> indicator at char %d in '", parse_error_offset); msgsv = sv_2mortal(newSVpv(buf,0)); sqlsv = sv_2mortal(newSVpv(imp_sth->statement,0)); sv_insert(sqlsv, parse_error_offset, 0, "<*>", 3); sv_catsv(msgsv, sqlsv); sv_catpv(msgsv, "'"); return SvPV(msgsv,PL_na); #else imp_sth = imp_sth; /* not unused */ return msg; #endif } void * oci_db_handle(imp_dbh_t *imp_dbh, int handle_type, int flags) { dTHX; switch(handle_type) { case OCI_HTYPE_ENV: return imp_dbh->envhp; case OCI_HTYPE_ERROR: return imp_dbh->errhp; case OCI_HTYPE_SERVER: return imp_dbh->srvhp; case OCI_HTYPE_SVCCTX: return imp_dbh->svchp; case OCI_HTYPE_SESSION: return imp_dbh->seshp; /*case OCI_HTYPE_AUTHINFO:return imp_dbh->authp;*/ } croak("Can't get OCI handle type %d from DBI database handle", handle_type); if( flags ) {/* For GCC not to warn on unused parameter */} /* satisfy compiler warning, even though croak will never return */ return 0; } void * oci_st_handle(imp_sth_t *imp_sth, int handle_type, int flags) { dTHX; switch(handle_type) { case OCI_HTYPE_ENV: return imp_sth->envhp; case OCI_HTYPE_ERROR: return imp_sth->errhp; case OCI_HTYPE_SERVER: return imp_sth->srvhp; case OCI_HTYPE_SVCCTX: return imp_sth->svchp; case OCI_HTYPE_STMT: return imp_sth->stmhp; } croak("Can't get OCI handle type %d from DBI statement handle", handle_type); if( flags ) {/* For GCC not to warn on unused parameter */} /* satisfy compiler warning, even though croak will never return */ return 0; } int dbd_st_prepare(SV *sth, imp_sth_t *imp_sth, char *statement, SV *attribs) { dTHX; D_imp_dbh_from_sth; sword status = 0; IV ora_piece_size = 0; IV ora_pers_lob = 0; IV ora_piece_lob = 0; IV ora_clbk_lob = 0; int ora_check_sql = 1; /* to force a describe to check SQL */ IV ora_placeholders = 1; /* find and handle placeholders */ /* XXX we set ora_check_sql on for now to force setup of the */ /* row cache. Change later to set up row cache using just a */ /* a memory size, perhaps also default $RowCacheSize to a */ /* negative value. OCI_ATTR_PREFETCH_MEMORY */ if (!DBIc_ACTIVE(imp_dbh)) { oci_error(sth, NULL, OCI_ERROR, "Database disconnected"); return 0; } imp_dbh->parse_error_offset = 0; imp_sth->done_desc = 0; imp_sth->get_oci_handle = oci_st_handle; if (DBIc_COMPAT(imp_sth)) { static SV *ora_pad_empty; if (!ora_pad_empty) { ora_pad_empty= perl_get_sv("Oraperl::ora_pad_empty", GV_ADDMULTI); if (!SvOK(ora_pad_empty) && getenv("ORAPERL_PAD_EMPTY")) sv_setiv(ora_pad_empty, atoi(getenv("ORAPERL_PAD_EMPTY"))); } imp_sth->ora_pad_empty = (SvOK(ora_pad_empty)) ? SvIV(ora_pad_empty) : 0; } imp_sth->auto_lob = 1; imp_sth->exe_mode = OCI_DEFAULT; if (attribs) { SV **svp; IV ora_auto_lob = 1; DBD_ATTRIB_GET_IV( attribs, "ora_placeholders", 16, svp, ora_placeholders); DBD_ATTRIB_GET_IV( attribs, "ora_auto_lob", 12, svp, ora_auto_lob); DBD_ATTRIB_GET_IV( attribs, "ora_pers_lob", 12, svp, ora_pers_lob); DBD_ATTRIB_GET_IV( attribs, "ora_clbk_lob", 12, svp, ora_clbk_lob); DBD_ATTRIB_GET_IV( attribs, "ora_piece_lob", 13, svp, ora_piece_lob); DBD_ATTRIB_GET_IV( attribs, "ora_piece_size", 14, svp, ora_piece_size); imp_sth->auto_lob = (ora_auto_lob) ? 1 : 0; imp_sth->pers_lob = (ora_pers_lob) ? 1 : 0; imp_sth->clbk_lob = (ora_clbk_lob) ? 1 : 0; imp_sth->piece_lob = (ora_piece_lob) ? 1 : 0; imp_sth->piece_size = (ora_piece_size) ? ora_piece_size : 0; imp_sth->prefetch_rows = 0; imp_sth->prefetch_memory= 0; /* ora_check_sql only works for selects owing to Oracle behaviour */ DBD_ATTRIB_GET_IV( attribs, "ora_check_sql", 13, svp, ora_check_sql); DBD_ATTRIB_GET_IV( attribs, "ora_exe_mode", 12, svp, imp_sth->exe_mode); DBD_ATTRIB_GET_IV( attribs, "ora_prefetch_memory", 19, svp, imp_sth->prefetch_memory); DBD_ATTRIB_GET_IV( attribs, "ora_prefetch_rows", 17, svp, imp_sth->prefetch_rows); DBD_ATTRIB_GET_IV( attribs, "ora_row_cache_off", 17, svp, imp_sth->row_cache_off); DBD_ATTRIB_GET_IV( attribs, "ora_verbose", 11, svp, dbd_verbose); DBD_ATTRIB_GET_IV( attribs, "ora_oci_success_warn", 20, svp, oci_warn); DBD_ATTRIB_GET_IV( attribs, "ora_objects", 11, svp, ora_objects); DBD_ATTRIB_GET_IV( attribs, "ora_ncs_buff_mtpl", 17, svp,ora_ncs_buff_mtpl); DBD_ATTRIB_GET_IV( attribs, "RowCacheSize",12,svp, imp_sth->RowCacheSize); if (!dbd_verbose) DBD_ATTRIB_GET_IV( attribs, "dbd_verbose", 11, svp, dbd_verbose); } /* scan statement for '?', ':1' and/or ':foo' style placeholders */ if (ora_placeholders) dbd_preparse(imp_sth, statement); else imp_sth->statement = savepv(statement); imp_sth->envhp = imp_dbh->envhp; imp_sth->errhp = imp_dbh->errhp; imp_sth->srvhp = imp_dbh->srvhp; imp_sth->svchp = imp_dbh->svchp; OCIHandleAlloc_ok(imp_dbh, imp_dbh->envhp, &imp_sth->stmhp, OCI_HTYPE_STMT, status); OCIStmtPrepare_log_stat(imp_sth, imp_sth->stmhp, imp_sth->errhp, (text*)imp_sth->statement, (ub4)strlen(imp_sth->statement), OCI_NTV_SYNTAX, OCI_DEFAULT, status); if (status != OCI_SUCCESS) { oci_error(sth, imp_sth->errhp, status, "OCIStmtPrepare"); OCIHandleFree_log_stat(imp_sth, imp_sth->stmhp, OCI_HTYPE_STMT, status); return 0; } OCIAttrGet_stmhp_stat(imp_sth, &imp_sth->stmt_type, 0, OCI_ATTR_STMT_TYPE, status); if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " dbd_st_prepare'd sql %s ( auto_lob%d, check_sql%d)\n", oci_stmt_type_name(imp_sth->stmt_type), imp_sth->auto_lob, ora_check_sql); DBIc_IMPSET_on(imp_sth); if (ora_check_sql) { if (!dbd_describe(sth, imp_sth)) return 0; } return 1; } sb4 dbd_phs_in(dvoid *octxp, OCIBind *bindp, ub4 iter, ub4 index, dvoid **bufpp, ub4 *alenp, ub1 *piecep, dvoid **indpp) { dTHX; phs_t *phs = (phs_t*)octxp; STRLEN phs_len; AV *tuples_av; SV *sv; AV *av; SV **sv_p; if( bindp ){ /* For GCC not to warn on unused parameter*/ } tuples_av = phs->imp_sth->bind_tuples; if(tuples_av) { /* NOTE: we already checked the validity in ora_st_bind_for_array_exec(). */ sv_p = av_fetch(tuples_av, phs->imp_sth->rowwise ? (int)iter : phs->idx, 0); av = (AV*)SvRV(*sv_p); sv_p = av_fetch(av, phs->imp_sth->rowwise ? phs->idx : (int)iter, 0); sv = *sv_p; if(SvOK(sv)) { *bufpp = SvPV(sv, phs_len); phs->alen = (phs->alen_incnull) ? phs_len+1 : phs_len; phs->indp = 0; } else { *bufpp = SvPVX(sv); phs->alen = 0; phs->indp = -1; } } else if (phs->desc_h) { *bufpp = phs->desc_h; phs->alen = 0; phs->indp = 0; } else if (SvOK(phs->sv)) { *bufpp = SvPV(phs->sv, phs_len); phs->alen = (phs->alen_incnull) ? phs_len+1 : phs_len;; phs->indp = 0; } else { *bufpp = SvPVX(phs->sv); /* not actually used? */ phs->alen = 0; phs->indp = -1; } *alenp = phs->alen; *indpp = &phs->indp; *piecep = OCI_ONE_PIECE; /* MJE commented out as we are avoiding DBIS now but as this is an Oracle callback there is no way to pass something non OCI into this func. if (DBIS->debug >= 3 || dbd_verbose >= 3 ) PerlIO_printf(DBILOGFP, " in '%s' [%lu,%lu]: len %2lu, ind %d%s, value=%s\n", phs->name, ul_t(iter), ul_t(index), ul_t(phs->alen), phs->indp, (phs->desc_h) ? " via descriptor" : "",neatsvpv(phs->sv,10)); */ if (!tuples_av && (index > 0 || iter > 0)) croak(" Arrays and multiple iterations not currently supported by DBD::Oracle (in %d/%d)", index,iter); return OCI_CONTINUE; } /* ``Binding and Defining'' Binding RETURNING...INTO variables As mentioned in the previous section, an OCI application implements the placeholders in the RETURNING clause as pure OUT bind variables. An application must adhere to the following rules when working with these bind variables: 1.Bind RETURNING clause placeholders in OCI_DATA_AT_EXEC mode using OCIBindByName() or OCIBindByPos(), followed by a call to OCIBindDynamic() for each placeholder. Note: The OCI only supports the callback mechanism for RETURNING clause binds. The polling mechanism is not supported. 2.When binding RETURNING clause placeholders, you must supply a valid out bind function as the ocbfp parameter of the OCIBindDynamic() call. This function must provide storage to hold the returned data. 3.The icbfp parameter of OCIBindDynamic() call should provide a "dummy" function which returns NULL values when called. 4.The piecep parameter of OCIBindDynamic() must be set to OCI_ONE_PIECE. 5.No duplicate binds are allowed in a DML statement with a RETURNING clause (i.e., no duplication between bind variables in the DML section and the RETURNING section of the statement). When a callback function is called, the OCI_ATTR_ROWS_RETURNED attribute of the bind handle tells the application the number of rows being returned in that particular iteration. Thus, when the callback is called the first time in a particular iteration (i.e., index=0), the user can allocate space for all the rows which will be returned for that bind variable. When the callback is called subsequently (with index>0) within the same iteration, the user can merely increment the buffer pointer to the correct memory within the allocated space to retrieve the data. Every bind handle has a OCI_ATTR_MAXDATA_SIZE attribute. This attribute specifies the number of bytes to be allocated on the server to accommodate the client-side bind data after any necessary character set conversions. Note: Character set conversions performed when data is sent to the server may result in the data expanding or contracting, so its size on the client may not be the same as its size on the server. An application will typically set OCI_ATTR_MAXDATA_SIZE to the maximum size of the column or the size of the PL/SQL variable, depending on how it is used. Oracle issues an error if OCI_ATTR_MAXDATA_SIZE is not a large enough value to accommodate the data after conversion, and the operation will fail. */ sb4 dbd_phs_out(dvoid *octxp, OCIBind *bindp, ub4 iter, /* execution itteration (0...) */ ub4 index, /* array index (0..) */ dvoid **bufpp, /* A pointer to a buffer to write the bind value/piece. */ ub4 **alenpp, /* A pointer to a storage for OCI to fill in the size */ /* of the bind value/piece after it has been read. */ ub1 *piecep, /* */ dvoid **indpp, /* Return a pointer to contain the indicator value which either an sb2 */ /* value or a pointer to an indicator structure for named data types. */ ub2 **rcodepp) /* Returns a pointer to contains the return code. */ { dTHX; phs_t *phs = (phs_t*)octxp; /* context */ /*imp_sth_t *imp_sth = phs->imp_sth;*/ if( bindp ) { /* For GCC not to warn on unused parameter */ } if (phs->desc_h) { /* a descriptor if present (LOBs etc)*/ *bufpp = phs->desc_h; phs->alen = 0; } else { SV *sv = phs->sv; if (SvTYPE(sv) == SVt_RV && SvTYPE(SvRV(sv)) == SVt_PVAV) { sv = *av_fetch((AV*)SvRV(sv), (IV)iter, 1); if (!SvOK(sv)) sv_setpv(sv,""); } *bufpp = SvGROW(sv, (size_t)(((phs->maxlen < 28) ? 28 : phs->maxlen))); phs->alen = SvLEN(sv); /* max buffer size now, actual data len later */ } *alenpp = &phs->alen; *indpp = &phs->indp; *rcodepp= &phs->arcode; /* MJE commented out as we are avoiding DBIS now but as this is an Oracle callback there is no way to pass something non OCI into this func. if (DBIS->debug >= 3 || dbd_verbose >= 3 ) PerlIO_printf(DBILOGFP, " out '%s' [%ld,%ld]: alen %2ld, piece %d%s\n", phs->name, ul_t(iter), ul_t(index), ul_t(phs->alen), *piecep, (phs->desc_h) ? " via descriptor" : ""); */ *piecep = OCI_ONE_PIECE; return OCI_CONTINUE; } /* -------------------------------------------------------------- Fetch callback fill buffers. Finaly figured out how this fucntion works Seems it is like this. The function inits and then fills the buffer (fb_ary->abuf) with the data from the select until it either runs out of data or its piece size is reached (fb_ary->bufl). If its piece size is reached it then goes and gets the the next piece and sets *piecep ==OCI_NEXT_PIECE at this point I take the data in the buffer and memcpy it onto my buffer (fb_ary->cb_abuf). This will go on until it runs out of full pieces so when it returns to back to the fetch I add what remains in (fb_ary->bufl) (the last piece) and memcpy onto my buffer (fb_ary->cb_abuf) to get it all. I also take set fb_ary->cb_abuf back to empty just to keep things clean -------------------------------------------------------------- */ sb4 presist_lob_fetch_cbk(dvoid *octxp, OCIDefine *dfnhp, ub4 iter, dvoid **bufpp, ub4 **alenpp, ub1 *piecep, dvoid **indpp, ub2 **rcpp) { dTHX; imp_fbh_t *fbh =(imp_fbh_t*)octxp; fb_ary_t *fb_ary; fb_ary = fbh->fb_ary; *bufpp = (dvoid *) fb_ary->abuf; *alenpp = &fb_ary->bufl; *indpp = (dvoid *) fb_ary->aindp; *rcpp = fb_ary->arcode; if (dbd_verbose >= 5 ) { PerlIO_printf(DBILOGFP, " In presist_lob_fetch_cbk\n"); } if ( *piecep ==OCI_NEXT_PIECE ){/*more than one piece*/ memcpy(fb_ary->cb_abuf+fb_ary->piece_count*fb_ary->bufl,fb_ary->abuf,fb_ary->bufl ); /*as we will be using both blobs and clobs we have to use pointer arithmetic to get the values right. in this case we simply copy all of the memory of the buff into the cb buffer starting at the piece count * the buffer length */ fb_ary->piece_count++;/*used to tell me how many pieces I have, Might be able to use aindp for this?*/ } return OCI_CONTINUE; } /* TAF or Transparent Application Failoever callback Works like this. The fuction below is registered on the server, when the server is set up to use it, when an exe is called (not sure about other server round trips) and the server fails tt should get into this cbk error below. It will wait X seconds and then try to reconnect (up to n times if that is the users choice) That is how I see it working */ sb4 taf_cbk(dvoid *svchp, dvoid *envhp, dvoid *fo_ctx,ub4 fo_type, ub4 fo_event ) { dTHX; int return_count; int ret; taf_callback_t *cb =(taf_callback_t*)fo_ctx; dSP; PUSHMARK(SP); XPUSHs(sv_2mortal(newSViv(fo_event))); XPUSHs(sv_2mortal(newSViv(fo_type))); XPUSHs(SvRV(cb->dbh_ref)); PUTBACK; return_count = call_sv(cb->function, G_SCALAR); SPAGAIN; if (return_count != 1) croak("Expected one scalar back from taf handler"); ret = POPi; switch (fo_event){ case OCI_FO_BEGIN: case OCI_FO_ABORT: case OCI_FO_END: case OCI_FO_REAUTH: { break; } case OCI_FO_ERROR: { if (ret == OCI_FO_RETRY) { return OCI_FO_RETRY; } break; } default: { break; } } PUTBACK; return 0; } sb4 reg_taf_callback(SV *dbh, imp_dbh_t *imp_dbh) { dTHX; OCIFocbkStruct tafailover; sword status; imp_dbh->taf_ctx.function = imp_dbh->taf_function; imp_dbh->taf_ctx.dbh_ref = newRV_inc(dbh); if (dbd_verbose >= 5 ) { PerlIO_printf(DBIc_LOGPIO(imp_dbh), " In reg_taf_callback\n"); } /* set the context up as a pointer to the taf callback struct*/ tafailover.fo_ctx = &imp_dbh->taf_ctx; tafailover.callback_function = &taf_cbk; /* register the callback */ OCIAttrSet_log_stat(imp_dbh, imp_dbh->srvhp, (ub4) OCI_HTYPE_SERVER, (dvoid *) &tafailover, (ub4) 0, (ub4) OCI_ATTR_FOCBK, imp_dbh->errhp, status); return status; } #ifdef UTF8_SUPPORT /* How many bytes are n utf8 chars in buffer */ static ub4 ora_utf8_to_bytes (ub1 *buffer, ub4 chars_wanted, ub4 max_bytes) { dTHX; ub4 i = 0; while (i < max_bytes && (chars_wanted-- > 0)) { i += UTF8SKIP(&buffer[i]); } return (i < max_bytes)? i : max_bytes; } #if 0 /* save this for later just in case... */ /* Given the 5.6.0 implementation of utf8 handling in perl, * avoid setting the UTF8 flag as much as possible. Almost * every binary operator in Perl will do conversions when * strings marked as UTF8 are involved. * Maybe setting the flag should be default in Japan or * Europe? Deduce that from NLS_LANG? Possibly... */ int set_utf8(SV *sv) { ub1 *c; for (c = (ub1*)SvPVX(sv); c < (ub1*)SvEND(sv); c++) { if (*c & 0x80) { SvUTF8_on(sv); return 1; } } return 0; } #endif #endif /* PerlIO_printf(DBILOGFP, "lab datalen=%d long_readlen=%d bytelen=%d\n" ,datalen ,imp_sth->long_readlen, bytelen ); */ static int /* LONG and LONG RAW */ fetch_func_varfield(SV *sth, imp_fbh_t *fbh, SV *dest_sv) { dTHX; D_imp_sth(sth); D_imp_dbh_from_sth ; D_imp_drh_from_dbh ; fb_ary_t *fb_ary = fbh->fb_ary; char *p = (char*)&fb_ary->abuf[0]; ub4 datalen = *(ub4*)p; /* XXX alignment ? */ p += 4; #ifdef UTF8_SUPPORT if (fbh->ftype == 94) { if (datalen > imp_sth->long_readlen) { ub4 bytelen = ora_utf8_to_bytes((ub1*)p, (ub4)imp_sth->long_readlen, datalen); if (bytelen < datalen ) { /* will be truncated */ int oraperl = DBIc_COMPAT(imp_sth); if (DBIc_has(imp_sth,DBIcf_LongTruncOk) || (oraperl && SvIV(imp_drh->ora_trunc))) { /* user says truncation is ok */ /* Oraperl recorded the truncation in ora_errno so we */ /* so also but only for Oraperl mode handles. */ if (oraperl) sv_setiv(DBIc_ERR(imp_sth), 1406); } else { char buf[300]; sprintf(buf,"fetching field %d of %d. LONG value truncated from %lu to %lu. %s", fbh->field_num+1, DBIc_NUM_FIELDS(imp_sth), ul_t(datalen), ul_t(bytelen), "DBI attribute LongReadLen too small and/or LongTruncOk not set"); oci_error_err(sth, NULL, OCI_ERROR, buf, 24345); /* appropriate ORA error number */ sv_set_undef(dest_sv); return 0; } if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " fetching field %d of %d. LONG value truncated from " "%lu to %lu.\n", fbh->field_num+1, DBIc_NUM_FIELDS(imp_sth), ul_t(datalen), ul_t(bytelen)); datalen = bytelen; } } sv_setpvn(dest_sv, p, (STRLEN)datalen); if (CSFORM_IMPLIES_UTF8(fbh->csform)) SvUTF8_on(dest_sv); } else { #else { #endif sv_setpvn(dest_sv, p, (STRLEN)datalen); } return 1; } static void fetch_cleanup_rset(SV *sth, imp_fbh_t *fbh) { dTHX; D_imp_sth(sth); SV *sth_nested = (SV *)fbh->special; fbh->special = NULL; if( sth ) { /* For GCC not to warn on unused parameter */ } if (sth_nested) { dTHR; D_impdata(imp_sth_nested, imp_sth_t, sth_nested); int fields = DBIc_NUM_FIELDS(imp_sth_nested); int i; for(i=0; i < fields; ++i) { imp_fbh_t *fbh_nested = &imp_sth_nested->fbh[i]; if (fbh_nested->fetch_cleanup) fbh_nested->fetch_cleanup(sth_nested, fbh_nested); } if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) PerlIO_printf(DBIc_LOGPIO(imp_sth), " fetch_cleanup_rset - deactivating handle %s (defunct nested cursor)\n", neatsvpv(sth_nested, 0)); DBIc_ACTIVE_off(imp_sth_nested); SvREFCNT_dec(sth_nested); } } static int fetch_func_rset(SV *sth, imp_fbh_t *fbh, SV *dest_sv) { dTHX; OCIStmt *stmhp_nested = ((OCIStmt **)fbh->fb_ary->abuf)[0]; dTHR; D_imp_sth(sth); D_imp_dbh_from_sth; dSP; HV *init_attr = newHV(); int count; if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " fetch_func_rset - allocating handle for cursor nested within %s ...\n", neatsvpv(sth, 0)); ENTER; SAVETMPS; PUSHMARK(SP); XPUSHs(sv_2mortal(newRV((SV*)DBIc_MY_H(imp_dbh)))); XPUSHs(sv_2mortal(newRV((SV*)init_attr))); PUTBACK; count = perl_call_pv("DBI::_new_sth", G_ARRAY); SPAGAIN; if (count != 2) croak("panic: DBI::_new_sth returned %d values instead of 2", count); if(POPs){} /* For GCC not to warn on unused result */ sv_setsv(dest_sv, POPs); SvREFCNT_dec(init_attr); PUTBACK; FREETMPS; LEAVE; if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " fetch_func_rset - ... allocated %s for nested cursor\n", neatsvpv(dest_sv, 0)); fbh->special = (void *)newSVsv(dest_sv); { D_impdata(imp_sth_nested, imp_sth_t, dest_sv); imp_sth_nested->envhp = imp_sth->envhp; imp_sth_nested->errhp = imp_sth->errhp; imp_sth_nested->srvhp = imp_sth->srvhp; imp_sth_nested->svchp = imp_sth->svchp; imp_sth_nested->stmhp = stmhp_nested; imp_sth_nested->nested_cursor = 1; imp_sth_nested->stmt_type = OCI_STMT_SELECT; DBIc_IMPSET_on(imp_sth_nested); DBIc_ACTIVE_on(imp_sth_nested); /* So describe won't do an execute */ if (!dbd_describe(dest_sv, imp_sth_nested)) return 0; } return 1; } /* ------ */ int dbd_rebind_ph_rset(SV *sth, imp_sth_t *imp_sth, phs_t *phs) { dTHX; if (DBIc_DBISTATE(imp_sth)->debug >= 6 || dbd_verbose >= 6 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " dbd_rebind_ph_rset phs->is_inout=%d\n", phs->is_inout); /* Only do this part for inout cursor refs because pp_exec_rset only gets called for all the output params */ if (phs->is_inout) { phs->out_prepost_exec = pp_exec_rset; return 2; /* OCI bind done */ } else { /* Call a special rebinder for cursor ref "in" params */ return(pp_rebind_ph_rset_in(sth, imp_sth, phs)); } } /* ------ */ static int fetch_lob(SV *sth, imp_sth_t *imp_sth, OCILobLocator* lobloc, int ftype, SV *dest_sv, char *name); static int lob_phs_post_execute(SV *sth, imp_sth_t *imp_sth, phs_t *phs, int pre_exec) { dTHX; if (pre_exec) return 1; /* fetch PL/SQL LOB data */ if (imp_sth->auto_lob && ( imp_sth->stmt_type == OCI_STMT_BEGIN || imp_sth->stmt_type == OCI_STMT_DECLARE )) { return fetch_lob(sth, imp_sth, (OCILobLocator*) phs->desc_h, phs->ftype, phs->sv, phs->name); } sv_setref_pv(phs->sv, "OCILobLocatorPtr", (void*)phs->desc_h); return 1; } int dbd_rebind_ph_lob(SV *sth, imp_sth_t *imp_sth, phs_t *phs) { dTHX; D_imp_dbh_from_sth ; sword status; ub4 lobEmpty = 0; if (phs->desc_h && phs->desc_t == OCI_DTYPE_LOB) ora_free_templob(sth, imp_sth, (OCILobLocator*)phs->desc_h); if (!phs->desc_h) { ++imp_sth->has_lobs; phs->desc_t = OCI_DTYPE_LOB; OCIDescriptorAlloc_ok(imp_sth, imp_sth->envhp, &phs->desc_h, phs->desc_t); } OCIAttrSet_log_stat(imp_sth, phs->desc_h, phs->desc_t, &lobEmpty, 0, OCI_ATTR_LOBEMPTY, imp_sth->errhp, status); if (status != OCI_SUCCESS) return oci_error(sth, imp_sth->errhp, status, "OCIAttrSet OCI_ATTR_LOBEMPTY"); if (!SvPOK(phs->sv)) { /* normalizations for special cases */ if (SvOK(phs->sv)) { /* ie a number, convert to string ASAP */ if (!(SvROK(phs->sv) && phs->is_inout)) sv_2pv(phs->sv, &PL_na); } else { /* ensure we're at least an SVt_PV (so SvPVX etc work) */ (void)SvUPGRADE(phs->sv, SVt_PV); } } phs->indp = (SvOK(phs->sv)) ? 0 : -1; phs->progv = (char*)&phs->desc_h; phs->maxlen = sizeof(OCILobLocator*); if (phs->is_inout) phs->out_prepost_exec = lob_phs_post_execute; /* accept input LOBs */ if (sv_isobject(phs->sv) && sv_derived_from(phs->sv, "OCILobLocatorPtr")) { OCILobLocator *src; OCILobLocator **dest; src = INT2PTR(OCILobLocator *, SvIV(SvRV(phs->sv))); dest = (OCILobLocator **) phs->progv; OCILobLocatorAssign_log_stat(imp_dbh, imp_dbh->svchp, imp_sth->errhp, src, dest, status); if (status != OCI_SUCCESS) { oci_error(sth, imp_sth->errhp, status, "OCILobLocatorAssign"); return 0; } } /* create temporary LOB for PL/SQL placeholder */ else if (imp_sth->stmt_type == OCI_STMT_BEGIN || imp_sth->stmt_type == OCI_STMT_DECLARE) { ub4 amtp; (void)SvUPGRADE(phs->sv, SVt_PV); amtp = SvCUR(phs->sv); /* XXX UTF8? */ /* Create a temp lob for non-empty string */ if (amtp > 0) { ub1 lobtype = (phs->ftype == 112 ? OCI_TEMP_CLOB : OCI_TEMP_BLOB); OCILobCreateTemporary_log_stat(imp_dbh, imp_dbh->svchp, imp_sth->errhp, (OCILobLocator *) phs->desc_h, (ub2) OCI_DEFAULT, (ub1) OCI_DEFAULT, lobtype, TRUE, OCI_DURATION_SESSION, status); if (status != OCI_SUCCESS) { oci_error(sth, imp_sth->errhp, status, "OCILobCreateTemporary"); return 0; } if( ! phs->csid ) { ub1 csform = SQLCS_IMPLICIT; ub2 csid = 0; OCILobCharSetForm_log_stat(imp_sth, imp_sth->envhp, imp_sth->errhp, (OCILobLocator*)phs->desc_h, &csform, status ); if (status != OCI_SUCCESS) return oci_error(sth, imp_sth->errhp, status, "OCILobCharSetForm"); #ifdef OCI_ATTR_CHARSET_ID /* Effectively only used so AL32UTF8 works properly */ OCILobCharSetId_log_stat(imp_sth, imp_sth->envhp, imp_sth->errhp, (OCILobLocator*)phs->desc_h, &csid, status ); if (status != OCI_SUCCESS) return oci_error(sth, imp_sth->errhp, status, "OCILobCharSetId"); #endif /* OCI_ATTR_CHARSET_ID */ /* if data is utf8 but charset isn't then switch to utf8 csid */ csid = (SvUTF8(phs->sv) && !CS_IS_UTF8(csid)) ? utf8_csid : CSFORM_IMPLIED_CSID(csform); phs->csid = csid; phs->csform = csform; } if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " calling OCILobWrite phs->csid=%d phs->csform=%d amtp=%d\n", phs->csid, phs->csform, amtp ); /* write lob data */ OCILobWrite_log_stat(imp_sth, imp_sth->svchp, imp_sth->errhp, (OCILobLocator*)phs->desc_h, &amtp, 1, SvPVX(phs->sv), amtp, OCI_ONE_PIECE, 0,0, phs->csid, phs->csform, status); if (status != OCI_SUCCESS) { return oci_error(sth, imp_sth->errhp, status, "OCILobWrite in dbd_rebind_ph_lob"); } } } return 1; } #ifdef UTF8_SUPPORT ub4 ora_blob_read_mb_piece(SV *sth, imp_sth_t *imp_sth, imp_fbh_t *fbh, SV *dest_sv, long offset, ub4 len, long destoffset) { dTHX; ub4 loblen = 0; ub4 buflen; ub4 amtp = 0; ub4 byte_destoffset = 0; OCILobLocator *lobl = (OCILobLocator*)fbh->desc_h; sword ftype = fbh->ftype; sword status; /* * We assume our caller has already done the * equivalent of the following: * (void)SvUPGRADE(dest_sv, SVt_PV); */ ub1 csform = SQLCS_IMPLICIT; OCILobCharSetForm_log_stat(imp_sth, imp_sth->envhp, imp_sth->errhp, lobl, &csform, status ); if (status != OCI_SUCCESS) { oci_error(sth, imp_sth->errhp, status, "OCILobCharSetForm"); sv_set_undef(dest_sv); /* signal error */ return 0; } if (ftype != ORA_CLOB) { oci_error(sth, imp_sth->errhp, OCI_ERROR, "blob_read not currently supported for non-CLOB types with OCI 8 " "(but with OCI 8 you can set $dbh->{LongReadLen} to the length you need," "so you don't need to call blob_read at all)"); sv_set_undef(dest_sv); /* signal error */ return 0; } OCILobGetLength_log_stat(imp_sth, imp_sth->svchp, imp_sth->errhp, lobl, &loblen, status); if (status != OCI_SUCCESS) { oci_error(sth, imp_sth->errhp, status, "OCILobGetLength ora_blob_read_mb_piece"); sv_set_undef(dest_sv); /* signal error */ return 0; } loblen -= offset; /* only count from offset onwards */ amtp = (loblen > len) ? len : loblen; buflen = 4 * amtp; byte_destoffset = ora_utf8_to_bytes((ub1 *)(SvPVX(dest_sv)), (ub4)destoffset, SvCUR(dest_sv)); if (loblen > 0) { ub1 *dest_bufp; ub1 *buffer; New(42, buffer, buflen, ub1); OCILobRead_log_stat(imp_sth, imp_sth->svchp, imp_sth->errhp, lobl, &amtp, (ub4)1 + offset, buffer, buflen, 0, 0, (ub2)0 ,csform ,status ); /* lab 0, 0, (ub2)0, (ub1)SQLCS_IMPLICIT, status); */ if (dbis->debug >= 3 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " OCILobRead field %d %s: LOBlen %lu, LongReadLen %lu, " "BufLen %lu, Got %lu\n", fbh->field_num+1, oci_status_name(status), ul_t(loblen), ul_t(imp_sth->long_readlen), ul_t(buflen), ul_t(amtp)); if (status != OCI_SUCCESS) { oci_error(sth, imp_sth->errhp, status, "OCILobRead"); sv_set_undef(dest_sv); /* signal error */ return 0; } amtp = ora_utf8_to_bytes(buffer, len, amtp); SvGROW(dest_sv, byte_destoffset + amtp + 1); dest_bufp = (ub1 *)(SvPVX(dest_sv)); dest_bufp += byte_destoffset; memcpy(dest_bufp, buffer, amtp); Safefree(buffer); } else { assert(amtp == 0); SvGROW(dest_sv, byte_destoffset + 1); if (dbis->debug >= 3 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " OCILobRead field %d %s: LOBlen %lu, LongReadLen %lu, " "BufLen %lu, Got %lu\n", fbh->field_num+1, "SKIPPED", (unsigned long)loblen, (unsigned long)imp_sth->long_readlen, (unsigned long)buflen, (unsigned long)amtp); } if (dbis->debug >= 3 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " blob_read field %d, ftype %d, offset %ld, len %lu, " "destoffset %ld, retlen %lu\n", fbh->field_num+1, ftype, offset, len, destoffset, ul_t(amtp)); SvCUR_set(dest_sv, byte_destoffset+amtp); *SvEND(dest_sv) = '\0'; /* consistent with perl sv_setpvn etc */ SvPOK_on(dest_sv); if (ftype == ORA_CLOB && CSFORM_IMPLIES_UTF8(csform)) SvUTF8_on(dest_sv); return 1; } #endif /* ifdef UTF8_SUPPORT */ ub4 ora_blob_read_piece(SV *sth, imp_sth_t *imp_sth, imp_fbh_t *fbh, SV *dest_sv, long offset, UV len, long destoffset) { dTHX; ub4 loblen = 0; ub4 buflen; ub4 amtp = 0; ub1 csform = 0; OCILobLocator *lobl = (OCILobLocator*)fbh->desc_h; sword ftype = fbh->ftype; sword status; char *type_name; if (ftype == ORA_CLOB) type_name = "CLOB"; else if (ftype == ORA_BLOB) type_name = "BLOB"; else if (ftype == ORA_BFILE) type_name = "BFILE"; else { oci_error(sth, imp_sth->errhp, OCI_ERROR, "blob_read not currently supported for non-LOB types with OCI 8 " "(but with OCI 8 you can set $dbh->{LongReadLen} to the length you need," "so you don't need to call blob_read at all)"); sv_set_undef(dest_sv); /* signal error */ return 0; } OCILobGetLength_log_stat(imp_sth, imp_sth->svchp, imp_sth->errhp, lobl, &loblen, status); if (status != OCI_SUCCESS) { oci_error(sth, imp_sth->errhp, status, "OCILobGetLength ora_blob_read_piece"); sv_set_undef(dest_sv); /* signal error */ return 0; } OCILobCharSetForm_log_stat(imp_sth, imp_sth->envhp, imp_sth->errhp, lobl, &csform, status ); if (status != OCI_SUCCESS) { oci_error(sth, imp_sth->errhp, status, "OCILobCharSetForm"); sv_set_undef(dest_sv); /* signal error */ return 0; } if (ftype == ORA_CLOB && csform == SQLCS_NCHAR) type_name = "NCLOB"; /* * We assume our caller has already done the * equivalent of the following: * (void)SvUPGRADE(dest_sv, SVt_PV); * SvGROW(dest_sv, buflen+destoffset+1); */ /* amtp is: LOB/BFILE CLOB/NCLOB Input bytes characters Output FW bytes characters (FW=Fixed Width charset, VW=Variable) Output VW bytes characters(in), bytes returned (afterwards) */ amtp = (loblen > len) ? len : loblen; /* buflen: length of buffer in bytes */ /* so for CLOBs that'll be returned as UTF8 we need more bytes that chars */ /* XXX the x4 here isn't perfect - really the code should be changed to loop */ if (ftype == ORA_CLOB && CSFORM_IMPLIES_UTF8(csform)) { buflen = amtp * 4; /* XXX destoffset would be counting chars here as well */ SvGROW(dest_sv, (destoffset*4) + buflen + 1); if (destoffset) { oci_error(sth, imp_sth->errhp, OCI_ERROR, "blob_read with non-zero destoffset not currently supported for UTF8 values"); sv_set_undef(dest_sv); /* signal error */ return 0; } } else { buflen = amtp; } if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " blob_read field %d: ftype %d %s, offset %ld, len %lu." "LOB csform %d, len %lu, amtp %lu, (destoffset=%ld)\n", fbh->field_num+1, ftype, type_name, offset, ul_t(len), csform,(unsigned long) (loblen), ul_t(amtp), destoffset); if (loblen > 0) { ub1 * bufp = (ub1 *)(SvPVX(dest_sv)); bufp += destoffset; OCILobRead_log_stat(imp_sth, imp_sth->svchp, imp_sth->errhp, lobl, &amtp, (ub4)1 + offset, bufp, buflen, 0, 0, (ub2)0 , csform, status); if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " OCILobRead field %d %s: LOBlen %lu, LongReadLen %lu," "BufLen %lu, amtp %lu\n", fbh->field_num+1, oci_status_name(status), ul_t(loblen), ul_t(imp_sth->long_readlen), ul_t(buflen), ul_t(amtp)); if (status != OCI_SUCCESS) { oci_error(sth, imp_sth->errhp, status, "OCILobRead"); sv_set_undef(dest_sv); /* signal error */ return 0; } if (ftype == ORA_CLOB && CSFORM_IMPLIES_UTF8(csform)) SvUTF8_on(dest_sv); } else { assert(amtp == 0); if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " OCILobRead field %d %s: LOBlen %lu, LongReadLen %lu, " "BufLen %lu, Got %lu\n", fbh->field_num+1, "SKIPPED", ul_t(loblen), ul_t(imp_sth->long_readlen), ul_t(buflen), ul_t(amtp)); } /* * We assume our caller will perform * the equivalent of the following: * SvCUR(dest_sv) = amtp; * *SvEND(dest_sv) = '\0'; * SvPOK_on(dest_sv); */ return(amtp); } static int fetch_lob(SV *sth, imp_sth_t *imp_sth, OCILobLocator* lobloc, int ftype, SV *dest_sv, char *name) { dTHX; ub4 loblen = 0; ub4 buflen = 0; ub4 amtp = 0; sword status; if (!name) name = "an unknown field"; /* this function is not called for NULL lobs */ /* The length is expressed in terms of bytes for BLOBs and BFILEs, */ /* and in terms of characters for CLOBs and NCLOBS */ OCILobGetLength_log_stat(imp_sth, imp_sth->svchp, imp_sth->errhp, lobloc, &loblen, status); if (status != OCI_SUCCESS) { oci_error(sth, imp_sth->errhp, status, "OCILobGetLength fetch_lob"); return 0; } if (loblen > imp_sth->long_readlen) { /* LOB will be truncated */ int oraperl = DBIc_COMPAT(imp_sth); D_imp_dbh_from_sth ; D_imp_drh_from_dbh ; /* move setting amtp up to ensure error message OK */ amtp = imp_sth->long_readlen; if (DBIc_has(imp_sth,DBIcf_LongTruncOk) || (oraperl && SvIV(imp_drh -> ora_trunc))) { /* user says truncation is ok */ /* Oraperl recorded the truncation in ora_errno so we */ /* so also but only for Oraperl mode handles. */ if (oraperl) sv_setiv(DBIc_ERR(imp_sth), 1406); } else { char buf[300]; sprintf(buf,"fetching %s. LOB value truncated from %ld to %ld. %s", name, ul_t(loblen), ul_t(amtp), "DBI attribute LongReadLen too small and/or LongTruncOk not set"); oci_error_err(sth, NULL, OCI_ERROR, buf, 24345); /* appropriate ORA error number */ sv_set_undef(dest_sv); return 0; } } else amtp = loblen; (void)SvUPGRADE(dest_sv, SVt_PV); /* XXXX I've hacked on this and left it probably broken because I didn't have time to research which args to OCI funcs need to be in char or byte units. That still needs to be done. better variable names may help. (The old version (1.15) duplicated too much code here because I applied a contributed patch that wasn't ideal, I had too little time to sort it out.) Whatever is done here, similar changes are probably needed for the ora_lob_*() methods when handling CLOBs. */ /* Yep you did bust it good and bad. Seem that when the charset of the client and the DB are comptiable the buflen and amtp are both in chars no matter how many bytes make up the chars. If it is the case were the Client's NLS_LANG or NLS_NCHAR is not a subset of the Server's the server will try to traslate the data to the Client's wishes and that is wen it uses will send the ampt value will be in bytes*/ buflen = amtp; if (ftype == ORA_CLOB) buflen = buflen*ora_ncs_buff_mtpl; SvGROW(dest_sv, buflen+1); if (loblen > 0) { ub1 csform = 0; OCILobCharSetForm_log_stat(imp_sth, imp_sth->envhp, imp_sth->errhp, lobloc, &csform, status ); if (status != OCI_SUCCESS) { oci_error(sth, imp_sth->errhp, status, "OCILobCharSetForm"); sv_set_undef(dest_sv); return 0; } if (ftype == ORA_BFILE) { OCILobFileOpen_log_stat(imp_sth, imp_sth->svchp, imp_sth->errhp, lobloc, (ub1)OCI_FILE_READONLY, status); if (status != OCI_SUCCESS) { oci_error(sth, imp_sth->errhp, status, "OCILobFileOpen"); sv_set_undef(dest_sv); return 0; } } OCILobRead_log_stat(imp_sth, imp_sth->svchp, imp_sth->errhp, lobloc, &amtp, (ub4)1, SvPVX(dest_sv), buflen, 0, 0, (ub2)0, csform, status); if (status != OCI_SUCCESS ) { if (status == OCI_NEED_DATA ){ char buf[300]; sprintf(buf,"fetching %s. LOB and the read bufer is only %lubytes, and the ora_ncs_buff_mtpl is %d, which is too small. Try setting ora_ncs_buff_mtpl to %d", name, (unsigned long)buflen, ora_ncs_buff_mtpl,ora_ncs_buff_mtpl+1); oci_error_err(sth, NULL, OCI_ERROR, buf, OCI_NEED_DATA); /* appropriate ORA error number */ /*croak("DBD::Oracle has returned a %s status when doing a LobRead!! \n",oci_status_name(status));*/ /*why a croak here well if it goes on it will result in a ORA-03127: no new operations allowed until the active operation ends This will result in a crash if there are any other fetchst*/ } else { oci_error(sth, imp_sth->errhp, status, "OCILobRead"); sv_set_undef(dest_sv); } return 0; } if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 || oci_warn){ char buf[11]; strcpy(buf,"bytes"); if (ftype == ORA_CLOB) strcpy(buf,"characters"); PerlIO_printf( DBIc_LOGPIO(imp_sth), " OCILobRead %s %s: csform %d (%s), LOBlen %lu(%s), " "LongReadLen %lu(%s), BufLen %lu(%s), Got %lu(%s)\n", name, oci_status_name(status), csform, oci_csform_name(csform), ul_t(loblen),buf , ul_t(imp_sth->long_readlen),buf, ul_t(buflen),buf, ul_t(amtp),buf); } if (ftype == ORA_BFILE) { OCILobFileClose_log_stat(imp_sth, imp_sth->svchp, imp_sth->errhp, lobloc, status); } if (status != OCI_SUCCESS) { oci_error(sth, imp_sth->errhp, status, "OCILobFileClose"); sv_set_undef(dest_sv); return 0; } /* tell perl what we've put in its dest_sv */ SvCUR(dest_sv) = amtp; *SvEND(dest_sv) = '\0'; if (ftype == ORA_CLOB && CSFORM_IMPLIES_UTF8(csform)) /* Don't set UTF8 on BLOBs */ SvUTF8_on(dest_sv); ora_free_templob(sth, imp_sth, lobloc); } else { /* LOB length is 0 */ assert(amtp == 0); /* tell perl what we've put in its dest_sv */ SvCUR(dest_sv) = amtp; *SvEND(dest_sv) = '\0'; if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " OCILobRead %s %s: LOBlen %lu, LongReadLen %lu, " "BufLen %lu, Got %lu\n", name, "SKIPPED", ul_t(loblen), ul_t(imp_sth->long_readlen), ul_t(buflen), ul_t(amtp)); } SvPOK_on(dest_sv); return 1; } static int fetch_func_autolob(SV *sth, imp_fbh_t *fbh, SV *dest_sv) { dTHX; char name[64]; sprintf(name, "field %d of %d", fbh->field_num, DBIc_NUM_FIELDS(fbh->imp_sth)); return fetch_lob(sth, fbh->imp_sth, (OCILobLocator*)fbh->desc_h, fbh->ftype, dest_sv, name); } static int fetch_func_getrefpv(SV *sth, imp_fbh_t *fbh, SV *dest_sv) { dTHX; if( sth ) { /* For GCC not to warn on unused parameter */ } /* See the Oracle::OCI module for how to actually use this! */ sv_setref_pv(dest_sv, fbh->bless, (void*)fbh->desc_h); return 1; } #ifdef OCI_DTYPE_REF static void fbh_setup_getrefpv(imp_sth_t *imp_sth, imp_fbh_t *fbh, int desc_t, char *bless) { dTHX; if (DBIc_DBISTATE(imp_sth)->debug >= 2 || dbd_verbose >= 3 ) PerlIO_printf(DBIc_LOGPIO(imp_sth), " col %d: otype %d, desctype %d, %s", fbh->field_num, fbh->dbtype, desc_t, bless); fbh->ftype = fbh->dbtype; fbh->disize = fbh->dbsize; fbh->fetch_func = fetch_func_getrefpv; fbh->bless = bless; fbh->desc_t = desc_t; OCIDescriptorAlloc_ok(imp_sth, fbh->imp_sth->envhp, &fbh->desc_h, fbh->desc_t); } #endif static int calc_cache_rows(int cache_rows, int num_fields, int est_width, int has_longs,ub4 prefetch_memory) { dTHX; /* Use guessed average on-the-wire row width calculated above & */ /* add in overhead of 5 bytes per field plus 8 bytes per row. */ /* The n*5+8 was determined by studying SQL*Net v2 packets. */ /* It could probably benefit from a more detailed analysis. */ est_width += num_fields*5 + 8; if (has_longs) { /* override/disable caching */ cache_rows = 1; /* else read_blob can't work */ } else if (prefetch_memory) { /*set rows by memory*/ cache_rows=prefetch_memory/est_width; } else{ if (cache_rows == 0) { /* automatically size the cache */ /* automatically size the cache */ /* Oracle packets on ethernet have max size of around 1460. */ /* We'll aim to fill our row cache with around 10 per go. */ /* Using 10 means any 'runt' packets will have less impact. */ /* orginally set up as above but playing around with newer versions*/ /* I found that 500 was much faster*/ int txfr_size = 10 * 1460; /* desired transfer/cache size */ cache_rows = txfr_size / est_width; /* (maybe 1 or 0) */ /* To ensure good performance with large rows (near or larger */ /* than our target transfer size) we set a minimum cache size. */ /* I made them all at least 10* what they were before this */ /* main reasoning this old value reprewneted a norm in the oralce 7~8 */ /* 9 to 11 can handel much much more */ if (cache_rows < 60) /* is cache a 'useful' size? */ cache_rows = (cache_rows > 0) ? 60 : 40; } } if (cache_rows > 10000000) /* keep within Oracle's limits */ cache_rows = 10000000; /* seems it was ub2 at one time now ub4 this number is arbitary on my part*/ return cache_rows; } /* called by get_object to return the actual value in the property */ static void get_attr_val(SV *sth,AV *list,imp_fbh_t *fbh, text *name , OCITypeCode typecode, dvoid *attr_value ) { dTHX; D_imp_sth(sth); text str_buf[200]; double dnum; size_t str_len; ub4 ub4_str_len; OCIRaw *raw = (OCIRaw *) 0; OCIString *vs = (OCIString *) 0; ub1 *temp = (ub1 *)0; ub4 rawsize = 0; ub4 i = 0; sword status; SV *raw_sv; /* get the data based on the type code*/ if (DBIc_DBISTATE(imp_sth)->debug >= 5 || dbd_verbose >= 5 ) { PerlIO_printf(DBIc_LOGPIO(imp_sth), " getting value of object attribute named %s with typecode=%s\n", name,oci_typecode_name(typecode)); } switch (typecode) { case OCI_TYPECODE_INTERVAL_YM : case OCI_TYPECODE_INTERVAL_DS : OCIIntervalToText_log_stat(fbh->imp_sth, fbh->imp_sth->envhp, fbh->imp_sth->errhp, attr_value, str_buf, (size_t) 200, &str_len, status); str_buf[str_len+1] = '\0'; av_push(list, newSVpv( (char *) str_buf,0)); break; case OCI_TYPECODE_TIMESTAMP_TZ : case OCI_TYPECODE_TIMESTAMP_LTZ : case OCI_TYPECODE_TIMESTAMP : ub4_str_len = 200; OCIDateTimeToText_log_stat(fbh->imp_sth, fbh->imp_sth->envhp, fbh->imp_sth->errhp, attr_value, &ub4_str_len, str_buf, status); if (typecode == OCI_TYPECODE_TIMESTAMP_TZ || typecode == OCI_TYPECODE_TIMESTAMP_LTZ){ char s_tz_hour[3]="000"; char s_tz_min[3]="000"; sb1 tz_hour; sb1 tz_minute; status = OCIDateTimeGetTimeZoneOffset (fbh->imp_sth->envhp, fbh->imp_sth->errhp, *(OCIDateTime**)attr_value, &tz_hour, &tz_minute ); if ( (tz_hour<0) && (tz_hour>-10) ){ sprintf(s_tz_hour," %03d",tz_hour); } else { sprintf(s_tz_hour," %02d",tz_hour); } sprintf(s_tz_min,":%02d", tz_minute); strcat((signed char*)str_buf, s_tz_hour); strcat((signed char*)str_buf, s_tz_min); str_buf[ub4_str_len+7] = '\0'; } else { str_buf[ub4_str_len+1] = '\0'; } av_push(list, newSVpv( (char *) str_buf,0)); break; case OCI_TYPECODE_DATE : /* fixed length string*/ ub4_str_len = 200; OCIDateToText_log_stat(fbh->imp_sth, fbh->imp_sth->errhp, (CONST OCIDate *) attr_value, &ub4_str_len, str_buf, status); str_buf[ub4_str_len+1] = '\0'; av_push(list, newSVpv( (char *) str_buf,0)); break; case OCI_TYPECODE_CLOB: case OCI_TYPECODE_BLOB: case OCI_TYPECODE_BFILE: raw_sv = newSV(0); fetch_lob(sth, fbh->imp_sth,*(OCILobLocator**)attr_value, typecode, raw_sv, (signed char*)name); av_push(list, raw_sv); break; case OCI_TYPECODE_RAW :/* RAW*/ raw_sv = newSV(0); raw = *(OCIRaw **) attr_value; temp = OCIRawPtr(fbh->imp_sth->envhp, raw); rawsize = OCIRawSize (fbh->imp_sth->envhp, raw); for (i=0; i < rawsize; i++) { sv_catpvf(raw_sv,"0x%x ", temp[i]); } sv_catpv(raw_sv,"\n"); av_push(list, raw_sv); break; case OCI_TYPECODE_CHAR : /* fixed length string */ case OCI_TYPECODE_VARCHAR : /* varchar */ case OCI_TYPECODE_VARCHAR2 : /* varchar2 */ vs = *(OCIString **) attr_value; av_push(list, newSVpv((char *) OCIStringPtr(fbh->imp_sth->envhp, vs),0)); break; case OCI_TYPECODE_SIGNED8 : /* BYTE - sb1 */ av_push(list, newSVuv(*(sb1 *)attr_value)); break; case OCI_TYPECODE_UNSIGNED8 : /* UNSIGNED BYTE - ub1 */ av_push(list, newSViv(*(ub1 *)attr_value)); break; case OCI_TYPECODE_OCTET : /* OCT*/ av_push(list, newSViv(*(ub1 *)attr_value)); break; case OCI_TYPECODE_UNSIGNED16 : /* UNSIGNED SHORT */ case OCI_TYPECODE_UNSIGNED32 : /* UNSIGNED LONG */ case OCI_TYPECODE_REAL : /* REAL */ case OCI_TYPECODE_DOUBLE : /* DOUBLE */ case OCI_TYPECODE_INTEGER : /* INT */ case OCI_TYPECODE_SIGNED16 : /* SHORT */ case OCI_TYPECODE_SIGNED32 : /* LONG */ case OCI_TYPECODE_DECIMAL : /* DECIMAL */ case OCI_TYPECODE_FLOAT : /* FLOAT */ case OCI_TYPECODE_NUMBER : /* NUMBER */ case OCI_TYPECODE_SMALLINT : /* SMALLINT */ (void) OCINumberToReal(fbh->imp_sth->errhp, (CONST OCINumber *) attr_value, (uword) sizeof(dnum), (dvoid *) &dnum); av_push(list, newSVnv(dnum)); break; default: break; } } SV* new_ora_object (AV* list, OCITypeCode typecode) { dTHX; SV* objref = newRV_noinc((SV*) list); if (ora_objects && typecode == OCI_TYPECODE_OBJECT) { HV* self = newHV(); (void)hv_store(self, "type_name", 9, av_shift(list), 0); (void)hv_store(self, "attributes", 10, objref, 0); objref = newRV_noinc((SV*) self); objref = sv_bless(objref, gv_stashpv("DBD::Oracle::Object", 0)); } return objref; } /*gets the properties of an object from a fetch by using the attributes saved in the describe */ int get_object (SV *sth, AV *list, imp_fbh_t *fbh,fbh_obj_t *base_obj,OCIComplexObject *value, OCIType *instance_tdo, dvoid *obj_ind){ dTHX; D_imp_sth(sth); sword status; dvoid *element ; dvoid *attr_value; boolean eoc; ub2 pos; dvoid *attr_null_struct; OCIInd attr_null_status; OCIInd *element_null; OCIType *attr_tdo; OCIIter *itr; fbh_obj_t *fld; fbh_obj_t *obj = base_obj; OCIType *tdo = instance_tdo ? instance_tdo : obj->tdo; if (DBIc_DBISTATE(imp_sth)->debug >= 5 || dbd_verbose >= 5 ) { PerlIO_printf(DBIc_LOGPIO(imp_sth), " getting attributes of object named %s with typecode=%s\n", obj->type_name,oci_typecode_name(obj->typecode)); } switch (obj->typecode) { case OCI_TYPECODE_OBJECT: /* embedded ADT */ case OCI_TYPECODE_OPAQUE: /*doesn't do anything though*/ if (ora_objects){ sword status; if (!instance_tdo && !obj->is_final_type) { OCIRef *type_ref=0; status = OCIObjectNew(fbh->imp_sth->envhp, fbh->imp_sth->errhp, fbh->imp_sth->svchp, OCI_TYPECODE_REF, (OCIType *)0, (dvoid *)0, OCI_DURATION_DEFAULT, TRUE, (dvoid **) &type_ref); if (status != OCI_SUCCESS) { oci_error(sth, fbh->imp_sth->errhp, status, "OCIObjectNew"); return 0; } status=OCIObjectGetTypeRef(fbh->imp_sth->envhp,fbh->imp_sth->errhp, (dvoid*)value, type_ref); if (status != OCI_SUCCESS) { oci_error(sth, fbh->imp_sth->errhp, status, "OCIObjectGetTypeRef"); return 0; } OCITypeByRef_log_stat(fbh->imp_sth, fbh->imp_sth->envhp, fbh->imp_sth->errhp, type_ref, &tdo,status); if (status != OCI_SUCCESS) { oci_error(sth, fbh->imp_sth->errhp, status, "OCITypeByRef"); return 0; } status = OCIObjectFree(fbh->imp_sth->envhp, fbh->imp_sth->errhp, type_ref, (ub2)0); if (status != OCI_SUCCESS) { oci_error(sth, fbh->imp_sth->errhp, status, "OCIObjectFree"); return 0; } } if (tdo != obj->tdo) { /* this is subtype -> search for subtype obj */ while (obj->next_subtype && tdo != obj->tdo) { obj = obj->next_subtype; } if (tdo != obj->tdo) { /* new subtyped -> get obj description */ if (DBIc_DBISTATE(imp_sth)->debug >= 5 || dbd_verbose >= 5 ) { PerlIO_printf(DBIc_LOGPIO(imp_sth), " describe subtype (tdo=%p) of object type %s (tdo=%p)\n",(void*)tdo,base_obj->type_name,(void*)base_obj->tdo); } Newz(1, obj->next_subtype, 1, fbh_obj_t); obj->next_subtype->tdo = tdo; if ( describe_obj_by_tdo(sth, fbh->imp_sth, obj->next_subtype, 0 /*unknown level there*/) ) { obj = obj->next_subtype; if (DBIc_DBISTATE(imp_sth)->debug >= 5 || dbd_verbose >= 5 ){ dump_struct(fbh->imp_sth,obj,0); } } else { obj->next_subtype = 0; } } if (DBIc_DBISTATE(imp_sth)->debug >= 5 || dbd_verbose >= 5 ) { PerlIO_printf(DBIc_LOGPIO(imp_sth), " getting attributes of object subtype %s\n",obj->type_name); } } av_push(list, newSVpv((char*)obj->type_name, obj->type_namel)); } for (pos = 0; pos < obj->field_count; pos++){ fld = &obj->fields[pos]; /*get the field */ if (ora_objects) { /* add field name */ av_push(list, newSVpv((char*)fld->type_name, fld->type_namel)); } /* the little bastard above took me ages to find out seems Oracle does not like people to know that it can do this the concept is simple really 1. pin the object 2. bind with dty = SQLT_NTY 3. OCIDefineObject using the TDO 4. one gets the null indicator of the objcet with OCIObjectGetInd The the obj_ind is for the entier object not the properties so you call it once it gets all of the indicators for the objects so you pass it into OCIObjectGetAttr and that function will set attr_null_status as in the get below. 5. interate over the atributes of the object The thing to remember is that OCI and C have no way of representing a DB NULLs so we use the OCIInd find out if the object or any of its properties are NULL, This is one little line in a 20 chapter book and even then id only shows you examples with the C struct built in and only a single record. Nowhere does it say you can do it this way. */ OCIObjectGetAttr_log_stat( fbh->imp_sth, fbh->imp_sth->envhp, fbh->imp_sth->errhp, value, /* instance */ obj_ind, /* null_struct */ tdo, /* tdo */ (CONST oratext**)&fld->type_name, /* names */ &fld->type_namel, /* lengths */ 1, /* name_count */ (ub4 *)0, /* indexes */ 0, /* index_count */ &attr_null_status, /* attr_null_status */ &attr_null_struct, /* attr_null_struct */ &attr_value, /* attr_value */ &attr_tdo, /* attr_tdo */ status); if (status != OCI_SUCCESS) { oci_error(sth, fbh->imp_sth->errhp, status, "OCIObjectGetAttr"); return 0; } if (attr_null_status==OCI_IND_NULL){ av_push(list, &PL_sv_undef); } else { if (fld->typecode == OCI_TYPECODE_OBJECT || fld->typecode == OCI_TYPECODE_VARRAY || fld->typecode == OCI_TYPECODE_TABLE || fld->typecode == OCI_TYPECODE_NAMEDCOLLECTION){ fld->fields[0].value = newAV(); if (fld->typecode != OCI_TYPECODE_OBJECT) attr_value = *(dvoid **)attr_value; if (!get_object (sth,fld->fields[0].value, fbh, &fld->fields[0],attr_value, attr_tdo, attr_null_struct)) return 0; av_push(list, new_ora_object(fld->fields[0].value, fld->typecode)); } else{ /* else, display the scaler type attribute */ get_attr_val(sth,list, fbh, fld->type_name, fld->typecode, attr_value); } } } break; case OCI_TYPECODE_REF : /* embedded ADT */ croak("panic: OCI_TYPECODE_REF objets () are not supported "); break; case OCI_TYPECODE_NAMEDCOLLECTION : /*this works for both as I am using CONST OCIColl */ switch (obj->col_typecode) { /*there may be more thatn two I havn't found them yet mmight be XML??*/ case OCI_TYPECODE_TABLE : /* nested table */ case OCI_TYPECODE_VARRAY : /* variable array */ fld = &obj->fields[0]; /*get the field */ OCIIterCreate_log_stat(fbh->imp_sth, fbh->imp_sth->envhp, fbh->imp_sth->errhp, (OCIColl*) value, &itr, status); if (status != OCI_SUCCESS) { /*not really an error just no data oci_error(sth, fbh->imp_sth->errhp, status, "OCIIterCreate");*/ status = OCI_SUCCESS; av_push(list, &PL_sv_undef); return 0; } for(eoc = FALSE;!OCIIterNext(fbh->imp_sth->envhp, fbh->imp_sth->errhp, itr, (dvoid **) &element, (dvoid **) &element_null, &eoc) && !eoc;) { if (*element_null==OCI_IND_NULL){ av_push(list, &PL_sv_undef); } else { if (obj->element_typecode == OCI_TYPECODE_OBJECT || obj->element_typecode == OCI_TYPECODE_VARRAY || obj->element_typecode== OCI_TYPECODE_TABLE || obj->element_typecode== OCI_TYPECODE_NAMEDCOLLECTION){ fld->value = newAV(); if(!get_object (sth,fld->value, fbh, fld,element,0,element_null)) return 0; av_push(list, new_ora_object(fld->value, obj->element_typecode)); } else{ /* else, display the scaler type attribute */ get_attr_val(sth,list, fbh, obj->type_name, obj->element_typecode, element); } } } /*nasty surprise here. one has to get rid of the iterator or you will leak memory not documented in oci or in demos */ OCIIterDelete_log_stat(fbh->imp_sth, fbh->imp_sth->envhp, fbh->imp_sth->errhp, &itr, status ); if (status != OCI_SUCCESS) { oci_error(sth, fbh->imp_sth->errhp, status, "OCIIterDelete"); return 0; } break; default: break; } break; default: if (value) { get_attr_val(sth,list, fbh, obj->type_name, obj->typecode, value); } else return 1; break; } return 1; } /*cutsom fetch for embedded objects */ static int fetch_func_oci_object(SV *sth, imp_fbh_t *fbh,SV *dest_sv) { dTHX; D_imp_sth(sth); if (DBIc_DBISTATE(imp_sth)->debug >= 4 || dbd_verbose >= 4 ) { PerlIO_printf(DBIc_LOGPIO(imp_sth), " getting an embedded object named %s with typecode=%s\n", fbh->obj->type_name,oci_typecode_name(fbh->obj->typecode)); } if (fbh->obj->obj_ind && fbh->obj->obj_ind[0] == OCI_IND_NULL) { sv_set_undef(dest_sv); return 1; } fbh->obj->value=newAV(); /*will return referance to an array of scalars*/ if (!get_object(sth,fbh->obj->value,fbh,fbh->obj,fbh->obj->obj_value,0,fbh->obj->obj_ind)){ return 0; } else { sv_setsv(dest_sv, sv_2mortal(new_ora_object(fbh->obj->value, fbh->obj->typecode))); return 1; } } static int fetch_clbk_lob(SV *sth, imp_fbh_t *fbh,SV *dest_sv){ dTHX; D_imp_sth(sth); fb_ary_t *fb_ary = fbh->fb_ary; ub4 actual_bufl=imp_sth->piece_size*(fb_ary->piece_count)+fb_ary->bufl; if (fb_ary->piece_count==0){ if (DBIc_DBISTATE(imp_sth)->debug >= 6 || dbd_verbose >= 6 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " Fetch persistent lob of %d (char/bytes) with callback in 1 " "piece of %d (Char/Bytes)\n", actual_bufl,fb_ary->bufl); memcpy(fb_ary->cb_abuf,fb_ary->abuf,fb_ary->bufl ); } else { if (DBIc_DBISTATE(imp_sth)->debug >= 6 || dbd_verbose >= 6 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " Fetch persistent lob of %d (Char/Bytes) with callback in %d " "piece(s) of %d (Char/Bytes) and one piece of %d (Char/Bytes)\n", actual_bufl,fb_ary->piece_count,fbh->piece_size,fb_ary->bufl); memcpy(fb_ary->cb_abuf+imp_sth->piece_size*(fb_ary->piece_count),fb_ary->abuf,fb_ary->bufl ); } if (fbh->ftype == SQLT_BIN){ *(fb_ary->cb_abuf+(actual_bufl))='\0'; /* add a null teminator*/ sv_setpvn(dest_sv, (char*)fb_ary->cb_abuf,(STRLEN)actual_bufl); } else { sv_setpvn(dest_sv, (char*)fb_ary->cb_abuf,(STRLEN)actual_bufl); if (CSFORM_IMPLIES_UTF8(fbh->csform) ){ SvUTF8_on(dest_sv); } } return 1; } /* This is another way to get lobs as a alternate to callback */ static int fetch_get_piece(SV *sth, imp_fbh_t *fbh,SV *dest_sv) { dTHX; D_imp_sth(sth); fb_ary_t *fb_ary = fbh->fb_ary; ub4 buflen = fb_ary->bufl; ub4 actual_bufl = 0; ub1 piece = OCI_FIRST_PIECE; void *hdlptr = (dvoid *) 0; ub4 hdltype = OCI_HTYPE_DEFINE, iter = 0, idx = 0; ub1 in_out = 0; sb2 indptr = 0; ub2 rcode = 0; sword status = OCI_NEED_DATA; if (DBIc_DBISTATE(imp_sth)->debug >= 4 || dbd_verbose >= 4 ) { PerlIO_printf(DBIc_LOGPIO(imp_sth), "in fetch_get_piece \n"); } while (status == OCI_NEED_DATA){ OCIStmtGetPieceInfo_log_stat(fbh->imp_sth, fbh->imp_sth->stmhp, fbh->imp_sth->errhp, &hdlptr, &hdltype, &in_out, &iter, &idx, &piece, status); /* This is how this works First we get the piece Info above the bugger thing is that this will get the piece info in sequential order so on each call to the above you have to check to ensure you have the right define handle from the OCIDefineByPos I do it in the next if statement. So this will loop untill the handle changes at that point it exits the loop during the loop I add the abuf to the cb_abuf using the buflen that is set above. I get the actual buffer length by adding up all the pieces (buflen) as I go along Another really anoying thing is once can only find out if there is data left over at the very end of the fetching of the colums so I make it warn if the LongTruncOk. I could also do this before but that would not result in any of the good data getting in */ if ( hdlptr==fbh->defnp){ OCIStmtSetPieceInfo_log_stat(fbh->imp_sth, fbh->defnp, fbh->imp_sth->errhp, fb_ary->abuf, &buflen, piece, (dvoid *)&indptr, &rcode,status); OCIStmtFetch_log_stat(fbh->imp_sth, fbh->imp_sth->stmhp,fbh->imp_sth->errhp,1,(ub2)OCI_FETCH_NEXT,OCI_DEFAULT,status); if (status==OCI_SUCCESS_WITH_INFO && !DBIc_has(fbh->imp_sth,DBIcf_LongTruncOk)){ dTHR; /* for DBIc_ACTIVE_off */ DBIc_ACTIVE_off(fbh->imp_sth); /* eg finish */ oci_error(sth, fbh->imp_sth->errhp, status, "OCIStmtFetch, LongReadLen too small and/or LongTruncOk not set"); } memcpy(fb_ary->cb_abuf+fb_ary->piece_count*imp_sth->piece_size,fb_ary->abuf,buflen ); fb_ary->piece_count++;/*used to tell me how many pieces I have, for debuffing in this case */ actual_bufl=actual_bufl+buflen; }else { status=OCI_LAST_PIECE; } } if (DBIc_DBISTATE(imp_sth)->debug >= 6 || dbd_verbose >= 6 ){ if (fb_ary->piece_count==1){ PerlIO_printf( DBIc_LOGPIO(imp_sth), " Fetch persistent lob of %d (Char/Bytes) with Polling " "in 1 piece\n", actual_bufl); } else { PerlIO_printf( DBIc_LOGPIO(imp_sth), " Fetch persistent lob of %d (Char/Bytes) with Polling " "in %d piece(s) of %d (Char/Bytes) and one piece of %d (Char/Bytes)\n", actual_bufl,fb_ary->piece_count,fbh->piece_size,buflen); } } sv_setpvn(dest_sv, (char*)fb_ary->cb_abuf,(STRLEN)actual_bufl); if (fbh->ftype != SQLT_BIN){ if (CSFORM_IMPLIES_UTF8(fbh->csform) ){ /* do the UTF 8 magic*/ SvUTF8_on(dest_sv); } } return 1; } int empty_oci_object(fbh_obj_t *obj){ dTHX; int pos =0; fbh_obj_t *fld=NULL; switch (obj->element_typecode) { case OCI_TYPECODE_OBJECT : /* embedded ADT */ case OCI_TYPECODE_OPAQUE : /*usually an XML object*/ if (obj->next_subtype) { empty_oci_object(obj->next_subtype); } for (pos = 0; pos < obj->field_count; pos++){ fld = &obj->fields[pos]; /*get the field */ if (fld->typecode == OCI_TYPECODE_OBJECT || fld->typecode == OCI_TYPECODE_VARRAY || fld->typecode == OCI_TYPECODE_TABLE || fld->typecode == OCI_TYPECODE_NAMEDCOLLECTION){ empty_oci_object(fld); if (fld->value && SvTYPE(fld->value) == SVt_PVAV){ av_clear(fld->value); av_undef(fld->value); } } else { return 1; } } break; case OCI_TYPECODE_NAMEDCOLLECTION : fld = &obj->fields[0]; /*get the field */ if (obj->element_typecode == OCI_TYPECODE_OBJECT){ empty_oci_object(fld); } if (fld->value && SvTYPE(fld->value)){ if (SvTYPE(fld->value) == SVt_PVAV){ av_clear(fld->value); av_undef(fld->value); } } break; default: break; } if ( fld && fld->value && (SvTYPE(fld->value) == SVt_PVAV) ){ av_clear(obj->value); av_undef(obj->value); } return 1; } static void fetch_cleanup_pres_lobs(SV *sth,imp_fbh_t *fbh){ dTHX; D_imp_sth(sth); fb_ary_t *fb_ary = fbh->fb_ary; if( sth ) { /* For GCC not to warn on unused parameter*/ } fb_ary->piece_count=0;/*reset the peice counter*/ memset( fb_ary->abuf, '\0', fb_ary->bufl); /*clean out the piece fetch buffer*/ fb_ary->bufl=fbh->piece_size; /*reset this back to the piece length */ fb_ary->cb_bufl=fbh->disize; /*reset this back to the max size for the fetch*/ memset( fb_ary->cb_abuf, '\0', fbh->disize ); /*clean out the call back buffer*/ if (DBIc_DBISTATE(imp_sth)->debug >= 5 || dbd_verbose >= 5 ) PerlIO_printf(DBIc_LOGPIO(imp_sth)," fetch_cleanup_pres_lobs \n"); return; } static void fetch_cleanup_oci_object(SV *sth, imp_fbh_t *fbh){ dTHX; D_imp_sth(sth); if( sth ) { /* For GCC not to warn on unused parameter*/ } if (fbh->obj){ if(fbh->obj->obj_value || fbh->obj->obj_ind){ empty_oci_object(fbh->obj); } } if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) PerlIO_printf(DBIc_LOGPIO(imp_sth)," fetch_cleanup_oci_object \n"); return; } void rs_array_init(imp_sth_t *imp_sth) { dTHX; imp_sth->rs_array_num_rows =0; imp_sth->rs_array_idx =0; imp_sth->rs_fetch_count =0; imp_sth->rs_array_status =OCI_SUCCESS; if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " rs_array_init:imp_sth->rs_array_size=%d, rs_array_idx=%d, " "prefetch_rows=%d, rs_array_status=%s\n", imp_sth->rs_array_size, imp_sth->rs_array_idx, imp_sth->prefetch_rows, oci_status_name(imp_sth->rs_array_status)); } static int /* --- Setup the row cache for this sth --- */ sth_set_row_cache(SV *h, imp_sth_t *imp_sth, int max_cache_rows, int num_fields, int has_longs) { dTHX; D_imp_dbh_from_sth; D_imp_drh_from_dbh; int num_errors = 0; ub4 prefetch_mem = 0; /*Oracle prefetch memory buffer*/ sb4 prefetch_rows = 0; /*Oracle prefetch Row Buffer*/ sb4 cache_rows = 0;/* set high so memory is the limit */ sword status; if (imp_sth->RowCacheSize ) { /*Statment value will crump the handle value */ cache_rows=imp_sth->RowCacheSize; } else if (imp_dbh->RowCacheSize){ cache_rows=imp_dbh->RowCacheSize; } /* seems that RowCacheSize was incorrectly used in the past in the DBI Spect RowCacheSize is to be used for a local row cache and can be set on both the handle and the statement and the statement will take precideace From DBI POD A hint to the driver indicating the size of the local row cache that the application would like the driver to use for future SELECT statements. so RowCacheSize is for a local cache to cut down on round trips The OCI doc state that both OCI_ATTR_PREFETCH_ROWS OCI_ATTR_PREFETCH_MEMORY sets up a cleint side cache but in earlier version than 1.24 we only selected one record at a time from the fetch this means a round trip (at least to the local cache) at each fetch. With the new array fetch we truly have a local cache so I will use it RowCacheSize to set the value of that cache or the array fetch*/ /* number of rows to cache if using oraperl will leave this in for now*/ if (SvOK(imp_drh->ora_cache_o)){ imp_sth->cache_rows = SvIV(imp_drh->ora_cache_o); } else if (SvOK(imp_drh->ora_cache)){ imp_sth->cache_rows = SvIV(imp_drh->ora_cache); } prefetch_rows =imp_sth->prefetch_rows; prefetch_mem =imp_sth->prefetch_memory; if (!cache_rows) { /*start with this value if not set then set default cache */ cache_rows=calc_cache_rows(imp_sth->cache_rows,(int)num_fields, imp_sth->est_width, has_longs,0); if(!prefetch_rows && !prefetch_mem){ /*if there are not prefetch rows make sure I set it here to the default*/ prefetch_rows=cache_rows; } } else if (imp_dbh->RowCacheSize < 0) {/* for compaibility with DBI doc negitive value here means use the value as memory*/ prefetch_mem =-imp_dbh->RowCacheSize; /* cache_mem always +ve here */ prefetch_rows =0; cache_rows=calc_cache_rows(imp_sth->cache_rows,(int)num_fields, imp_sth->est_width, has_longs,prefetch_mem); /*The above fucntion will set the cache_rows using memory as the limit*/ } else { if (!prefetch_mem){ prefetch_rows = cache_rows; /*use the RowCacheSize*/ } } if (cache_rows <= prefetch_rows){ cache_rows=prefetch_rows; /* is prefetch_rows are greater than the RowCahceSize then use prefetch_rows*/ } OCIAttrSet_log_stat(imp_sth, imp_sth->stmhp, OCI_HTYPE_STMT, &prefetch_mem, sizeof(prefetch_mem), OCI_ATTR_PREFETCH_MEMORY, imp_sth->errhp, status); if (status != OCI_SUCCESS) { oci_error(h, imp_sth->errhp, status, "OCIAttrSet OCI_ATTR_PREFETCH_MEMORY"); ++num_errors; } OCIAttrSet_log_stat(imp_sth, imp_sth->stmhp, OCI_HTYPE_STMT, &prefetch_rows, sizeof(prefetch_rows), OCI_ATTR_PREFETCH_ROWS, imp_sth->errhp, status); if (status != OCI_SUCCESS) { oci_error(h, imp_sth->errhp, status, "OCIAttrSet OCI_ATTR_PREFETCH_ROWS"); ++num_errors; } imp_sth->rs_array_size=cache_rows; if (max_cache_rows){/* limited to 1 by a cursor or something else*/ imp_sth->rs_array_size=1; } if (imp_sth->row_cache_off){/*set the size of the Rows in Cache value*/ imp_dbh->RowsInCache =1; imp_sth->RowsInCache =1; } else { imp_dbh->RowsInCache=imp_sth->rs_array_size; imp_sth->RowsInCache=imp_sth->rs_array_size; } if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 || oci_warn) /*will also display if oci_warn is on*/ PerlIO_printf( DBIc_LOGPIO(imp_sth), " cache settings DB Handle RowCacheSize=%d,Statement Handle " "RowCacheSize=%d, OCI_ATTR_PREFETCH_ROWS=%lu, " "OCI_ATTR_PREFETCH_MEMORY=%lu, Rows per Fetch=%d, Multiple Row Fetch=%s\n", imp_dbh->RowCacheSize, imp_sth->RowCacheSize, (unsigned long) (prefetch_rows), (unsigned long) (prefetch_mem), cache_rows,(imp_sth->row_cache_off)?"Off":"On"); return num_errors; } /*recurses down the field's TDOs and saves the little bits it need for later use on a fetch fbh->obj */ int describe_obj(SV *sth,imp_sth_t *imp_sth,OCIParam *parm,fbh_obj_t *obj,int level ) { dTHX; sword status; OCIRef *type_ref; if (DBIc_DBISTATE(imp_sth)->debug >= 5 || dbd_verbose >= 5 ) { PerlIO_printf( DBIc_LOGPIO(imp_sth), "At level=%d in description an embedded object \n",level); } /*Describe the field (OCIParm) we know it is a object or a collection */ /* Get the Actual TDO */ OCIAttrGet_parmdp(imp_sth,parm, &type_ref, 0, OCI_ATTR_REF_TDO, status); if (status != OCI_SUCCESS) { oci_error(sth, imp_sth->errhp, status, "OCIAttrGet"); return 0; } OCITypeByRef_log_stat(imp_sth, imp_sth->envhp, imp_sth->errhp, type_ref, &obj->tdo, status); if (status != OCI_SUCCESS) { oci_error(sth, imp_sth->errhp, status, "OCITypeByRef"); return 0; } return describe_obj_by_tdo(sth, imp_sth, obj, level); } int describe_obj_by_tdo(SV *sth,imp_sth_t *imp_sth,fbh_obj_t *obj,ub2 level ) { dTHX; sword status; text *type_name, *schema_name; ub4 type_namel, schema_namel; OCIDescribeAny_log_stat(imp_sth, imp_sth->svchp,imp_sth->errhp,obj->tdo,(ub4)0,OCI_OTYPE_PTR,(ub1)1,OCI_PTYPE_TYPE,imp_sth->dschp,status); /*we have the Actual TDO so lets see what it is made up of by a describe*/ if (status != OCI_SUCCESS) { oci_error(sth,imp_sth->errhp, status, "OCIDescribeAny"); return 0; } OCIAttrGet_parmap(imp_sth, imp_sth->dschp,OCI_HTYPE_DESCRIBE, &obj->parmdp, 0, status); if (status != OCI_SUCCESS) { oci_error(sth,imp_sth->errhp, status, "OCIAttrGet"); return 0; } /*and we store it in the object's paramdp for now*/ OCIAttrGet_parmdp(imp_sth, obj->parmdp, &schema_name, &schema_namel, OCI_ATTR_SCHEMA_NAME, status); if (status != OCI_SUCCESS) { oci_error(sth,imp_sth->errhp, status, "OCIAttrGet"); return 0; } OCIAttrGet_parmdp(imp_sth, obj->parmdp, &type_name, &type_namel, OCI_ATTR_NAME, status); if (status != OCI_SUCCESS) { oci_error(sth,imp_sth->errhp, status, "OCIAttrGet"); return 0; } /* make full type_name: schema_name + "." + type_name */ obj->full_type_name = newSVpv((char*)schema_name, schema_namel); sv_catpvn(obj->full_type_name, ".", 1); sv_catpvn(obj->full_type_name, (char*)type_name, type_namel); obj->type_name = (text*)SvPV(obj->full_type_name,PL_na); /*we need to know its type code*/ OCIAttrGet_parmdp(imp_sth, obj->parmdp, (dvoid *)&obj->typecode, 0, OCI_ATTR_TYPECODE, status); if (status != OCI_SUCCESS) { oci_error(sth,imp_sth->errhp, status, "OCIAttrGet"); return 0; } if (DBIc_DBISTATE(imp_sth)->debug >= 6 || dbd_verbose >= 6 ) { PerlIO_printf( DBIc_LOGPIO(imp_sth), "Getting the properties of object named =%s at level %d typecode=%d\n", obj->type_name,level,obj->typecode); } if (obj->typecode == OCI_TYPECODE_OBJECT || obj->typecode == OCI_TYPECODE_OPAQUE){ OCIParam *list_attr= (OCIParam *) 0; ub2 pos; if (DBIc_DBISTATE(imp_sth)->debug >= 6 || dbd_verbose >= 6 ) { PerlIO_printf( DBIc_LOGPIO(imp_sth), "Object named =%s at level %d is an Object\n", obj->type_name,level); } OCIAttrGet_parmdp(imp_sth, obj->parmdp, (dvoid *)&obj->obj_ref, 0, OCI_ATTR_REF_TDO, status); if (status != OCI_SUCCESS) { oci_error(sth,imp_sth->errhp, status, "OCIAttrGet"); return 0; } /*we will need a reff to the TDO for the pin operation*/ OCIObjectPin_log_stat(imp_sth, imp_sth->envhp,imp_sth->errhp, obj->obj_ref,(dvoid **)&obj->obj_type,status); if (status != OCI_SUCCESS) { oci_error(sth,imp_sth->errhp, status, "OCIObjectPin"); return 0; } OCIAttrGet_parmdp(imp_sth, obj->parmdp, (dvoid *)&obj->is_final_type,(ub4 *) 0, OCI_ATTR_IS_FINAL_TYPE, status); if (status != OCI_SUCCESS) { oci_error(sth,imp_sth->errhp, status, "OCIAttrGet"); return 0; } OCIAttrGet_parmdp(imp_sth, obj->parmdp, (dvoid *)&obj->field_count,(ub4 *) 0, OCI_ATTR_NUM_TYPE_ATTRS, status); if (status != OCI_SUCCESS) { oci_error(sth,imp_sth->errhp, status, "OCIAttrGet"); return 0; } /*now get the differnt fields of this object add one field object for property*/ Newz(1, obj->fields, (unsigned) obj->field_count, fbh_obj_t); /*a field is just another instance of an obj not a new struct*/ OCIAttrGet_parmdp(imp_sth, obj->parmdp, (dvoid *)&list_attr,(ub4 *) 0, OCI_ATTR_LIST_TYPE_ATTRS, status); if (status != OCI_SUCCESS) { oci_error(sth,imp_sth->errhp, status, "OCIAttrGet"); return 0; } for (pos = 1; pos <= obj->field_count; pos++){ OCIParam *parmdf= (OCIParam *) 0; fbh_obj_t *fld = &obj->fields[pos-1]; /*get the field holder*/ OCIParamGet_log_stat(imp_sth, (dvoid *) list_attr,(ub4) OCI_DTYPE_PARAM, imp_sth->errhp,(dvoid *)&parmdf, (ub4) pos ,status); if (status != OCI_SUCCESS) { oci_error(sth,imp_sth->errhp, status, "OCIParamGet"); return 0; } OCIAttrGet_parmdp(imp_sth, (dvoid*)parmdf, (dvoid *)&fld->type_name,(ub4 *) &fld->type_namel, OCI_ATTR_NAME, status); /* get the name of the attribute */ if (status != OCI_SUCCESS) { oci_error(sth,imp_sth->errhp, status, "OCIAttrGet"); return 0; } OCIAttrGet_parmdp(imp_sth, (dvoid*)parmdf, (void *)&fld->typecode,(ub4 *) 0, OCI_ATTR_TYPECODE, status); if (status != OCI_SUCCESS) { oci_error(sth,imp_sth->errhp, status, "OCIAttrGet"); return 0; } if (DBIc_DBISTATE(imp_sth)->debug >= 6 || dbd_verbose >= 6 ) { PerlIO_printf( DBIc_LOGPIO(imp_sth), "Getting property #%d, named=%s and its typecode is %d \n", pos, fld->type_name, fld->typecode); } if (fld->typecode == OCI_TYPECODE_OBJECT || fld->typecode == OCI_TYPECODE_VARRAY || fld->typecode == OCI_TYPECODE_TABLE || fld->typecode == OCI_TYPECODE_NAMEDCOLLECTION){ /*this is some sort of object or collection so lets drill down some more*/ Newz(1, fld->fields, 1, fbh_obj_t); fld->field_count=1;/*not really needed but used internally*/ status=describe_obj(sth,imp_sth,parmdf,fld->fields,level+1); } } } else { /*well this is an embedded table or varray of some form so find out what is in it*/ if (DBIc_DBISTATE(imp_sth)->debug >= 6 || dbd_verbose >= 6 ) { PerlIO_printf( DBIc_LOGPIO(imp_sth), "Object named =%s at level %d is an Varray or Table\n", obj->type_name,level); } OCIAttrGet_parmdp(imp_sth, obj->parmdp, (dvoid *)&obj->col_typecode, 0, OCI_ATTR_COLLECTION_TYPECODE, status); if (status != OCI_SUCCESS) { oci_error(sth,imp_sth->errhp, status, "OCIAttrGet"); return 0; } /* first get what sort of collection it is by coll typecode*/ OCIAttrGet_parmdp(imp_sth, obj->parmdp, (dvoid *)&obj->parmap, 0, OCI_ATTR_COLLECTION_ELEMENT, status); if (status != OCI_SUCCESS) { oci_error(sth,imp_sth->errhp, status, "OCIAttrGet"); return 0; } OCIAttrGet_parmdp(imp_sth, obj->parmap, (dvoid *)&obj->element_typecode, 0, OCI_ATTR_TYPECODE, status); if (status != OCI_SUCCESS) { oci_error(sth,imp_sth->errhp, status, "OCIAttrGet"); return 0; } if (obj->element_typecode == OCI_TYPECODE_OBJECT || obj->element_typecode == OCI_TYPECODE_VARRAY || obj->element_typecode == OCI_TYPECODE_TABLE || obj->element_typecode == OCI_TYPECODE_NAMEDCOLLECTION){ /*this is some sort of object or collection so lets drill down some more*/ fbh_obj_t *fld; Newz(1, obj->fields, 1, fbh_obj_t); fld = &obj->fields[0]; /*get the field holder*/ obj->field_count=1; /*not really needed but used internally*/ status=describe_obj(sth,imp_sth,obj->parmap,fld,level+1); } } return 1; } int dump_struct(imp_sth_t *imp_sth,fbh_obj_t *obj,int level){ dTHX; int i; /*dumps the contents of the current fbh->obj*/ PerlIO_printf( DBIc_LOGPIO(imp_sth), " level=%d type_name = %s\n",level,obj->type_name); PerlIO_printf( DBIc_LOGPIO(imp_sth), " type_namel = %u\n",obj->type_namel); PerlIO_printf( DBIc_LOGPIO(imp_sth), " parmdp = %p\n",obj->parmdp); PerlIO_printf( DBIc_LOGPIO(imp_sth), " parmap = %p\n",obj->parmap); PerlIO_printf( DBIc_LOGPIO(imp_sth), " tdo = %p\n",obj->tdo); PerlIO_printf( DBIc_LOGPIO(imp_sth), " typecode = %s\n",oci_typecode_name(obj->typecode)); PerlIO_printf( DBIc_LOGPIO(imp_sth), " col_typecode = %d\n",obj->col_typecode); PerlIO_printf( DBIc_LOGPIO(imp_sth), " element_typecode = %s\n",oci_typecode_name(obj->element_typecode)); PerlIO_printf( DBIc_LOGPIO(imp_sth), " obj_ref = %p\n",obj->obj_ref); PerlIO_printf(DBIc_LOGPIO(imp_sth), " obj_value = %p\n",obj->obj_value); PerlIO_printf(DBIc_LOGPIO(imp_sth), " obj_type = %p\n",obj->obj_type); PerlIO_printf(DBIc_LOGPIO(imp_sth), " is_final_type = %u\n",obj->is_final_type); PerlIO_printf(DBIc_LOGPIO(imp_sth), " field_count = %d\n",obj->field_count); PerlIO_printf(DBIc_LOGPIO(imp_sth), " fields = %p\n",obj->fields); for (i = 0; i < obj->field_count;i++){ fbh_obj_t *fld = &obj->fields[i]; PerlIO_printf( DBIc_LOGPIO(imp_sth), " \n--->sub objects\n "); dump_struct(imp_sth,fld,level+1); } PerlIO_printf(DBIc_LOGPIO(imp_sth), " \n--->done %s\n ",obj->type_name); return 1; } int dbd_describe(SV *h, imp_sth_t *imp_sth) { dTHX; D_imp_dbh_from_sth; D_imp_drh_from_dbh; UV long_readlen; ub4 num_fields; int num_errors = 0; int has_longs = 0; int est_width = 0; /* estimated avg row width (for cache) */ int nested_cursors = 0; ub4 i = 0; sword status; if (imp_sth->done_desc) return 1; /* success, already done it */ imp_sth->done_desc = 1; /* ora_trunc is checked at fetch time */ /* long_readlen: length for long/longraw (if >0), else 80 (ora app dflt) */ /* Ought to be for COMPAT mode only but was relaxed before LongReadLen existed */ long_readlen = (SvOK(imp_drh -> ora_long) && SvUV(imp_drh->ora_long)>0) ? SvUV(imp_drh->ora_long) : DBIc_LongReadLen(imp_sth); /* set long_readlen for SELECT or PL/SQL with output placeholders */ imp_sth->long_readlen = long_readlen; if (imp_sth->stmt_type != OCI_STMT_SELECT) { /* XXX DISABLED, see num_fields test below */ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " dbd_describe skipped for %s\n", oci_stmt_type_name(imp_sth->stmt_type)); /* imp_sth memory was cleared when created so no setup required here */ return 1; } if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " dbd_describe %s (%s, lb %lu)...\n", oci_stmt_type_name(imp_sth->stmt_type), DBIc_ACTIVE(imp_sth) ? "implicit" : "EXPLICIT", (unsigned long)long_readlen); /* We know it's a select and we've not got the description yet, so if the */ /* sth is not 'active' (executing) then we need an explicit describe. */ if ( !DBIc_ACTIVE(imp_sth) ) { OCIStmtExecute_log_stat(imp_sth, imp_sth->svchp, imp_sth->stmhp, imp_sth->errhp, 0, 0, 0, 0, OCI_DESCRIBE_ONLY, status); if (status != OCI_SUCCESS) { oci_error(h, imp_sth->errhp, status, ora_sql_error(imp_sth, "OCIStmtExecute/Describe")); if (status != OCI_SUCCESS_WITH_INFO) return 0; } } OCIAttrGet_stmhp_stat(imp_sth, &num_fields, 0, OCI_ATTR_PARAM_COUNT, status); if (status != OCI_SUCCESS) { oci_error(h, imp_sth->errhp, status, "OCIAttrGet OCI_ATTR_PARAM_COUNT"); return 0; } if (num_fields == 0) { if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " dbd_describe skipped for %s (no fields returned)\n", oci_stmt_type_name(imp_sth->stmt_type)); /* imp_sth memory was cleared when created so no setup required here */ return 1; } DBIc_NUM_FIELDS(imp_sth) = num_fields; Newz(42, imp_sth->fbh, num_fields, imp_fbh_t); /* Get number of fields and space needed for field names */ /* loop though the fields and get all the fileds and thier types to get back*/ for(i = 1; i <= num_fields; ++i) { /*start define of filed struct[i] fbh */ char *p; ub4 atrlen; int avg_width = 0; imp_fbh_t *fbh = &imp_sth->fbh[i-1]; fbh->imp_sth = imp_sth; fbh->field_num = i; fbh->define_mode = OCI_DEFAULT; OCIParamGet_log_stat(imp_sth, imp_sth->stmhp, OCI_HTYPE_STMT, imp_sth->errhp, (dvoid**)&fbh->parmdp, (ub4)i, status); if (status != OCI_SUCCESS) { oci_error(h, imp_sth->errhp, status, "OCIParamGet"); return 0; } OCIAttrGet_parmdp(imp_sth, fbh->parmdp, &fbh->dbtype, 0, OCI_ATTR_DATA_TYPE, status); OCIAttrGet_parmdp(imp_sth, fbh->parmdp, &fbh->dbsize, 0, OCI_ATTR_DATA_SIZE, status); /*may be a bug in 11 where the OCI_ATTR_DATA_SIZE my return 0 which should never happen*/ /*to fix or kludge for this I added a little code for ORA_VARCHAR2 below */ #ifdef OCI_ATTR_CHAR_USED /* 0 means byte-length semantics, 1 means character-length semantics */ OCIAttrGet_parmdp(imp_sth, fbh->parmdp, &fbh->len_char_used, 0, OCI_ATTR_CHAR_USED, status); /* OCI_ATTR_CHAR_SIZE: like OCI_ATTR_DATA_SIZE but measured in chars */ OCIAttrGet_parmdp(imp_sth, fbh->parmdp, &fbh->len_char_size, 0, OCI_ATTR_CHAR_SIZE, status); #endif fbh->csid = 0; fbh->csform = 0; /* just to be sure */ #ifdef OCI_ATTR_CHARSET_ID OCIAttrGet_parmdp(imp_sth, fbh->parmdp, &fbh->csid, 0, OCI_ATTR_CHARSET_ID, status); OCIAttrGet_parmdp(imp_sth, fbh->parmdp, &fbh->csform, 0, OCI_ATTR_CHARSET_FORM, status); #endif /* OCI_ATTR_PRECISION returns 0 for most types including some numbers */ OCIAttrGet_parmdp(imp_sth, fbh->parmdp, &fbh->prec, 0, OCI_ATTR_PRECISION, status); OCIAttrGet_parmdp(imp_sth, fbh->parmdp, &fbh->scale, 0, OCI_ATTR_SCALE, status); OCIAttrGet_parmdp(imp_sth, fbh->parmdp, &fbh->nullok, 0, OCI_ATTR_IS_NULL, status); OCIAttrGet_parmdp(imp_sth, fbh->parmdp, &fbh->name, &atrlen, OCI_ATTR_NAME,status); if (atrlen == 0) { /* long names can cause oracle to return 0 for atrlen */ char buf[99]; sprintf(buf,"field_%d_name_too_long", i); fbh->name = &buf[0]; atrlen = strlen(fbh->name); } fbh->name_sv = newSVpv(fbh->name,atrlen); fbh->name = SvPVX(fbh->name_sv); fbh->ftype = 5; /* default: return as null terminated string */ /* TO_DO there is something wrong with the tracing below as sql_typecode_name returns NVARCHAR2 for type 2 and ORA_NUMBER is 2 */ if (DBIc_DBISTATE(imp_sth)->debug >= 4 || dbd_verbose >= 4 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), "Describe col #%d type=%d(%s)\n", i,fbh->dbtype,sql_typecode_name(fbh->dbtype)); switch (fbh->dbtype) { /* the simple types */ case ORA_VARCHAR2: /* VARCHAR2 */ if (fbh->dbsize == 0){ fbh->dbsize=4000; } avg_width = fbh->dbsize / 2; /* FALLTHRU */ case ORA_CHAR: /* CHAR */ if ( CSFORM_IMPLIES_UTF8(fbh->csform) && !CS_IS_UTF8(fbh->csid) ) fbh->disize = fbh->dbsize * 4; else fbh->disize = fbh->dbsize; fbh->prec = fbh->disize; break; case ORA_RAW: /* RAW */ fbh->disize = fbh->dbsize * 2; fbh->prec = fbh->disize; break; case ORA_NUMBER: /* NUMBER */ case 21: /* BINARY FLOAT os-endian */ case 22: /* BINARY DOUBLE os-endian */ case 100: /* BINARY FLOAT oracle-endian */ case 101: /* BINARY DOUBLE oracle-endian */ fbh->disize = 130+38+3; /* worst case */ avg_width = 4; /* NUMBER approx +/- 1_000_000 */ break; case ORA_DATE: /* DATE */ /* actually dependent on NLS default date format*/ fbh->disize = 75; /* a generous default */ fbh->prec = fbh->disize; avg_width = 8; /* size in SQL*Net packet */ break; case ORA_LONG: /* LONG */ imp_sth->row_cache_off = 1; has_longs++; if (imp_sth->clbk_lob){ /*get by peice with callback a slow*/ fbh->clbk_lob = 1; fbh->define_mode = OCI_DYNAMIC_FETCH; /* piecwise fetch*/ fbh->disize = imp_sth->long_readlen; /*user set max value for the fetch*/ fbh->piece_size = imp_sth->piece_size; /*the size for each piece*/ fbh->fetch_cleanup = fetch_cleanup_pres_lobs; /* clean up buffer before each fetch*/ if (!imp_sth->piece_size){ /*if not set use max value*/ imp_sth->piece_size=imp_sth->long_readlen; } fbh->ftype = SQLT_CHR; fbh->fetch_func = fetch_clbk_lob; } else if (imp_sth->piece_lob){ /*get by peice with polling slowest*/ fbh->piece_lob = 1; fbh->define_mode = OCI_DYNAMIC_FETCH; /* piecwise fetch*/ fbh->disize = imp_sth->long_readlen; /*user set max value for the fetch*/ fbh->piece_size = imp_sth->piece_size; /*the size for each piece*/ fbh->fetch_cleanup = fetch_cleanup_pres_lobs; /* clean up buffer before each fetch*/ if (!imp_sth->piece_size){ /*if not set use max value*/ imp_sth->piece_size=imp_sth->long_readlen; } fbh->ftype = SQLT_CHR; fbh->fetch_func = fetch_get_piece; } else { if ( CSFORM_IMPLIES_UTF8(fbh->csform) && !CS_IS_UTF8(fbh->csid) ) fbh->disize = long_readlen * 4; else fbh->disize = long_readlen; /* not governed by else: */ fbh->dbsize = (fbh->disize>65535) ? 65535 : fbh->disize; fbh->ftype = 94; /* VAR form */ fbh->fetch_func = fetch_func_varfield; } break; case ORA_LONGRAW: /* LONG RAW */ has_longs++; if (imp_sth->clbk_lob){ /*get by peice with callback a slow*/ fbh->clbk_lob = 1; fbh->define_mode = OCI_DYNAMIC_FETCH; /* piecwise fetch*/ fbh->disize = imp_sth->long_readlen; /*user set max value for the fetch*/ fbh->piece_size = imp_sth->piece_size; /*the size for each piece*/ fbh->fetch_cleanup = fetch_cleanup_pres_lobs; /* clean up buffer before each fetch*/ if (!imp_sth->piece_size){ /*if not set use max value*/ imp_sth->piece_size=imp_sth->long_readlen; } fbh->ftype = SQLT_BIN; fbh->fetch_func = fetch_clbk_lob; } else if (imp_sth->piece_lob){ /*get by peice with polling slowest*/ fbh->piece_lob = 1; fbh->define_mode = OCI_DYNAMIC_FETCH; /* piecwise fetch*/ fbh->disize = imp_sth->long_readlen; /*user set max value for the fetch*/ fbh->piece_size = imp_sth->piece_size; /*the size for each piece*/ fbh->fetch_cleanup = fetch_cleanup_pres_lobs; /* clean up buffer before each fetch*/ if (!imp_sth->piece_size){ /*if not set use max value*/ imp_sth->piece_size=imp_sth->long_readlen; } fbh->ftype = SQLT_BIN; fbh->fetch_func = fetch_get_piece; } else { fbh->disize = long_readlen * 2; fbh->dbsize = (fbh->disize>65535) ? 65535 : fbh->disize; fbh->ftype = 95; /* VAR form */ fbh->fetch_func = fetch_func_varfield; } break; case ORA_ROWID: /* ROWID */ case 104: /* ROWID Desc */ fbh->disize = 20; fbh->prec = fbh->disize; break; case 108: /* some sort of embedded object */ imp_sth->row_cache_off = 1;/* cant fetch more thatn one at a time */ fbh->ftype = fbh->dbtype; /*varray or alike */ fbh->fetch_func = fetch_func_oci_object; /* need a new fetch function for it */ fbh->fetch_cleanup = fetch_cleanup_oci_object; /* clean up any AV from the fetch*/ fbh->desc_t = SQLT_NTY; if (!imp_sth->dschp){ OCIHandleAlloc_ok(imp_sth, imp_sth->envhp, &imp_sth->dschp, OCI_HTYPE_DESCRIBE, status); if (status != OCI_SUCCESS) { oci_error(h,imp_sth->errhp, status, "OCIHandleAlloc"); ++num_errors; } } break; case ORA_CLOB: /* CLOB & NCLOB */ case ORA_BLOB: /* BLOB */ case ORA_BFILE: /* BFILE */ has_longs++; fbh->ftype = fbh->dbtype; imp_sth->ret_lobs = 1; imp_sth->row_cache_off = 1; /* Cannot use mulit fetch for a lob*/ /* Unless they are just getting the locator */ if (imp_sth->pers_lob){ /*get as one peice fasted but limited to 64k big you can get.*/ fbh->pers_lob = 1; if (long_readlen){ fbh->disize =long_readlen;/*user set max value for the fetch*/ } else { fbh->disize = fbh->dbsize*10; /*default size*/ } if (fbh->dbtype == ORA_CLOB){ fbh->ftype = SQLT_CHR;/*SQLT_LNG*/ } else { fbh->ftype = SQLT_LVB; /*Binary form seems this is the only value where we can get the length correctly*/ } } else if (imp_sth->clbk_lob){ /*get by peice with callback a slow*/ fbh->clbk_lob = 1; fbh->define_mode = OCI_DYNAMIC_FETCH; /* piecwise fetch*/ fbh->disize = imp_sth->long_readlen; /*user set max value for the fetch*/ fbh->piece_size = imp_sth->piece_size; /*the size for each piece*/ fbh->fetch_cleanup = fetch_cleanup_pres_lobs; /* clean up buffer before each fetch*/ if (!imp_sth->piece_size){ /*if not set use max value*/ imp_sth->piece_size=imp_sth->long_readlen; } if (fbh->dbtype == ORA_CLOB){ fbh->ftype = SQLT_CHR; } else { fbh->ftype = SQLT_BIN; /*other Binary*/ } fbh->fetch_func = fetch_clbk_lob; } else if (imp_sth->piece_lob){ /*get by peice with polling slowest*/ fbh->piece_lob = 1; fbh->define_mode = OCI_DYNAMIC_FETCH; /* piecwise fetch*/ fbh->disize = imp_sth->long_readlen; /*user set max value for the fetch*/ fbh->piece_size = imp_sth->piece_size; /*the size for each piece*/ fbh->fetch_cleanup = fetch_cleanup_pres_lobs; /* clean up buffer before each fetch*/ if (!imp_sth->piece_size){ /*if not set use max value*/ imp_sth->piece_size=imp_sth->long_readlen; } if (fbh->dbtype == ORA_CLOB){ fbh->ftype = SQLT_CHR; } else { fbh->ftype = SQLT_BIN; /*other Binary */ } fbh->fetch_func = fetch_get_piece; } else { /*auto lob fetch with locator by far the fastest*/ fbh->disize = sizeof(OCILobLocator*);/* Size of the lob locator ar we do not really get the lob! */ if (imp_sth->auto_lob) { fbh->fetch_func = fetch_func_autolob; } else { fbh->fetch_func = fetch_func_getrefpv; } fbh->bless = "OCILobLocatorPtr"; fbh->desc_t = OCI_DTYPE_LOB; OCIDescriptorAlloc_ok(imp_sth, imp_sth->envhp, &fbh->desc_h, fbh->desc_t); } break; #ifdef OCI_DTYPE_REF case 111: /* REF */ fbh_setup_getrefpv(imp_sth, fbh, OCI_DTYPE_REF, "OCIRefPtr"); break; #endif case ORA_RSET: /* RSET */ fbh->ftype = fbh->dbtype; fbh->disize = sizeof(OCIStmt *); fbh->fetch_func = fetch_func_rset; fbh->fetch_cleanup = fetch_cleanup_rset; nested_cursors++; break; case 182: /* INTERVAL YEAR TO MONTH */ case 183: /* INTERVAL DAY TO SECOND */ case 185: /* TIME (ocidfn.h) */ case 186: /* TIME WITH TIME ZONE (ocidfn.h) */ case 187: /* TIMESTAMP */ case 188: /* TIMESTAMP WITH TIME ZONE */ case 189: /* INTERVAL YEAR TO MONTH (ocidfn.h) */ case 190: /* INTERVAL DAY TO SECOND */ case 232: /* TIMESTAMP WITH LOCAL TIME ZONE */ /* actually dependent on NLS default date format*/ fbh->disize = 75; /* XXX */ break; default: /* XXX unhandled type may lead to errors or worse */ fbh->ftype = fbh->dbtype; fbh->disize = fbh->dbsize; p = "Field %d has an Oracle type (%d) which is not explicitly supported%s"; if (DBIc_DBISTATE(imp_sth)->debug >= 1 || dbd_verbose >= 3 ) PerlIO_printf(DBIc_LOGPIO(imp_sth), p, i, fbh->dbtype, "\n"); if (PL_dowarn) warn(p, i, fbh->dbtype, ""); break; } if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), "Described col %2d: dbtype %d(%s), scale %d, prec %d, nullok %d, " "name %s\n : dbsize %d, char_used %d, char_size %d, " "csid %d, csform %d(%s), disize %d\n", i, fbh->dbtype, sql_typecode_name(fbh->dbtype), fbh->scale, fbh->prec, fbh->nullok, fbh->name, fbh->dbsize, fbh->len_char_used, fbh->len_char_size, fbh->csid,fbh->csform,oci_csform_name(fbh->csform), fbh->disize); if (fbh->ftype == 5) /* XXX need to handle wide chars somehow */ fbh->disize += 1; /* allow for null terminator */ /* dbsize can be zero for 'select NULL ...' */ imp_sth->t_dbsize += fbh->dbsize; if (!avg_width) avg_width = fbh->dbsize; est_width += avg_width; if (DBIc_DBISTATE(imp_sth)->debug >= 2 || dbd_verbose >= 3 ) dbd_fbh_dump(imp_sth, fbh, (int)i, 0); }/* end define of filed struct[i] fbh*/ imp_sth->est_width = est_width; sth_set_row_cache(h, imp_sth, (imp_dbh->max_nested_cursors) ? 0 :nested_cursors , (int)num_fields, has_longs ); /* Initialise cache counters */ imp_sth->in_cache = 0; imp_sth->eod_errno = 0; /*rs_array_init(imp_sth);*/ /* now set up the oci call with define by pos*/ for(i=1; i <= num_fields; ++i) { imp_fbh_t *fbh = &imp_sth->fbh[i-1]; int ftype = fbh->ftype; /* add space for STRING null term, or VAR len prefix */ sb4 define_len = (ftype==94||ftype==95) ? fbh->disize+4 : fbh->disize; fb_ary_t *fb_ary; if (fbh->clbk_lob || fbh->piece_lob ){/*init the cb_abuf with this call*/ fbh->fb_ary = fb_ary_cb_alloc(imp_sth->piece_size,define_len, imp_sth->rs_array_size); } else { fbh->fb_ary = fb_ary_alloc(define_len, imp_sth->rs_array_size); } fb_ary = fbh->fb_ary; if (fbh->ftype == SQLT_BIN) { define_len++; /*add one extra byte incase the size of the lob is equal to the define_len*/ } if (fbh->ftype == ORA_RSET) { /* RSET */ OCIHandleAlloc_ok(imp_sth, imp_sth->envhp, (dvoid*)&((OCIStmt **)fb_ary->abuf)[0], OCI_HTYPE_STMT, status); } OCIDefineByPos_log_stat(imp_sth, imp_sth->stmhp, &fbh->defnp, imp_sth->errhp, (ub4) i, (fbh->desc_h) ? (dvoid*)&fbh->desc_h : fbh->clbk_lob ? (dvoid *) 0: fbh->piece_lob ? (dvoid *) 0:(dvoid*)fb_ary->abuf, (fbh->desc_h) ? 0 : define_len, (ub2)fbh->ftype, fb_ary->aindp, (ftype==94||ftype==95) ? NULL : fb_ary->arlen, fb_ary->arcode, fbh->define_mode, status); if (fbh->clbk_lob){ /* use a dynamic callback for persistent binary and char lobs*/ OCIDefineDynamic_log_stat(imp_sth, fbh->defnp,imp_sth->errhp,(dvoid *) fbh,status); } if (fbh->ftype == 108) { /* Embedded object bind it differently*/ if (DBIc_DBISTATE(imp_sth)->debug >= 5 || dbd_verbose >= 5 ){ PerlIO_printf( DBIc_LOGPIO(imp_sth), "Field #%d is a object or colection of some sort. " "Using OCIDefineObject and or OCIObjectPin \n",i); } Newz(1, fbh->obj, 1, fbh_obj_t); fbh->obj->typecode=fbh->dbtype; if (!describe_obj(h,imp_sth,fbh->parmdp,fbh->obj,0)){ ++num_errors; } if (DBIc_DBISTATE(imp_sth)->debug >= 5 || dbd_verbose >= 5 ){ dump_struct(imp_sth,fbh->obj,0); } OCIDefineObject_log_stat(imp_sth,fbh->defnp,imp_sth->errhp,fbh->obj->tdo,(dvoid**)&fbh->obj->obj_value,(dvoid**)&fbh->obj->obj_ind,status); if (status != OCI_SUCCESS) { oci_error(h,imp_sth->errhp, status, "OCIDefineObject"); ++num_errors; } } if (status != OCI_SUCCESS) { oci_error(h, imp_sth->errhp, status, "OCIDefineByPos"); ++num_errors; } #ifdef OCI_ATTR_CHARSET_FORM if ( (fbh->dbtype == 1) && fbh->csform ) { /* csform may be 0 when talking to Oracle 8.0 database*/ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " calling OCIAttrSet OCI_ATTR_CHARSET_FORM with csform=%d (%s)\n", fbh->csform,oci_csform_name(fbh->csform) ); OCIAttrSet_log_stat(imp_sth, fbh->defnp, (ub4) OCI_HTYPE_DEFINE, (dvoid *) &fbh->csform, (ub4) 0, (ub4) OCI_ATTR_CHARSET_FORM, imp_sth->errhp, status ); if (status != OCI_SUCCESS) { oci_error(h, imp_sth->errhp, status, "OCIAttrSet OCI_ATTR_CHARSET_FORM"); ++num_errors; } } #endif /* OCI_ATTR_CHARSET_FORM */ } if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " dbd_describe'd %d columns (row bytes: %d max, %d est avg, cache: %d)\n", (int)num_fields, imp_sth->t_dbsize, imp_sth->est_width, imp_sth->prefetch_rows); return (num_errors>0) ? 0 : 1; } AV * dbd_st_fetch(SV *sth, imp_sth_t *imp_sth){ dTHX; D_imp_xxh(sth); sword status; D_imp_dbh_from_sth; int num_fields = DBIc_NUM_FIELDS(imp_sth); int ChopBlanks; int err; int i; AV *av; /* Check that execute() was executed sucessfully. This also implies */ /* that dbd_describe() executed sucessfuly so the memory buffers */ /* are allocated and bound. */ if ( !DBIc_ACTIVE(imp_sth) ) { oci_error(sth, NULL, OCI_ERROR, imp_sth->nested_cursor ? "nested cursor is defunct (parent row is no longer current)" : "no statement executing (perhaps you need to call execute first)"); return Nullav; } for(i=0; i < num_fields; ++i) { imp_fbh_t *fbh = &imp_sth->fbh[i]; if (fbh->fetch_cleanup) fbh->fetch_cleanup(sth, fbh); } if (ora_fetchtest && DBIc_ROW_COUNT(imp_sth)>0) { --ora_fetchtest; /* trick for testing performance */ status = OCI_SUCCESS; } else { if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ){ PerlIO_printf( DBIc_LOGPIO(imp_sth), " dbd_st_fetch %d fields...\n", DBIc_NUM_FIELDS(imp_sth)); } if (imp_sth->fetch_orient != OCI_DEFAULT) { if (imp_sth->exe_mode!=OCI_STMT_SCROLLABLE_READONLY) croak ("attempt to use a scrollable cursor without first setting ora_exe_mode to OCI_STMT_SCROLLABLE_READONLY\n") ; if (DBIc_DBISTATE(imp_sth)->debug >= 4 || dbd_verbose >= 4 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " Scrolling Fetch, position before fetch=%d, " "Orientation = %s , Fetchoffset =%d\n", imp_sth->fetch_position, oci_fetch_options(imp_sth->fetch_orient), imp_sth->fetch_offset); OCIStmtFetch_log_stat(imp_sth, imp_sth->stmhp, imp_sth->errhp,1, imp_sth->fetch_orient,imp_sth->fetch_offset, status); /*this will work without a round trip so might as well open it up for all statments handles*/ /* default and OCI_FETCH_NEXT are the same so this avoids miscaluation on the next value*/ if (status==OCI_NO_DATA){ return Nullav; } OCIAttrGet_stmhp_stat(imp_sth, &imp_sth->fetch_position, 0, OCI_ATTR_CURRENT_POSITION, status); if (DBIc_DBISTATE(imp_sth)->debug >= 4 || dbd_verbose >= 4 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " Scrolling Fetch, postion after fetch=%d\n", imp_sth->fetch_position); } else { if (imp_sth->row_cache_off){ /*Do not use array fetch or local cache */ OCIStmtFetch_log_stat(imp_sth, imp_sth->stmhp, imp_sth->errhp,1,(ub2)OCI_FETCH_NEXT, OCI_DEFAULT, status); imp_sth->rs_fetch_count++; imp_sth->rs_array_idx=0; } else { /*Array Fetch the New Normal Super speedy and very nice*/ imp_sth->rs_array_idx++; if (imp_sth->rs_array_num_rows<=imp_sth->rs_array_idx && (imp_sth->rs_array_status==OCI_SUCCESS || imp_sth->rs_array_status==OCI_SUCCESS_WITH_INFO)) { /* PerlIO_printf(DBIc_LOGPIO(imp_sth), " dbd_st_fetch fields...b\n");*/ OCIStmtFetch_log_stat(imp_sth, imp_sth->stmhp,imp_sth->errhp,imp_sth->rs_array_size,(ub2)OCI_FETCH_NEXT,OCI_DEFAULT,status); imp_sth->rs_array_status=status; imp_sth->rs_fetch_count++; if (oci_warn && (imp_sth->rs_array_status == OCI_SUCCESS_WITH_INFO)) { oci_error(sth, imp_sth->errhp, status, "OCIStmtFetch"); } OCIAttrGet_stmhp_stat(imp_sth, &imp_sth->rs_array_num_rows,0,OCI_ATTR_ROWS_FETCHED, status); imp_sth->rs_array_idx=0; imp_dbh->RowsInCache =imp_sth->rs_array_size; imp_sth->RowsInCache =imp_sth->rs_array_size; if (DBIc_DBISTATE(imp_sth)->debug >= 4 || dbd_verbose >= 4 || oci_warn) PerlIO_printf( DBIc_LOGPIO(imp_sth), "...Fetched %d rows\n",imp_sth->rs_array_num_rows); } imp_dbh->RowsInCache--; imp_sth->RowsInCache--; if (imp_sth->rs_array_num_rows>imp_sth->rs_array_idx) /* set status to success if rows in cache */ status=OCI_SUCCESS; else status=imp_sth->rs_array_status; } } } if (status != OCI_SUCCESS && status !=OCI_NEED_DATA) { ora_fetchtest = 0; if (status == OCI_NO_DATA) { dTHR; /* for DBIc_ACTIVE_off */ DBIc_ACTIVE_off(imp_sth); /* eg finish */ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 || oci_warn) PerlIO_printf( DBIc_LOGPIO(imp_sth), " dbd_st_fetch no-more-data, fetch count=%d\n", imp_sth->rs_fetch_count-1); return Nullav; } if (status != OCI_SUCCESS_WITH_INFO) { dTHR; /* for DBIc_ACTIVE_off */ DBIc_ACTIVE_off(imp_sth); /* eg finish */ oci_error(sth, imp_sth->errhp, status, "OCIStmtFetch"); return Nullav; } if (oci_warn && (status == OCI_SUCCESS_WITH_INFO)) { oci_error(sth, imp_sth->errhp, status, "OCIStmtFetch"); } /* for OCI_SUCCESS_WITH_INFO we fall through and let the */ /* per-field rcode value be dealt with as we fetch the data */ } av = DBIc_DBISTATE(imp_sth)->get_fbav(imp_sth); if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) { PerlIO_printf( DBIc_LOGPIO(imp_sth), " dbd_st_fetched %d fields with status of %d(%s)\n", num_fields,status, oci_status_name(status)); } ChopBlanks = DBIc_has(imp_sth, DBIcf_ChopBlanks); err = 0; for(i=0; i < num_fields; ++i) { imp_fbh_t *fbh = &imp_sth->fbh[i]; fb_ary_t *fb_ary = fbh->fb_ary; int rc = fb_ary->arcode[imp_sth->rs_array_idx]; ub1* row_data = &fb_ary->abuf[0]+(fb_ary->bufl*imp_sth->rs_array_idx); SV *sv = AvARRAY(av)[i]; /* Note: we (re)use the SV in the AV */; if (DBIc_DBISTATE(imp_sth)->debug >= 4 || dbd_verbose >= 4 ) { PerlIO_printf( DBIc_LOGPIO(imp_sth), " field #%d with rc=%d(%s)\n",i+1,rc,oci_col_return_codes(rc)); } if (rc == 1406 /* field was truncated */ && ora_dbtype_is_long(fbh->dbtype)/* field is a LONG */ ){ int oraperl = DBIc_COMPAT(imp_sth); D_imp_dbh_from_sth ; D_imp_drh_from_dbh ; if (DBIc_has(imp_sth,DBIcf_LongTruncOk) || (oraperl && SvIV(imp_drh -> ora_trunc))) { /* user says truncation is ok */ /* Oraperl recorded the truncation in ora_errno so we */ /* so also but only for Oraperl mode handles. */ if (oraperl) sv_setiv(DBIc_ERR(imp_sth), (IV)rc); rc = 0; /* but don't provoke an error here */ } /* else fall through and let rc trigger failure below */ } if (rc == 0 || /* the normal case*/ (rc == 1406 && DBIc_has(imp_sth,DBIcf_LongTruncOk))/*Field Truncaded*/) { if (fbh->fetch_func) { if (!fbh->fetch_func(sth, fbh, sv)){ ++err; /* fetch_func already called oci_error */ } } else { int datalen = fb_ary->arlen[imp_sth->rs_array_idx]; char *p = (char*)row_data; if (rc == 1406 ){ datalen= fbh->disize; } if (fbh->ftype == SQLT_LVB){ /* very special case for binary lobs that are directly fetched. Seems I have to use SQLT_LVB to get the length all other will fail*/ datalen = *(ub4*)row_data; sv_setpvn(sv, (char*)row_data+ sizeof(ub4), datalen); } else { if (ChopBlanks && fbh->dbtype == 96) { while(datalen && p[datalen - 1]==' ') --datalen; } sv_setpvn(sv, p, (STRLEN)datalen); #if DBIXS_REVISION > 13590 /* If a bind type was specified we use DBI's sql_type_cast to cast it - currently only number types are handled */ if ((fbh->req_type != 0) && (fbh->bind_flags != 0)) { int sts; char errstr[256]; sts = DBIc_DBISTATE(imp_sth)->sql_type_cast_svpv( aTHX_ sv, fbh->req_type, fbh->bind_flags, NULL); if (sts == 0) { sprintf(errstr, "over/under flow converting column %d to type %"IVdf"", i+1, fbh->req_type); oci_error(sth, imp_sth->errhp, OCI_ERROR, errstr); return Nullav; } else if (sts == -2) { sprintf(errstr, "unsupported bind type %"IVdf" for column %d", fbh->req_type, i+1); /* issue warning */ DBIh_SET_ERR_CHAR(sth, imp_xxh, "0", 1, errstr, Nullch, Nullch); if (CSFORM_IMPLIES_UTF8(fbh->csform) ){ SvUTF8_on(sv); } } } else #endif /* DBISTATE_VERSION > 94 */ { if (CSFORM_IMPLIES_UTF8(fbh->csform) ){ SvUTF8_on(sv); } } } } } else if (rc == 1405) { /* field is null - return undef */ sv_set_undef(sv); } else { /* See odefin rcode arg description in OCI docs */ char buf[200]; char *hint = ""; /* These may get more case-by-case treatment eventually. */ if (rc == 1406) { /* field truncated (see above) */ if (!fbh->fetch_func) { /* Copy the truncated value anyway, it may be of use, */ /* but it'll only be accessible via prior bind_column() */ sv_setpvn(sv, (char *)row_data,fb_ary->arlen[imp_sth->rs_array_idx]); if ((CSFORM_IMPLIES_UTF8(fbh->csform)) && (fbh->ftype != SQLT_BIN)){ SvUTF8_on(sv); } } if (ora_dbtype_is_long(fbh->dbtype)){ /* double check */ hint = ", LongReadLen too small and/or LongTruncOk not set"; } } else { /* set field that caused error to undef */ sv_set_undef(sv); } ++err; /* 'fail' this fetch but continue getting fields */ /* Some should probably be treated as warnings but */ /* for now we just treat them all as errors */ sprintf(buf,"ORA-%05d error on field %d of %d, ora_type %d%s",rc, i+1, num_fields, fbh->dbtype, hint); oci_error(sth, imp_sth->errhp, OCI_ERROR, buf); } if (DBIc_DBISTATE(imp_sth)->debug >= 5 || dbd_verbose >= 5 ){ PerlIO_printf( DBIc_LOGPIO(imp_sth), "\n %p (field=%d): %s\n", av, i,neatsvpv(sv,10)); } } return (err) ? Nullav : av; } ub4 ora_parse_uid(imp_dbh_t *imp_dbh, char **uidp, char **pwdp) { dTHX; sword status; /* OCI 8 does not seem to allow uid to be "name/pass" :-( */ /* so we have to split it up ourselves */ if (strlen(*pwdp)==0 && strchr(*uidp,'/')) { SV *tmpsv = sv_2mortal(newSVpv(*uidp,0)); *uidp = SvPVX(tmpsv); *pwdp = strchr(*uidp, '/'); *(*pwdp)++ = '\0'; /* XXX look for '@', e.g. "u/p@d" and "u@d" and maybe "@d"? */ } if (**uidp == '\0' && **pwdp == '\0') { return OCI_CRED_EXT; } #ifdef ORA_OCI_112 if (imp_dbh->using_drcp){ OCIAttrSet_log_stat(imp_dbh, imp_dbh->authp, OCI_HTYPE_SESSION, *uidp, strlen(*uidp), (ub4) OCI_ATTR_USERNAME, imp_dbh->errhp, status); OCIAttrSet_log_stat(imp_dbh, imp_dbh->authp, OCI_HTYPE_SESSION, (strlen(*pwdp)) ? *pwdp : NULL, strlen(*pwdp), (ub4) OCI_ATTR_PASSWORD, imp_dbh->errhp, status); } else { #endif OCIAttrSet_log_stat(imp_dbh, imp_dbh->seshp, OCI_HTYPE_SESSION, *uidp, strlen(*uidp), (ub4) OCI_ATTR_USERNAME, imp_dbh->errhp, status); OCIAttrSet_log_stat(imp_dbh, imp_dbh->seshp, OCI_HTYPE_SESSION, (strlen(*pwdp)) ? *pwdp : NULL, strlen(*pwdp), (ub4) OCI_ATTR_PASSWORD, imp_dbh->errhp, status); #ifdef ORA_OCI_112 } #endif return OCI_CRED_RDBMS; } int ora_db_reauthenticate(SV *dbh, imp_dbh_t *imp_dbh, char *uid, char *pwd) { dTHX; sword status; /* XXX should possibly create new session before ending the old so */ /* that if the new one can't be created, the old will still work. */ OCISessionEnd_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, imp_dbh->seshp, OCI_DEFAULT, status); /* XXX check status here?*/ OCISessionBegin_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, imp_dbh->seshp, ora_parse_uid(imp_dbh, &uid, &pwd), (ub4) OCI_DEFAULT, status); if (status != OCI_SUCCESS) { oci_error(dbh, imp_dbh->errhp, status, "OCISessionBegin"); return 0; } return 1; } #ifdef not_used_curently static char * rowid2hex(OCIRowid *rowid) { int i; SV *sv = sv_2mortal(newSVpv("",0)); for (i = 0; i < OCI_ROWID_LEN; i++) { char buf[6]; sprintf(buf, "%02X ", (int)(((ub1*)rowid)[i])); sv_catpv(sv, buf); } return SvPVX(sv); } #endif static void * alloc_via_sv(STRLEN len, SV **svp, int mortal) { dTHX; SV *sv = newSVpv("",0); sv_grow(sv, len+1); memset(SvPVX(sv), 0, len); if (mortal) sv_2mortal(sv); if (svp) *svp = sv; return SvPVX(sv); } char * find_ident_after(char *src, char *after, STRLEN *len, int copy) { int seen_key = 0; char *orig = src; char *p; while(*src){ if (*src == '\'') { char delim = *src; while(*src && *src != delim) ++src; } else if (*src == '-' && src[1] == '-') { while(*src && *src != '\n') ++src; } else if (*src == '/' && src[1] == '*') { while(*src && !(*src == '*' && src[1]=='/')) ++src; } else if (isALPHA(*src)) { if (seen_key) { char *start = src; while(*src && (isALNUM(*src) || *src=='.' || *src=='$' || *src=='"')) ++src; *len = src - start; if (copy) { p = (char*)alloc_via_sv(*len, 0, 1); strncpy(p, start, *len); p[*len] = '\0'; return p; } return start; } else if ( toLOWER(*src)==toLOWER(*after) && (src==orig ? 1 : !isALPHA(src[-1]))) { p = after; while(*p && *src && toLOWER(*p)==toLOWER(*src)) ++p, ++src; if (!*p) seen_key = 1; } ++src; } else ++src; } return NULL; } struct lob_refetch_st { OCIStmt *stmthp; OCIBind *bindhp; OCIRowid *rowid; OCIParam *parmdp_tmp; OCIParam *parmdp_lob; int num_fields; SV *fbh_ary_sv; imp_fbh_t *fbh_ary; }; static int init_lob_refetch(SV *sth, imp_sth_t *imp_sth) { dTHX; SV *sv; SV *sql_select; HV *lob_cols_hv = NULL; sword status; OCIError *errhp = imp_sth->errhp; OCIParam *parmhp = NULL, *collisthd = NULL, *colhd = NULL; ub2 numcols = 0; imp_fbh_t *fbh; int unmatched_params; I32 i,j; char *p; lob_refetch_t *lr = NULL; STRLEN tablename_len; char *tablename; char new_tablename[100]; switch (imp_sth->stmt_type) { case OCI_STMT_UPDATE: tablename = find_ident_after(imp_sth->statement, "update", &tablename_len, 1); break; case OCI_STMT_INSERT: tablename = find_ident_after(imp_sth->statement, "into", &tablename_len, 1); break; default: return oci_error(sth, errhp, OCI_ERROR, "LOB refetch attempted for unsupported statement type (see also ora_auto_lob attribute)"); } if (!tablename) return oci_error(sth, errhp, OCI_ERROR, "Unable to parse table name for LOB refetch"); if (!imp_sth->dschp){ OCIHandleAlloc_ok(imp_sth, imp_sth->envhp, &imp_sth->dschp, OCI_HTYPE_DESCRIBE, status); if (status != OCI_SUCCESS) { oci_error(sth,imp_sth->errhp, status, "OCIHandleAlloc"); } } OCIDescribeAny_log_stat(imp_sth, imp_sth->svchp, errhp, tablename, strlen(tablename), (ub1)OCI_OTYPE_NAME, (ub1)1, (ub1)OCI_PTYPE_SYN, imp_sth->dschp, status); if (status == OCI_SUCCESS) { /* There is a synonym, get the schema */ char *syn_schema=NULL; char syn_name[100]; ub4 tn_len = 0, syn_schema_len = 0; strncpy(syn_name,tablename,strlen(tablename)); /* Put the synonym name here for later user */ OCIAttrGet_log_stat(imp_sth, imp_sth->dschp, OCI_HTYPE_DESCRIBE, &parmhp, 0, OCI_ATTR_PARAM, errhp, status); OCIAttrGet_log_stat(imp_sth, parmhp, OCI_DTYPE_PARAM, &syn_schema, &syn_schema_len, OCI_ATTR_SCHEMA_NAME, errhp, status); OCIAttrGet_log_stat(imp_sth, parmhp, OCI_DTYPE_PARAM, &tablename, &tn_len, OCI_ATTR_NAME, errhp, status); strncpy(new_tablename,syn_schema,syn_schema_len); new_tablename[syn_schema_len+1] = '\0'; new_tablename[syn_schema_len]='.'; strncat(new_tablename, tablename,tn_len); tablename=new_tablename; if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " lob refetch using a synonym named=%s for %s \n", syn_name,tablename); } OCIDescribeAny_log_stat(imp_sth, imp_sth->svchp, errhp, tablename, strlen(tablename), (ub1)OCI_OTYPE_NAME, (ub1)1, (ub1)OCI_PTYPE_TABLE, imp_sth->dschp, status); if (status != OCI_SUCCESS) { /* XXX this OCI_PTYPE_TABLE->OCI_PTYPE_VIEW fallback should actually be */ /* a loop that includes synonyms etc */ OCIDescribeAny_log_stat(imp_sth, imp_sth->svchp, errhp, tablename, strlen(tablename), (ub1)OCI_OTYPE_NAME, (ub1)1, (ub1)OCI_PTYPE_VIEW, imp_sth->dschp, status); if (status != OCI_SUCCESS) { OCIHandleFree_log_stat(imp_sth, imp_sth->dschp, OCI_HTYPE_DESCRIBE, status); return oci_error(sth, errhp, status, "OCIDescribeAny(view)/LOB refetch"); } } OCIAttrGet_log_stat(imp_sth, imp_sth->dschp, OCI_HTYPE_DESCRIBE, &parmhp, 0, OCI_ATTR_PARAM, errhp, status); if (!status ) { OCIAttrGet_log_stat(imp_sth, parmhp, OCI_DTYPE_PARAM, &numcols, 0, OCI_ATTR_NUM_COLS, errhp, status); } if (!status ) { OCIAttrGet_log_stat(imp_sth, parmhp, OCI_DTYPE_PARAM, &collisthd, 0, OCI_ATTR_LIST_COLUMNS, errhp, status); } if (status != OCI_SUCCESS) { OCIHandleFree_log_stat(imp_sth, imp_sth->dschp, OCI_HTYPE_DESCRIBE, status); return oci_error(sth, errhp, status, "OCIDescribeAny/OCIAttrGet/LOB refetch"); } if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " lob refetch from table %s, %d columns:\n", tablename, numcols); for (i = 1; i <= (long)numcols; i++) { ub2 col_dbtype; char *col_name; ub4 col_name_len; OCIParamGet_log_stat(imp_sth, collisthd, OCI_DTYPE_PARAM, errhp, (dvoid**)&colhd, i, status); if (status) break; OCIAttrGet_log_stat(imp_sth, colhd, OCI_DTYPE_PARAM, &col_dbtype, 0, OCI_ATTR_DATA_TYPE, errhp, status); if (status) break; OCIAttrGet_log_stat(imp_sth, colhd, OCI_DTYPE_PARAM, &col_name, &col_name_len, OCI_ATTR_NAME, errhp, status); if (status) break; if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " lob refetch table col %d: '%.*s' otype %d\n", (int)i, (int)col_name_len,col_name, col_dbtype); if (col_dbtype != SQLT_CLOB && col_dbtype != SQLT_BLOB) continue; if (!lob_cols_hv) lob_cols_hv = newHV(); sv = newSViv(col_dbtype); (void)sv_setpvn(sv, col_name, col_name_len); if (CSFORM_IMPLIES_UTF8(SQLCS_IMPLICIT)) SvUTF8_on(sv); (void)SvIOK_on(sv); /* "what a wonderful hack!" */ (void)hv_store(lob_cols_hv, col_name,col_name_len, sv,0); OCIDescriptorFree_log(imp_sth, colhd, OCI_DTYPE_PARAM); colhd = NULL; } if (colhd) OCIDescriptorFree_log(imp_sth, colhd, OCI_DTYPE_PARAM); if (status != OCI_SUCCESS) { oci_error(sth, errhp, status, "OCIDescribeAny/OCIParamGet/OCIAttrGet/LOB refetch"); OCIHandleFree_log_stat(imp_sth, imp_sth->dschp, OCI_HTYPE_DESCRIBE, status); return 0; } if (!lob_cols_hv) return oci_error(sth, errhp, OCI_ERROR, "LOB refetch failed, no lobs in table"); /* our bind params are in %imp_sth->all_params_hv our table cols are in %lob_cols_hv we now iterate through our bind params and allocate them to the appropriate table columns */ Newz(1, lr, 1, lob_refetch_t); unmatched_params = 0; lr->num_fields = 0; lr->fbh_ary = (imp_fbh_t*)alloc_via_sv(sizeof(imp_fbh_t) * HvKEYS(lob_cols_hv)+1, &lr->fbh_ary_sv, 0); sql_select = sv_2mortal(newSVpv("select ",0)); hv_iterinit(imp_sth->all_params_hv); while( (sv = hv_iternextsv(imp_sth->all_params_hv, &p, &i)) != NULL ) { int matched = 0; phs_t *phs = (phs_t*)(void*)SvPVX(sv); if (sv == &PL_sv_undef || !phs) croak("panic: unbound params"); if (phs->ftype != SQLT_CLOB && phs->ftype != SQLT_BLOB) continue; hv_iterinit(lob_cols_hv); while( (sv = hv_iternextsv(lob_cols_hv, &p, &j)) != NULL ) { char sql_field[200]; if (phs->ora_field) { /* must match this phs by field name */ char *ora_field_name = SvPV(phs->ora_field,PL_na); if (SvCUR(phs->ora_field) != SvCUR(sv) || ibcmp(ora_field_name, SvPV(sv,PL_na), (I32)SvCUR(sv) ) ) continue; } else { /* basic dumb match by type */ if (phs->ftype != SvIV(sv)){ continue; } else { /* got a type match - check it's safe */ SV *sv_other; char *p_other; /* would any other lob field match this type? */ while( (sv_other = hv_iternextsv(lob_cols_hv, &p_other, &i)) != NULL ) { if (phs->ftype != SvIV(sv_other)) continue; if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " both %s and %s have type %d - ambiguous\n", neatsvpv(sv,0), neatsvpv(sv_other,0), (int)SvIV(sv_other)); Safefree(lr); sv_free((SV*)lob_cols_hv); return oci_error(sth, errhp, OCI_ERROR, "Need bind_param(..., { ora_field=>... }) attribute to identify table LOB field names"); } } } matched = 1; sprintf(sql_field, "%s%s \"%s\"", (SvCUR(sql_select)>7)?", ":"", p, &phs->name[1]); sv_catpv(sql_select, sql_field); if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " lob refetch %s param: otype %d, matched field '%s' %s(%s)\n", phs->name, phs->ftype, p, (phs->ora_field) ? "by name " : "by type ", sql_field); (void)hv_delete(lob_cols_hv, p, i, G_DISCARD); fbh = &lr->fbh_ary[lr->num_fields++]; fbh->name = phs->name; fbh->ftype = phs->ftype; fbh->dbtype = phs->ftype; fbh->disize = 99; fbh->desc_t = OCI_DTYPE_LOB; OCIDescriptorAlloc_ok(imp_sth, imp_sth->envhp, &fbh->desc_h, fbh->desc_t); break; /* we're done with this placeholder now */ } if (!matched) { ++unmatched_params; if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " lob refetch %s param: otype %d, UNMATCHED\n", phs->name, phs->ftype); } } sv_free((SV*)lob_cols_hv); if (unmatched_params) { Safefree(lr); return oci_error(sth, errhp, OCI_ERROR, "Can't match some parameters to LOB fields in the table, check type and name"); } sv_catpv(sql_select, " from "); sv_catpv(sql_select, tablename); sv_catpv(sql_select, " where rowid = :rid for update"); /* get row with lock */ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " lob refetch sql: %s\n", SvPVX(sql_select)); lr->stmthp = NULL; lr->bindhp = NULL; lr->rowid = NULL; lr->parmdp_tmp = NULL; lr->parmdp_lob = NULL; OCIHandleAlloc_ok(imp_sth, imp_sth->envhp, &lr->stmthp, OCI_HTYPE_STMT, status); OCIStmtPrepare_log_stat(imp_sth, lr->stmthp, errhp, (text*)SvPVX(sql_select), SvCUR(sql_select), OCI_NTV_SYNTAX, OCI_DEFAULT, status); if (status != OCI_SUCCESS) { OCIHandleFree(lr->stmthp, OCI_HTYPE_STMT); Safefree(lr); return oci_error(sth, errhp, status, "OCIStmtPrepare/LOB refetch"); } /* bind the rowid input */ OCIDescriptorAlloc_ok(imp_sth, imp_sth->envhp, &lr->rowid, OCI_DTYPE_ROWID); OCIBindByName_log_stat(imp_sth, lr->stmthp, &lr->bindhp, errhp, (text*)":rid", 4, &lr->rowid, sizeof(OCIRowid*), SQLT_RDD, 0,0,0,0,0, OCI_DEFAULT, status); if (status != OCI_SUCCESS) { OCIDescriptorFree_log(imp_sth, lr->rowid, OCI_DTYPE_ROWID); OCIHandleFree(lr->stmthp, OCI_HTYPE_STMT); Safefree(lr); return oci_error(sth, errhp, status, "OCIBindByPos/LOB refetch"); } /* define the output fields */ for(i=0; i < lr->num_fields; ++i) { OCIDefine *defnp = NULL; imp_fbh_t *fbh = &lr->fbh_ary[i]; phs_t *phs; SV **phs_svp = hv_fetch(imp_sth->all_params_hv, fbh->name,strlen(fbh->name), 0); if (!phs_svp) croak("panic: LOB refetch for '%s' param (%ld) - name not found",fbh->name,(unsigned long)i+1); phs = (phs_t*)(void*)SvPVX(*phs_svp); fbh->special = phs; if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " lob refetch %d for '%s' param: ftype %d setup\n", (int)i+1,fbh->name, fbh->dbtype); fbh->fb_ary = fb_ary_alloc(fbh->disize, 1); OCIDefineByPos_log_stat(imp_sth, lr->stmthp, &defnp, errhp, (ub4)i+1, &fbh->desc_h, -1, (ub2)fbh->ftype, fbh->fb_ary->aindp, 0, fbh->fb_ary->arcode, OCI_DEFAULT, status); if (status != OCI_SUCCESS) { OCIDescriptorFree_log(imp_sth, lr->rowid, OCI_DTYPE_ROWID); OCIHandleFree(lr->stmthp, OCI_HTYPE_STMT); Safefree(lr); fb_ary_free(fbh->fb_ary); fbh->fb_ary = NULL; return oci_error(sth, errhp, status, "OCIDefineByPos/LOB refetch"); } } OCIHandleFree_log_stat(imp_sth, imp_sth->dschp, OCI_HTYPE_DESCRIBE, status); imp_sth->lob_refetch = lr; /* structure copy */ return 1; } int post_execute_lobs(SV *sth, imp_sth_t *imp_sth, ub4 row_count) /* XXX leaks handles on error */ { /* To insert a new LOB transparently (without using 'INSERT . RETURNING .') */ /* we have to insert an empty LobLocator and then fetch it back from the */ /* server before we can call OCILobWrite on it! This function handles that. */ dTHX; sword status; int i; OCIError *errhp = imp_sth->errhp; lob_refetch_t *lr; D_imp_dbh_from_sth; SV *dbh = (SV*)DBIc_MY_H(imp_dbh); if (!imp_sth->auto_lob) return 1; /* application doesn't want magical lob handling */ if (imp_sth->stmt_type == OCI_STMT_BEGIN || imp_sth->stmt_type == OCI_STMT_DECLARE){ /* PL/SQL is handled by lob_phs_ora_free_templobpost_execute */ if (imp_sth->has_lobs) { /*get rid of OCILob Temporary used in non inout bind*/ SV *phs_svp; I32 i; char *p; hv_iterinit(imp_sth->all_params_hv); while( (phs_svp = hv_iternextsv(imp_sth->all_params_hv, &p, &i)) != NULL ) { phs_t *phs = (phs_t*)(void*)SvPVX(phs_svp); if (phs->desc_h && !phs->is_inout){ OCILobFreeTemporary_log_stat(imp_sth, imp_sth->svchp, imp_sth->errhp, phs->desc_h, status); /* boolean lobEmpty=1;*/ /* OCIAttrSet_log_stat(phs->desc_h, phs->desc_t,&lobEmpty, 0, OCI_ATTR_LOBEMPTY, imp_sth->errhp, status);*/ /* OCIHandleFree_log_stat(phs->desc_h, phs->desc_t, status);*/ } /*this seem to cause an error later on so I just got rid of it for Now does */ /* not seem to kill anything */ } } return 1; } if (row_count == 0) return 1; /* nothing to do */ if (row_count > 1) return oci_error(sth, errhp, OCI_ERROR, "LOB refetch attempted for multiple rows"); if (!imp_sth->lob_refetch) { if (!init_lob_refetch(sth, imp_sth)) return 0; /* init_lob_refetch already called oci_error */ } lr = imp_sth->lob_refetch; OCIAttrGet_stmhp_stat(imp_sth, lr->rowid, 0, OCI_ATTR_ROWID,status); if (status != OCI_SUCCESS) return oci_error(sth, errhp, status, "OCIAttrGet OCI_ATTR_ROWID /LOB refetch"); OCIStmtExecute_log_stat(imp_sth, imp_sth->svchp, lr->stmthp, errhp,1, 0, NULL, NULL, OCI_DEFAULT, status); /* execute and fetch */ if (status != OCI_SUCCESS) return oci_error(sth, errhp, status, ora_sql_error(imp_sth,"OCIStmtExecute/LOB refetch")); for(i=0; i < lr->num_fields; ++i) { imp_fbh_t *fbh = &lr->fbh_ary[i]; int rc = fbh->fb_ary->arcode[0]; phs_t *phs = (phs_t*)fbh->special; ub4 amtp; (void)SvUPGRADE(phs->sv, SVt_PV); amtp = SvCUR(phs->sv); /* XXX UTF8? */ if (rc == 1405) { /* NULL - return undef */ sv_set_undef(phs->sv); status = OCI_SUCCESS; } else if (amtp > 0) { /* since amtp==0 & OCI_ONE_PIECE fail (OCI 8.0.4) */ if( ! fbh->csid ) { ub1 csform = SQLCS_IMPLICIT; ub2 csid = 0; OCILobCharSetForm_log_stat(imp_sth, imp_sth->envhp, errhp, (OCILobLocator*)fbh->desc_h, &csform, status ); if (status != OCI_SUCCESS) return oci_error(sth, errhp, status, "OCILobCharSetForm"); #ifdef OCI_ATTR_CHARSET_ID /* Effectively only used so AL32UTF8 works properly */ OCILobCharSetId_log_stat(imp_sth, imp_sth->envhp, errhp, (OCILobLocator*)fbh->desc_h, &csid, status ); if (status != OCI_SUCCESS) return oci_error(sth, errhp, status, "OCILobCharSetId"); #endif /* OCI_ATTR_CHARSET_ID */ /* if data is utf8 but charset isn't then switch to utf8 csid */ csid = (SvUTF8(phs->sv) && !CS_IS_UTF8(csid)) ? utf8_csid : CSFORM_IMPLIED_CSID(csform); fbh->csid = csid; fbh->csform = csform; } if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " calling OCILobWrite fbh->csid=%d fbh->csform=%d amtp=%d\n", fbh->csid, fbh->csform, amtp ); OCILobWrite_log_stat(imp_sth, imp_sth->svchp, errhp, (OCILobLocator*)fbh->desc_h, &amtp, 1, SvPVX(phs->sv), amtp, OCI_ONE_PIECE, 0,0, fbh->csid ,fbh->csform, status); if (status != OCI_SUCCESS) { return oci_error(sth, errhp, status, "OCILobWrite in post_execute_lobs"); } } else { /* amtp==0 so truncate LOB to zero length */ OCILobTrim_log_stat(imp_sth, imp_sth->svchp, errhp, (OCILobLocator*)fbh->desc_h, 0, status); if (status != OCI_SUCCESS) { return oci_error(sth, errhp, status, "OCILobTrim in post_execute_lobs"); } } if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " lob refetch %d for '%s' param: ftype %d, len %ld: %s %s\n", i+1,fbh->name, fbh->dbtype, ul_t(amtp), (rc==1405 ? "NULL" : (amtp > 0) ? "LobWrite" : "LobTrim"), oci_status_name(status)); if (status != OCI_SUCCESS) { return oci_error(sth, errhp, status, "OCILobTrim/OCILobWrite/LOB refetch"); } } if (DBIc_has(imp_dbh,DBIcf_AutoCommit)) dbd_db_commit(dbh, imp_dbh); return 1; } void ora_free_lob_refetch(SV *sth, imp_sth_t *imp_sth) { dTHX; lob_refetch_t *lr = imp_sth->lob_refetch; int i; sword status; if (lr->rowid) OCIDescriptorFree_log(imp_sth, lr->rowid, OCI_DTYPE_ROWID); OCIHandleFree_log_stat(imp_sth, lr->stmthp, OCI_HTYPE_STMT, status); if (status != OCI_SUCCESS) oci_error(sth, imp_sth->errhp, status, "ora_free_lob_refetch/OCIHandleFree"); for(i=0; i < lr->num_fields; ++i) { imp_fbh_t *fbh = &lr->fbh_ary[i]; ora_free_fbh_contents(sth, fbh); } sv_free(lr->fbh_ary_sv); Safefree(imp_sth->lob_refetch); imp_sth->lob_refetch = NULL; } ub4 ora_db_version(SV *dbh, imp_dbh_t *imp_dbh) { dTHX; sword status; text buf[2]; ub4 vernum; if( imp_dbh->server_version > 0 ) { return imp_dbh->server_version; } /* XXX should possibly create new session before ending the old so */ /* that if the new one can't be created, the old will still work. */ OCIServerRelease_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, buf, 2,OCI_HTYPE_SVCCTX, &vernum , status); if (status != OCI_SUCCESS) { oci_error(dbh, imp_dbh->errhp, status, "OCISessionServerRelease"); return 0; } imp_dbh->server_version = vernum; return vernum; } DBD-Oracle-1.74/META.yml0000644000175000017500000000361412326332111014026 0ustar yanickyanick--- abstract: 'Oracle database driver for the DBI module' author: - 'Tim Bunce ' - 'John Scoles ' - 'Yanick Champoux ' - 'Martin J. Evans ' build_requires: B: '0' Carp: '0' Data::Dumper: '0' Devel::Peek: '0' Encode: '0' Math::BigInt: '0' Test::More: '0.88' Thread::Semaphore: '0' lib: '0' utf8: '0' vars: '0' configure_requires: DBI: '1.51' ExtUtils::MakeMaker: '6.30' dynamic_config: 0 generated_by: 'Dist::Zilla version 5.014, CPAN::Meta::Converter version 2.140640' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: DBD-Oracle provides: DBD::Oracle: file: lib/DBD/Oracle.pm version: '1.74' DBD::Oracle::GetInfo: file: lib/DBD/Oracle/GetInfo.pm version: '1.74' DBD::Oracle::Object: file: lib/DBD/Oracle/Object.pm version: '1.74' requires: DBI: '0' DynaLoader: '0' Exporter: '0' perl: '5.006' strict: '0' warnings: '0' resources: bugtracker: https://github.com/pythian/DBD-Oracle/issues homepage: http://search.cpan.org/dist/DBD-Oracle/ repository: https://github.com/pythian/DBD-Oracle.git version: '1.74' x_authority: cpan:PYTHIAN x_contributors: - 'David E. Wheeler ' - 'David Perry ' - 'David Steinbrunner ' - 'Gwen Shapira ' - 'Joe Crotty ' - 'Michael Portnoy ' - 'StephenCIQG ' - 'cjardine ' - 'gregor herrmann ' - 'jurl ' - 'lbaxter ' - 'robert ' x_help_wanted: - developer - documenter - tester DBD-Oracle-1.74/Oracle.h0000644000175000017500000001053112326332111014127 0ustar yanickyanick/* Copyright (c) 1994-2006 Tim Bunce See the COPYRIGHT section in the Oracle.pm file for terms. */ /* ====== Include Oracle Header Files ====== */ #ifndef CAN_PROTOTYPE #define signed /* Oracle headers use signed */ #endif /* The following define avoids a problem with Oracle >=7.3 where * ociapr.h has the line: * sword obindps(struct cda_def *cursor, ub1 opcode, text *sqlvar, ... * In some compilers that clashes with perls 'opcode' enum definition. */ #define opcode opcode_redefined /* Hack to fix broken Oracle oratypes.h on OSF Alpha. Sigh. */ #if defined(__osf__) && defined(__alpha) #ifndef A_OSF #define A_OSF #endif #endif /* egcs-1.1.2 does not have _int64 */ #if defined(__MINGW32__) || defined(__CYGWIN32__) #define _int64 long long #endif /* ori.h uses 'dirty' as an arg name in prototypes so we use this */ /* hack to prevent ori.h being read (since we don't need it) */ /*#define ORI_ORACLE*/ #include #include #include #include #include /* ------ end of Oracle include files ------ */ #define NEED_DBIXS_VERSION 93 #define PERL_NO_GET_CONTEXT /*for Threaded Perl */ #include /* installed by the DBI module */ #include "dbdimp.h" #include "dbivport.h" #include /* installed by the DBI module */ /* These prototypes are for dbdimp.c funcs used in the XS file */ /* These names are #defined to driver specific names in dbdimp.h */ void dbd_init _((dbistate_t *dbistate)); void dbd_init_oci_drh _((imp_drh_t * imp_drh)); int dbd_db_login _((SV *dbh, imp_dbh_t *imp_dbh, char *dbname, char *user, char *pwd)); int dbd_db_do _((SV *sv, char *statement)); int dbd_db_commit _((SV *dbh, imp_dbh_t *imp_dbh)); int dbd_db_rollback _((SV *dbh, imp_dbh_t *imp_dbh)); int dbd_st_bind_col(SV *sth, imp_sth_t *imp_sth, SV *col, SV *ref, IV type, SV *attribs); int dbd_db_disconnect _((SV *dbh, imp_dbh_t *imp_dbh)); void dbd_db_destroy _((SV *dbh, imp_dbh_t *imp_dbh)); int dbd_db_STORE_attrib _((SV *dbh, imp_dbh_t *imp_dbh, SV *keysv, SV *valuesv)); SV *dbd_db_FETCH_attrib _((SV *dbh, imp_dbh_t *imp_dbh, SV *keysv)); int dbd_st_prepare _((SV *sth, imp_sth_t *imp_sth, char *statement, SV *attribs)); int dbd_st_rows _((SV *sth, imp_sth_t *imp_sth)); int dbd_st_execute _((SV *sth, imp_sth_t *imp_sth)); int dbd_st_cancel _((SV *sth, imp_sth_t *imp_sth)); AV *dbd_st_fetch _((SV *sth, imp_sth_t *imp_sth)); int dbd_st_finish _((SV *sth, imp_sth_t *imp_sth)); void dbd_st_destroy _((SV *sth, imp_sth_t *imp_sth)); int dbd_st_blob_read _((SV *sth, imp_sth_t *imp_sth, int field, long offset, long len, SV *destrv, long destoffset)); int dbd_st_STORE_attrib _((SV *sth, imp_sth_t *imp_sth, SV *keysv, SV *valuesv)); SV *dbd_st_FETCH_attrib _((SV *sth, imp_sth_t *imp_sth, SV *keysv)); int dbd_bind_ph _((SV *sth, imp_sth_t *imp_sth, SV *param, SV *value, IV sql_type, SV *attribs, int is_inout, IV maxlen)); int dbd_db_login6 _((SV *dbh, imp_dbh_t *imp_dbh, char *dbname, char *user, char *pwd, SV *attr)); int dbd_describe _((SV *sth, imp_sth_t *imp_sth)); ub4 ora_blob_read_piece _((SV *sth, imp_sth_t *imp_sth, imp_fbh_t *fbh, SV *dest_sv, long offset, UV len, long destoffset)); ub4 ora_blob_read_mb_piece _((SV *sth, imp_sth_t *imp_sth, imp_fbh_t *fbh, SV *dest_sv, long offset, ub4 len, long destoffset)); /* Oracle types */ #define ORA_VARCHAR2 1 #define ORA_STRING 5 #define ORA_NUMBER 2 #define ORA_LONG 8 #define ORA_ROWID 11 #define ORA_DATE 12 #define ORA_RAW 23 #define ORA_LONGRAW 24 #define ORA_CHAR 96 #define ORA_CHARZ 97 #define ORA_MLSLABEL 105 #define ORA_CLOB 112 #define ORA_BLOB 113 #define ORA_BFILE 114 #define ORA_RSET 116 #define ORA_VARCHAR2_TABLE 201 #define ORA_NUMBER_TABLE 202 #define ORA_XMLTYPE 108 /* other Oracle not in noraml API defines most of these are largly undocumented XML functions that are in the API but not defined not noramlly found in the defines the prototypes of OCI functions in most clients Normally can be found in ociap.h (Oracle Call Interface - Ansi Prototypes ) and ocikp.h (functions in K&R style) They will be added when needed */ sword OCIXMLTypeCreateFromSrc( OCISvcCtx *svchp, OCIError *errhp, OCIDuration dur, ub1 src_type, dvoid *src_ptr, sb4 ind, OCIXMLType **retInstance ); /* end of Oracle.h */ DBD-Oracle-1.74/dbivport.h0000644000175000017500000000374012326332111014557 0ustar yanickyanick/* dbivport.h Provides macros that enable greater portability between DBI versions. This file should be *copied* and included in driver distributions and #included into the source, after #include DBIXS.h New driver releases should include an updated copy of dbivport.h from the most recent DBI release. */ #ifndef DBI_VPORT_H #define DBI_VPORT_H #ifndef DBIh_SET_ERR_CHAR /* Emulate DBIh_SET_ERR_CHAR Only uses the err_i, errstr and state parameters. */ #define DBIh_SET_ERR_CHAR(h, imp_xxh, err_c, err_i, errstr, state, method) \ sv_setiv(DBIc_ERR(imp_xxh), err_i); \ (state) ? (void)sv_setpv(DBIc_STATE(imp_xxh), state) : (void)SvOK_off(DBIc_STATE(imp_xxh)); \ sv_setpv(DBIc_ERRSTR(imp_xxh), errstr) #endif #ifndef DBIcf_Executed #define DBIcf_Executed 0x080000 #endif #ifndef DBIc_TRACE_LEVEL_MASK #define DBIc_TRACE_LEVEL_MASK 0x0000000F #define DBIc_TRACE_FLAGS_MASK 0xFFFFFF00 #define DBIc_TRACE_SETTINGS(imp) (DBIc_DBISTATE(imp)->debug) #define DBIc_TRACE_LEVEL(imp) (DBIc_TRACE_SETTINGS(imp) & DBIc_TRACE_LEVEL_MASK) #define DBIc_TRACE_FLAGS(imp) (DBIc_TRACE_SETTINGS(imp) & DBIc_TRACE_FLAGS_MASK) /* DBIc_TRACE_MATCHES - true if s1 'matches' s2 (c.f. trace_msg()) DBIc_TRACE_MATCHES(foo, DBIc_TRACE_SETTINGS(imp)) */ #define DBIc_TRACE_MATCHES(s1, s2) \ ( ((s1 & DBIc_TRACE_LEVEL_MASK) >= (s2 & DBIc_TRACE_LEVEL_MASK)) \ || ((s1 & DBIc_TRACE_FLAGS_MASK) & (s2 & DBIc_TRACE_FLAGS_MASK)) ) /* DBIc_TRACE - true if flags match & DBI level>=flaglevel, or if DBI level>level DBIc_TRACE(imp, 0, 0, 4) = if level >= 4 DBIc_TRACE(imp, DBDtf_FOO, 2, 4) = if tracing DBDtf_FOO & level>=2 or level>=4 DBIc_TRACE(imp, DBDtf_FOO, 2, 0) = as above but never trace just due to level */ #define DBIc_TRACE(imp, flags, flaglevel, level) \ ( (flags && (DBIc_TRACE_FLAGS(imp) & flags) && (DBIc_TRACE_LEVEL(imp) >= flaglevel)) \ || (level && DBIc_TRACE_LEVEL(imp) >= level) ) #endif #endif /* !DBI_VPORT_H */ DBD-Oracle-1.74/typemap0000644000175000017500000000006712326332111014156 0ustar yanickyanickOCILobLocator * T_PTROBJ OCIXMLType * T_PTROBJDBD-Oracle-1.74/t/0000775000175000017500000000000012326332111013016 5ustar yanickyanickDBD-Oracle-1.74/t/23wide_db_al32utf8.t0000644000175000017500000000253512326332111016400 0ustar yanickyanick#!perl -w #written by Lincoln A Baxter (lab@lincolnbaxter.com) use strict; #use warnings; use Test::More; use DBI qw(:sql_types); use DBD::Oracle qw( :ora_types ORA_OCI SQLCS_NCHAR ); unshift @INC ,'t'; require 'nchar_test_lib.pl'; my $dbh; $| = 1; SKIP: { plan skip_all => "Unable to run unicode test, perl version is less than 5.6" unless ( $] >= 5.006 ); plan skip_all => "Oracle charset tests unreliable for Oracle 8 client" if ORA_OCI() < 9.0 and !$ENV{DBD_ALL_TESTS}; set_nls_lang_charset( (ORA_OCI >= 9.2) ? 'AL32UTF8' : 'UTF8', 1 ); $dbh = db_handle(); plan skip_all => "Unable to connect to Oracle" if not $dbh; plan skip_all => "Database character set is not Unicode" if not db_ochar_is_utf($dbh) ; # testing utf8 with char columns (wide mode database) my $tdata = test_data( 'wide_char' ); my $testcount = 0 #create table + insert_test_count( $tdata ) + select_test_count( $tdata ) * 1; ; plan tests => $testcount; show_test_data( $tdata ,0 ); drop_table($dbh); create_table( $dbh, $tdata ); insert_rows( $dbh, $tdata ,SQLCS_NCHAR); dump_table( $dbh ,'ch' ,'descr' ); select_rows( $dbh, $tdata ); } END { eval { local $dbh->{PrintError} = 0; drop_table($dbh) if $dbh and not $ENV{'DBD_SKIP_TABLE_DROP'}; }; } DBD-Oracle-1.74/t/00versions.t0000644000175000017500000000202412326332111015207 0ustar yanickyanick# reports on all interesting versions use strict; use warnings; use lib 't'; use Test::More tests => 2; use DBD::Oracle qw/ ORA_OCI /; require 'nchar_test_lib.pl'; my $oci_version = ORA_OCI(); diag "OCI client library version: ", $oci_version; ok $oci_version; SKIP: { my $dsn = oracle_test_dsn(); my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; my $dbh = DBI->connect($dsn, $dbuser, '',{ PrintError => 0, }) or note <<'END_NOTE' or skip q{can't connect to database} => 1; Can't connect to an Oracle instance. Without a database connection, most of DBD::Oracle's test suite will be skipped. To let the tests use a database, set up the environment variables ORACLE_USERID and ORACLE_DSN. E.g.: $ export ORACLE_USERID='scott/tiger' $ export ORACLE_DSN='dbi:Oracle:testdb' END_NOTE my $sth = $dbh->prepare( q{select * from v$version where banner like 'Oracle%'} ); $sth->execute; my $version = join ' ', $sth->fetchrow; diag 'database version: ', $version; ok $version; } DBD-Oracle-1.74/t/22nchar_al32utf8.t0000644000175000017500000000256112326332111016074 0ustar yanickyanick#!perl -w #written by Lincoln A Baxter (lab@lincolnbaxter.com) use strict; #use warnings; use Test::More; use DBI qw(:sql_types); use DBD::Oracle qw( :ora_types ORA_OCI SQLCS_NCHAR ); unshift @INC ,'t'; require 'nchar_test_lib.pl'; my $dbh; $| = 1; SKIP: { plan skip_all => "Unable to run unicode test, perl version is less than 5.6" unless ( $] >= 5.006 ); plan skip_all => "Oracle charset tests unreliable for Oracle 8 client" if ORA_OCI() < 9.0 and !$ENV{DBD_ALL_TESTS}; set_nls_nchar( (ORA_OCI >= 9.2) ? 'AL32UTF8' : 'UTF8', 1 ); $dbh = db_handle(); plan skip_all => "Unable to connect to Oracle" if not $dbh; plan skip_all => "Database NCHAR character set is not Unicode" if not db_nchar_is_utf($dbh) ; print "testing utf8 with nchar columns\n" ; show_db_charsets( $dbh ); my $tdata = test_data( 'wide_nchar' ); my $testcount = 0 #create table + insert_test_count( $tdata ) + select_test_count( $tdata ) * 1; ; plan tests => $testcount; show_test_data( $tdata ,0 ); drop_table($dbh); create_table( $dbh, $tdata ); insert_rows( $dbh, $tdata ,SQLCS_NCHAR); dump_table( $dbh ,'nch' ,'descr' ); select_rows( $dbh, $tdata ); } END { eval { local $dbh->{PrintError} = 0; drop_table($dbh) if $dbh and not $ENV{'DBD_SKIP_TABLE_DROP'}; }; } DBD-Oracle-1.74/t/31lob.t0000644000175000017500000001540212326332111014123 0ustar yanickyanick#!/usr/bin/perl use strict; use Test::More; use DBD::Oracle qw(:ora_types ORA_OCI ); use DBI; unshift @INC ,'t'; require 'nchar_test_lib.pl'; my $dsn = oracle_test_dsn(); my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; my $dbh = DBI->connect($dsn, $dbuser, '',{ PrintError => 0, }); plan $dbh ? ( tests => 12 ) : ( skip_all => "Unable to connect to Oracle" ); my $table = table(); drop_table($dbh); $dbh->do( <<"END_SQL" ); CREATE TABLE $table ( id INTEGER NOT NULL, data BLOB ) END_SQL my ($stmt, $sth, $id, $loc); ## test with insert empty blob and select locator. $stmt = "INSERT INTO $table (id,data) VALUES (1, EMPTY_BLOB())"; $dbh->do($stmt); $stmt = "SELECT data FROM $table WHERE id = ?"; $sth = $dbh->prepare($stmt, {ora_auto_lob => 0}); $id = 1; $sth->bind_param(1, $id); $sth->execute; ($loc) = $sth->fetchrow; is (ref $loc, "OCILobLocatorPtr", "returned valid locator"); ## test inserting a large value $stmt = "INSERT INTO $table (id,data) VALUES (666, ?)"; $sth = $dbh->prepare($stmt); my $content = join(q{}, map { chr } ( 32 .. 64 )) x 16384; $sth->bind_param(1, $content, { ora_type => ORA_BLOB, ora_field => 'data' }); eval { $sth->execute($content) }; is $@, '', 'inserted into BLOB successfully'; { local $dbh->{LongReadLen} = 1_000_000; my ($fetched) = $dbh->selectrow_array("select data from $table where id = 666"); is $fetched, $content, 'got back what we put in'; } ## test with insert empty blob returning blob to a var. ($id, $loc) = (2, undef); $stmt = "INSERT INTO $table (id,data) VALUES (?, EMPTY_BLOB()) RETURNING data INTO ?"; $sth = $dbh->prepare($stmt, {ora_auto_lob => 0}); $sth->bind_param(1, $id); $sth->bind_param_inout(2, \$loc, 0, {ora_type => ORA_BLOB}); $sth->execute; is (ref $loc, "OCILobLocatorPtr", "returned valid locator"); sub temp_lob_count { my $dbh = shift; return $dbh->selectrow_array(<<'END_SQL'); SELECT cache_lobs + nocache_lobs AS temp_lob_count FROM v$temporary_lobs templob, v$session sess WHERE sess.sid = templob.sid AND sess.audsid = userenv('sessionid') END_SQL } sub have_v_session { $dbh->do('select * from v$session where 0=1'); return defined($dbh->err) ? $dbh->err != 942 : 1; } ## test writing / reading large data { # LOB locators cannot span transactions - turn off AutoCommit local $dbh->{AutoCommit} = 0; my ( $large_value, $len ); # get a new locator $stmt = "INSERT INTO $table (id,data) VALUES (3, EMPTY_BLOB())"; $dbh->do($stmt); $stmt = "SELECT data FROM $table WHERE id = ?"; $sth = $dbh->prepare( $stmt, { ora_auto_lob => 0 } ); $id = 3; $sth->bind_param( 1, $id ); $sth->execute; ($loc) = $sth->fetchrow; is( ref $loc, "OCILobLocatorPtr", "returned valid locator" ); is( $dbh->ora_lob_is_init($loc), 1, "returned initialized locator" ); # write string > 32k $large_value = 'ABCD' x 10_000; $dbh->ora_lob_write( $loc, 1, $large_value ); eval { $len = $dbh->ora_lob_length($loc); }; if ($@) { note ("It appears your Oracle or Oracle client has problems with ora_lob_length(lob_locator). We have seen this before - see RT 69350. The test is not going to fail because of this because we have seen it before but if you are using lob locators you might want to consider upgrading your Oracle client to 11.2 where we know this test works"); done_testing(); } else { is( $len, length($large_value), "returned length" ); } is( $dbh->ora_lob_read( $loc, 1, length($large_value) ), $large_value, "returned written value" ); ## PL/SQL TESTS SKIP: { ## test calling PL/SQL with LOB placeholder my $plsql_testcount = 4; my $sth = $dbh->prepare( 'BEGIN ? := DBMS_LOB.GETLENGTH( ? ); END;', { ora_auto_lob => 0 } ); $sth->bind_param_inout( 1, \$len, 16 ); $sth->bind_param( 2, $loc, { ora_type => ORA_BLOB } ); $sth->execute; # ORA-00600: internal error code # ORA-00900: invalid SQL statement # ORA-06550: PLS-00201: identifier 'DBMS_LOB.GETLENGTH' must be declared # ORA-06553: PLS-00213: package STANDARD not accessible if ( $dbh->err && grep { $dbh->err == $_ } ( 600, 900, 6550, 6553 ) ) { skip "Your Oracle server doesn't support PL/SQL", $plsql_testcount if $dbh->err == 900; skip "Your Oracle PL/SQL package DBMS_LOB is not properly installed", $plsql_testcount if $dbh->err == 6550; skip "Your Oracle PL/SQL is not properly installed", $plsql_testcount if $dbh->err == 6553 || $dbh->err == 600; } TODO: { local $TODO = "problem reported w/ lobs and Oracle 11.2.*, see RT#69350" if ORA_OCI() =~ /^11\.2\./; is( $len, length($large_value), "returned length via PL/SQL" ); } $dbh->{LongReadLen} = length($large_value) * 2; my $out; my $inout = lc $large_value; eval { $sth = $dbh->prepare( <<'END_SQL', { ora_auto_lob => 1 } ); DECLARE -- testing IN, OUT, and IN OUT: -- p_out will be set to LOWER(p_in) -- p_inout will be set to p_inout || p_in PROCEDURE lower_lob(p_in BLOB, p_out OUT BLOB, p_inout IN OUT BLOB) IS pos INT; buffer RAW(1024); BEGIN DBMS_LOB.CREATETEMPORARY(p_out, TRUE); pos := 1; WHILE pos <= DBMS_LOB.GETLENGTH(p_in) LOOP buffer := DBMS_LOB.SUBSTR(p_in, 1024, pos); DBMS_LOB.WRITEAPPEND(p_out, UTL_RAW.LENGTH(buffer), UTL_RAW.CAST_TO_RAW(LOWER(UTL_RAW.CAST_TO_VARCHAR2(buffer)))); DBMS_LOB.WRITEAPPEND(p_inout, UTL_RAW.LENGTH(buffer), buffer); pos := pos + 1024; END LOOP; END; BEGIN lower_lob(:in, :out, :inout); END; END_SQL $sth->bind_param( ':in', $large_value, { ora_type => ORA_BLOB }); $sth->bind_param_inout( ':out', \$out, 100, { ora_type => ORA_BLOB } ); $sth->bind_param_inout( ':inout', \$inout, 100, { ora_type => ORA_BLOB } ); $sth->execute; }; local $TODO = "problem reported w/ lobs and Oracle 11.2.*, see RT#69350" if ORA_OCI() =~ /^11\.2\./; skip "Your Oracle PL/SQL installation does not implement temporary LOBS", 3 if $dbh->err && $dbh->err == 6550; is($out, lc($large_value), "returned LOB as string"); is($inout, lc($large_value).$large_value, "returned IN/OUT LOB as string"); undef $sth; # lobs are freed with statement handle skip q{can't check num of temp lobs, no access to v$session}, 1, unless have_v_session(); is(temp_lob_count($dbh), 0, "no temp lobs left"); } } $dbh->do("DROP TABLE $table"); $dbh->disconnect; 1; DBD-Oracle-1.74/t/lib/0000775000175000017500000000000012326332111013564 5ustar yanickyanickDBD-Oracle-1.74/t/lib/ExecuteArray.pm0000644000175000017500000004344012326332111016526 0ustar yanickyanick# $Id$ # Author: Martin J. Evans # This should be an exact copy of the same file in DBD::ODBC # If you change this file please let me know. package ExecuteArray; use Test::More; use Data::Dumper; use DBI; our $VERSION = '0.01'; my $table = 'PERL_DBD_execute_array'; my $table2 = 'PERL_DBD_execute_array2'; my @p1 = (1,2,3,4,5); my @p2 = qw(one two three four five); my $fetch_row = 0; my @captured_error; # values captured in error handler sub error_handler { @captured_error = @_; note("***** error handler called *****"); 0; # pass errors on } sub new { my ($class, $dbh, $dbi_version) = @_; my $self = {}; $dbh = setup($dbh, $dbi_version); $self->{_dbh} = $dbh; # find out how the driver supports row counts and parameter status $self->{_param_array_row_counts} = $dbh->get_info(153); # a return of 1 is SQL_PARC_BATCH which means: # Individual row counts are available for each set of parameters. This is # conceptually equivalent to the driver generating a batch of SQL # statements, one for each parameter set in the array. Extended error # information can be retrieved by using the SQL_PARAM_STATUS_PTR # descriptor field. # a return of 2 is SQL_PARC_NO_BATCH which means: # There is only one row count available, which is the cumulative row # count resulting from the execution of the statement for the entire # array of parameters. This is conceptually equivalent to treating # the statement together with the complete parameter array as one # atomic unit. Errors are handled the same as if one statement # were executed. return bless ($self, $class); } sub dbh { my $self = shift; return $self->{_dbh}; } sub setup { my ($dbh, $dbi_version) = @_; $dbh = enable_mars($dbh, $native); $dbh->{HandleError} = \&error_handler; if ($dbi_version) { $dbh->{odbc_disable_array_operations} = 1; } #$dbh->{ora_verbose} = 5; $dbh->{RaiseError} = 1; $dbh->{PrintError} = 0; $dbh->{ChopBlanks} = 1; $dbh->{AutoCommit} = 1; return $dbh; } sub create_table { my ($self, $dbh) = @_; eval { $dbh->do(qq/create table $table (a integer not null primary key, b char(20))/); }; if ($@) { diag("Failed to create test table $table - $@"); return 0; } eval { $dbh->do(qq/create table $table2 (a integer not null primary key, b char(20))/); }; if ($@) { diag("Failed to create test table $table2 - $@"); return 0; } my $sth = $dbh->prepare(qq/insert into $table2 values(?,?)/); for (my $row = 0; $row < @p1; $row++) { $sth->execute($p1[$row], $p2[$row]); } 1; } sub drop_table { my ($self, $dbh) = @_; eval { local $dbh->{PrintError} = 0; local $dbh->{PrintWarn} = 0; $dbh->do(qq/drop table $table/); $dbh->do(qq/drop table $table2/); }; note("Table dropped"); } # clear the named table of rows sub clear_table { $_[0]->do(qq/delete from $_[1]/); } # check $table contains the data in $c1, $c2 which are arrayrefs of values sub check_data { my ($dbh, $c1, $c2) = @_; my $data = $dbh->selectall_arrayref(qq/select * from $table order by a/); my $row = 0; foreach (@$data) { is($_->[0], $c1->[$row], "row $row p1 data"); is($_->[1], $c2->[$row], "row $row p2 data"); $row++; } } sub check_tuple_status { my ($self, $tsts, $expected) = @_; note(Data::Dumper->Dump([$tsts], [qw(ArrayTupleStatus)])); BAIL_OUT('expected data must be specified') if (!$expected || (ref($expected) ne 'ARRAY')); is(ref($tsts), 'ARRAY', 'tuple status is an array') or return; if (!is(scalar(@$tsts), scalar(@$expected), 'status arrays same size')) { diag(Dumper($tsts)); diag(Dumper($expected)); return; } my $row = 0; foreach my $s (@$expected) { if (ref($s)) { unless ($self->{_param_array_row_counts} == 2) { is(ref($tsts->[$row]), 'ARRAY', 'array in array tuple status'); is(scalar(@{$tsts->[$row]}), 3, '3 elements in array tuple status error'); } } else { if ($tsts->[$row] == -1) { pass("row $row tuple status unknown"); } else { is($tsts->[$row], $s, "row $row tuple status"); } } $row++; } return; } # insert might return 'mas' which means the caller said the test # required Multiple Active Statements and the driver appeared to not # support MAS. # # ref is a hash ref: # error (0|1) whether we expect an error # raise (0|1) means set RaiseError to this # commit (0|1) do the inserts in a txn # tuple arrayref of what we expect in the tuple status # e.g., [1,1,1,1,[]] # where the empty [] signifies we expect an error for this row # where 1 signifies we the expect row count for this row # affected - the total number of rows affected for insert/update # sub insert { my ($self, $dbh, $sth, $ref) = @_; die "need hashref arg" if (!$ref || (ref($ref) ne 'HASH')); note("insert " . join(", ", map {"$_ = ". DBI::neat($ref->{$_})} keys %$ref )); # DBD::Oracle supports MAS don't compensate for it not if ($ref->{requires_mas} && $dbh->{Driver}->{Name} eq 'Oracle') { delete $ref->{requires_mas}; } @captured_error = (); if ($ref->{raise}) { $sth->{RaiseError} = 1; } else { $sth->{RaiseError} = 0; } my (@tuple_status, $sts, $total_affected); my $tuple_status_arg = {}; $tuple_status_arg->{ArrayTupleStatus} = \@tuple_status unless $ref->{notuplestatus}; $sts = 999999; # to ensure it is overwritten $total_affected = 999998; if ($ref->{array_context}) { eval { if ($ref->{params}) { ($sts, $total_affected) = $sth->execute_array($tuple_status_arg, @{$ref->{params}}); } elsif ($ref->{fetch}) { ($sts, $total_affected) = $sth->execute_array( {%{$tuple_status_arg}, ArrayTupleFetch => $ref->{fetch}}); } else { ($sts, $total_affected) = $sth->execute_array($tuple_status_arg); } }; } else { eval { if ($ref->{params}) { $sts = $sth->execute_array($tuple_status_arg, @{$ref->{params}}); } else { $sts = $sth->execute_array($tuple_status_arg); } }; } if ($ref->{error} && $ref->{raise}) { ok($@, 'error in execute_array eval'); } else { if ($ref->{requires_mas} && $@) { diag("\nThis test died with $@"); diag("It requires multiple active statement support in the driver and I cannot easily determine if your driver supports MAS. Ignoring the rest of this test."); foreach (@tuple_status) { if (ref($_)) { diag(join(",", @$_)); } } return 'mas'; } ok(!$@, 'no error in execute_array eval') or note($@); } $dbh->commit if $ref->{commit}; if (!$ref->{raise} || ($ref->{error} == 0)) { if (exists($ref->{sts})) { is($sts, $ref->{sts}, "execute_array returned " . DBI::neat($sts) . " rows executed"); } if (exists($ref->{affected}) && $ref->{array_context}) { is($total_affected, $ref->{affected}, "total affected " . DBI::neat($total_affected)) } } if ($ref->{raise}) { if ($ref->{error}) { ok(scalar(@captured_error) > 0, "error captured"); } else { is(scalar(@captured_error), 0, "no error captured"); } } if ($ref->{sts}) { is(scalar(@tuple_status), (($ref->{sts} eq '0E0') ? 0 : $ref->{sts}), "$ref->{sts} rows in tuple_status"); } if ($ref->{tuple} && !exists($ref->{notuplestatus})) { $self->check_tuple_status(\@tuple_status, $ref->{tuple}); } return; } # simple test on ensure execute_array with no errors: # o checks returned status and affected is correct # o checks ArrayTupleStatus is correct # o checks no error is raised # o checks rows are inserted # o run twice with AutoCommit on/off # o checks if less values are specified for one parameter the right number # of rows are still inserted and NULLs are placed in the missing rows # checks binding via bind_param_array and adding params to execute_array # checks binding no parameters at all sub simple { my ($self, $dbh, $ref) = @_; note('simple tests ' . join(", ", map {"$_ = $ref->{$_}"} keys %$ref )); note(" all param arrays the same size"); foreach my $commit (1,0) { note(" Autocommit: $commit"); clear_table($dbh, $table); $dbh->begin_work if !$commit; my $sth = $dbh->prepare(qq/insert into $table values(?,?)/); $sth->bind_param_array(1, \@p1); $sth->bind_param_array(2, \@p2); $self->insert($dbh, $sth, { commit => !$commit, error => 0, sts => 5, affected => 5, tuple => [1, 1, 1, 1, 1], %$ref}); check_data($dbh, \@p1, \@p2); } note " Not all param arrays the same size"; clear_table($dbh, $table); my $sth = $dbh->prepare(qq/insert into $table values(?,?)/); $sth->bind_param_array(1, \@p1); $sth->bind_param_array(2, [qw(one)]); $self->insert($dbh, $sth, {commit => 0, error => 0, raise => 1, sts => 5, affected => 5, tuple => [1, 1, 1, 1, 1], %$ref}); check_data($dbh, \@p1, ['one', undef, undef, undef, undef]); note " Not all param arrays the same size with bind on execute_array"; clear_table($dbh, $table); $sth = $dbh->prepare(qq/insert into $table values(?,?)/); $self->insert($dbh, $sth, {commit => 0, error => 0, raise => 1, sts => 5, affected => 5, tuple => [1, 1, 1, 1, 1], %$ref, params => [\@p1, [qw(one)]]}); check_data($dbh, \@p1, ['one', undef, undef, undef, undef]); note " no parameters"; clear_table($dbh, $table); $sth = $dbh->prepare(qq/insert into $table values(?,?)/); $self->insert($dbh, $sth, {commit => 0, error => 0, raise => 1, sts => '0E0', affected => 0, tuple => [], %$ref, params => [[], []]}); check_data($dbh, \@p1, ['one', undef, undef, undef, undef]); } # error test to ensure correct behavior for execute_array when it errors: # o execute_array of 5 inserts with last one failing # o check it raises an error # o check caught error is passed on from handler for eval # o check returned status and affected rows # o check ArrayTupleStatus # o check valid inserts are inserted # o execute_array of 5 inserts with 2nd last one failing # o check it raises an error # o check caught error is passed on from handler for eval # o check returned status and affected rows # o check ArrayTupleStatus # o check valid inserts are inserted sub error { my ($self, $dbh, $ref) = @_; die "need hashref arg" if (!$ref || (ref($ref) ne 'HASH')); note('error tests ' . join(", ", map {"$_ = $ref->{$_}"} keys %$ref )); { note("Last row in error"); clear_table($dbh, $table); my $sth = $dbh->prepare(qq/insert into $table values(?,?)/); my @pe1 = @p1; $pe1[-1] = 1; $sth->bind_param_array(1, \@pe1); $sth->bind_param_array(2, \@p2); $self->insert($dbh, $sth, {commit => 0, error => 1, sts => undef, affected => undef, tuple => [1, 1, 1, 1, []], %$ref}); check_data($dbh, [@pe1[0..4]], [@p2[0..4]]); } { note("2nd last row in error"); clear_table($dbh, $table); my $sth = $dbh->prepare(qq/insert into $table values(?,?)/); my @pe1 = @p1; $pe1[-2] = 1; $sth->bind_param_array(1, \@pe1); $sth->bind_param_array(2, \@p2); $self->insert($dbh, $sth, {commit => 0, error => 1, sts => undef, affected => undef, tuple => [1, 1, 1, [], 1], %$ref}); check_data($dbh, [@pe1[0..2],$pe1[4]], [@p2[0..2], $p2[4]]); } } sub fetch_sub { note("fetch_sub $fetch_row"); if ($fetch_row == @p1) { note('returning undef'); $fetch_row = 0; return; } return [$p1[$fetch_row], $p2[$fetch_row++]]; } # test insertion via execute_array and ArrayTupleFetch sub row_wise { my ($self, $dbh, $ref) = @_; note("row_size via execute_for_fetch"); # Populate the first table via a ArrayTupleFetch which points to a sub # returning rows $fetch_row = 0; # reset fetch_sub to start with first row clear_table($dbh, $table); my $sth = $dbh->prepare(qq/insert into $table values(?,?)/); $self->insert($dbh, $sth, {commit => 0, error => 0, sts => 5, affected => 5, tuple => [1, 1, 1, 1, 1], %$ref, fetch => \&fetch_sub}); # NOTE: The following test requires Multiple Active Statements. Although # I can find ODBC drivers which do this it is not easy (if at all possible) # to know if an ODBC driver can handle MAS or not. If it errors the # driver probably does not have MAS so the error is ignored and a # diagnostic is output. Exceptions are DBD::Oracle which definitely does # support MAS. # The data pushed into the first table is retrieved via ArrayTupleFetch # from the second table by passing an executed select statement handle into # execute_array. note("row_size via select"); clear_table($dbh, $table); $sth = $dbh->prepare(qq/insert into $table values(?,?)/); my $sth2 = $dbh->prepare(qq/select * from $table2/); # some drivers issue warnings when mas fails and this causes # Test::NoWarnings to output something when we already found # the test failed and captured it. # e.g., some ODBC drivers cannot do MAS and this test is then expected to # fail but we ignore the failure. Unfortunately in failing DBD::ODBC will # issue a warning in addition to the fail $sth->{Warn} = 0; $sth->{Warn} = 0; ok($sth2->execute, 'execute on second table') or diag($sth2->errstr); ok($sth2->{Executed}, 'second statement is in executed state'); my $res = $self->insert($dbh, $sth, {commit => 0, error => 0, sts => 5, affected => 5, tuple => [1, 1, 1, 1, 1], %$ref, fetch => $sth2, requires_mas => 1}); return if $res && $res eq 'mas'; # aborted , does not seem to support MAS check_data($dbh, \@p1, \@p2); } # test updates # updates are special as you can update more rows than there are parameter rows sub update { my ($self, $dbh, $ref) = @_; note("update test"); # populate the first table with the default 5 rows using a ArrayTupleFetch $fetch_row = 0; clear_table($dbh, $table); my $sth = $dbh->prepare(qq/insert into $table values(?,?)/); $self->insert($dbh, $sth, {commit => 0, error => 0, sts => 5, affected => 5, tuple => [1, 1, 1, 1, 1], %$ref, fetch => \&fetch_sub}); check_data($dbh, \@p1, \@p2); # update all rows b column to 'fred' checking rows affected is 5 $sth = $dbh->prepare(qq/update $table set b = ? where a = ?/); # NOTE, this also checks you can pass a scalar to bind_param_array $sth->bind_param_array(1, 'fred'); $sth->bind_param_array(2, \@p1); $self->insert($dbh, $sth, {commit => 0, error => 0, sts => 5, affected => 5, tuple => [1, 1, 1, 1, 1], %$ref}); check_data($dbh, \@p1, [qw(fred fred fred fred fred)]); # update 4 rows column b to 'dave' checking rows affected is 4 $sth = $dbh->prepare(qq/update $table set b = ? where a = ?/); # NOTE, this also checks you can pass a scalar to bind_param_array $sth->bind_param_array(1, 'dave'); my @pe1 = @p1; $pe1[-1] = 10; # non-existant row $sth->bind_param_array(2, \@pe1); $self->insert($dbh, $sth, {commit => 0, error => 0, sts => 5, affected => 4, tuple => [1, 1, 1, 1, '0E0'], %$ref}); check_data($dbh, \@p1, [qw(dave dave dave dave fred)]); # now change all rows b column to 'pete' - this will change all 5 # rows even though we have 2 rows of parameters so we can see if # the rows affected is > parameter rows $sth = $dbh->prepare(qq/update $table set b = ? where b like ?/); # NOTE, this also checks you can pass a scalar to bind_param_array $sth->bind_param_array(1, 'pete'); $sth->bind_param_array(2, ['dave%', 'fred%']); $self->insert($dbh, $sth, {commit => 0, error => 0, sts => 2, affected => 5, tuple => [4, 1], %$ref}); check_data($dbh, \@p1, [qw(pete pete pete pete pete)]); } sub enable_mars { my $dbh = shift; # this test uses multiple active statements # if we recognise the driver and it supports MAS enable it my $driver_name = $dbh->get_info(6) || ''; if (($driver_name eq 'libessqlsrv.so') || ($driver_name =~ /libsqlncli/)) { my $dsn = $ENV{DBI_DSN}; if ($dsn !~ /^dbi:ODBC:DSN=/ && $dsn !~ /DRIVER=/i) { my @a = split(q/:/, $ENV{DBI_DSN}); $dsn = join(q/:/, @a[0..($#a - 1)]) . ":DSN=" . $a[-1]; } $dsn .= ";MARS_Connection=yes"; $dbh->disconnect; $dbh = DBI->connect($dsn, $ENV{DBI_USER}, $ENV{DBI_PASS}); } return $dbh; } 1; DBD-Oracle-1.74/t/10general.t0000644000175000017500000000754212326332111014767 0ustar yanickyanickuse strict; use warnings; use Test::More; use DBI; use Config; use DBD::Oracle qw(ORA_OCI); unshift @INC ,'t'; require 'nchar_test_lib.pl'; $| = 1; my $dsn = oracle_test_dsn(); my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; my $dbh = DBI->connect($dsn, $dbuser, '', { PrintError => 0, }); if ($dbh) { plan tests => 28; } else { plan skip_all => "Unable to connect to Oracle"; } my($sth, $p1, $p2, $tmp); SKIP: { skip "not unix-like", 2 unless $Config{d_semctl}; my @ora_oci_version = split /\./, ORA_OCI(); skip 'solaris with OCI>9.x', 2 if $^O eq 'solaris' and $ora_oci_version[0] > 9; # basic check that we can fork subprocesses and wait for the status # after having connected to Oracle # at some point, this should become a subtest my $success = is system("exit 1;"), 1<<8, 'system exit 1 should return 256'; $success &&= is system("exit 0;"), 0, 'system exit 0 should return 0'; unless ( $success ) { diag <prepare(q{ /* also test preparse doesn't get confused by ? :1 */ /* also test placeholder binding is case insensitive */ select :a, :A from user_tables -- ? :1 }); ok($sth->{ParamValues}, 'preparse, case insensitive, placeholders in comments'); is(keys %{$sth->{ParamValues}}, 1, 'number of parameters'); is($sth->{NUM_OF_PARAMS}, 1, 'expected number of parameters'); ok($sth->bind_param(':a', 'a value'), 'bind_param for select parameter'); ok($sth->execute, 'execute for select parameter'); ok($sth->{NUM_OF_FIELDS}, 'NUM_OF_FIELDS'); eval { local $SIG{__WARN__} = sub { die @_ }; # since DBI 1.43 $p1=$sth->{NUM_OFFIELDS_typo}; }; ok($@ =~ /attribute/, 'unrecognised attribute'); ok($sth->{Active}, 'statement is active'); ok($sth->finish, 'finish'); ok(!$sth->{Active}, 'statement is not active'); $sth = $dbh->prepare("select * from user_tables"); ok($sth->execute, 'execute for user_tables'); ok($sth->{Active}, 'active for user_tables'); 1 while ($sth->fetch); # fetch through to end ok(!$sth->{Active}, 'user_tables not active after fetch'); # so following test works with other NLS settings/locations ok($dbh->do("ALTER SESSION SET NLS_NUMERIC_CHARACTERS = '.,'"), 'set NLS_NUMERIC_CHARACTERS'); ok($tmp = $dbh->selectall_arrayref(q{ select 1 * power(10,-130) "smallest?", 9.9999999999 * power(10,125) "biggest?" from dual }), 'select all for arithmetic'); my @tmp = @{$tmp->[0]}; #warn "@tmp"; $tmp[0]+=0; $tmp[1]+=0; warn "@tmp"; ok($tmp[0] <= 1.0000000000000000000000000000000001e-130, "tmp0=$tmp[0]"); ok($tmp[1] >= 9.99e+125, "tmp1=$tmp[1]"); my $warn=''; eval { local $SIG{__WARN__} = sub { $warn = $_[0] }; $dbh->{RaiseError} = 1; $dbh->{PrintError} = 1; $dbh->do("some invalid sql statement"); }; ok($@ =~ /DBD::Oracle::db do failed:/, "eval error: ``$@'' expected 'do failed:'"); #print "''$warn''"; ok($warn =~ /DBD::Oracle::db do failed:/, "warn error: ``$warn'' expected 'do failed:'"); ok($DBI::err, 'err defined'); $dbh->{RaiseError} = 0; $dbh->{PrintError} = 0; # --- ok( $dbh->ping, 'ping - connected'); my $ora_oci = DBD::Oracle::ORA_OCI(); # dualvar note sprintf "ORA_OCI = %d (%s)\n", $ora_oci, $ora_oci; ok("$ora_oci", 'ora_oci defined'); ok($ora_oci >= 8, "ora_oci $ora_oci >= 8"); my @ora_oci = split(/\./, $ora_oci,-1); ok(scalar @ora_oci >= 2, 'version has 2 or more components'); ok((scalar @ora_oci == grep { DBI::looks_like_number($_) } @ora_oci), 'version looks like numbers'); is($ora_oci[0], int($ora_oci), 'first number is int'); DBD-Oracle-1.74/t/28array_bind.t0000644000175000017500000001737712326332111015504 0ustar yanickyanick#!perl -w use strict; ## ---------------------------------------------------------------------------- ## 26array_bind.t ## By Alexander V Alekseev ## and John Scoles, The Pythian Group ## ## ---------------------------------------------------------------------------- ## Checking bind_param_inout to an varchar2_table and number_table ## Checking bind_param_inout_array with execute_array ## ## ---------------------------------------------------------------------------- use strict; use warnings; use Encode; use Devel::Peek; use DBI; use DBD::Oracle qw(:ora_types ORA_OCI); use Test::More; unshift @INC ,'t'; require 'nchar_test_lib.pl'; use Data::Dumper; $Data::Dumper::Useqq=1; my $dbh; my $utf8_charset = (ORA_OCI >= 9.2) ? 'AL32UTF8' : 'UTF8'; my $eight_bit_charset = 'WE8ISO8859P1'; sub db_connect($) { my $utf8 = shift; # Make sure we really are overriding the environment settings. my ($charset, $ncharset); if ($utf8) { set_nls_lang_charset($eight_bit_charset); set_nls_nchar($eight_bit_charset); $charset = $utf8_charset; $ncharset = $utf8_charset; } else { set_nls_lang_charset($utf8_charset); set_nls_nchar($utf8_charset); $charset = $eight_bit_charset; $ncharset = $eight_bit_charset; } my $dsn = oracle_test_dsn(); my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; my $p = { AutoCommit => 1, PrintError => 0, FetchHashKeyName => 'NAME_lc', ora_envhp => 0, # force fresh environment (with current NLS env vars) }; $p->{ora_charset} = $charset if $charset; $p->{ora_ncharset} = $ncharset if $ncharset; my $dbh = DBI->connect($dsn, $dbuser, '', $p); return $dbh; } sub test_varchar2_table_3_tests($){ my $dbh=shift; my $statement=' DECLARE tbl SYS.DBMS_SQL.VARCHAR2_TABLE; BEGIN tbl := :mytable; :cc := tbl.count(); tbl(1) := \'def\'; tbl(2) := \'ijk\'; :mytable := tbl; END; '; my $sth=$dbh->prepare( $statement ); if( ! defined($sth) ){ BAIL_OUT("Prapare(varchar2) error: ".$dbh->errstr); } my @arr=( "abc", "cde","lalala" ); if( not $sth->bind_param_inout(":mytable", \\@arr, 5, { ora_type => ORA_VARCHAR2_TABLE, ora_maxarray_numentries => 2 } ) ){ BAIL_OUT("bind :mytable (VARCHAR2) error: ".$dbh->errstr); } my $cc; if( not $sth->bind_param_inout(":cc", \$cc, 100 ) ){ BAIL_OUT("bind :cc (at VARCHAR2) error: ".$dbh->errstr); } if( not $sth->execute() ){ BAIL_OUT("Execute (at VARCHAR2) failed: ".$dbh->errstr); } # print "Result: cc=",$cc,"\n", # "\tarr=",Data::Dumper::Dumper(\@arr),"\n"; #Result: cc=2, l=3 # arr=$VAR1 = [ # 'def', # 'ijk' # ]; # ok( $cc == 2, "VARCHAR2_TABLE input count correctness"); ok( scalar(@arr) == 2,"VARCHAR2_TABLE output count correctness"); ok( (($arr[0] eq 'def') and ($arr[1] eq 'ijk')) , "VARCHAR2_TABLE output content") or diag( "arr[0]='",$arr[0],"', arr[1]='",$arr[1],"', arr=", Data::Dumper::Dumper(\@arr)); } sub test_number_table_3_tests($){ my $dbh=shift; my $statement=' DECLARE tbl SYS.DBMS_SQL.NUMBER_TABLE; BEGIN tbl := :mytable; :cc := tbl.count(); tbl(4) := -1; tbl(5) := -2; :mytable := tbl; END; '; my $sth=$dbh->prepare( $statement ); if( ! defined($sth) ){ BAIL_OUT("Prapare(NUMBER_TABLE) error: ".$dbh->errstr); } my @arr=( 1,"2E0","3.5" ); # note, that ora_internal_type defaults to SQLT_FLT for ORA_NUMBER_TABLE . if( not $sth->bind_param_inout(":mytable", \\@arr, 10, { ora_type => ORA_NUMBER_TABLE, ora_maxarray_numentries => (scalar(@arr)+2), ora_internal_type => SQLT_INT } ) ) { BAIL_OUT("bind(NUMBER_TABLE) :mytable error: ".$dbh->errstr); } my $cc=undef; if( not $sth->bind_param_inout(":cc", \$cc, 100 ) ){ BAIL_OUT("bind(NUMBER_TABLE) :cc error: ".$dbh->errstr); } if( not $sth->execute() ){ BAIL_OUT("Execute(NUMBER_TABLE) failed: ".$dbh->errstr); } # print "Result: cc=",$cc,"\n", # "\tarr=",Data::Dumper::Dumper(\@arr),"\n"; #Result: cc=3 # arr=$VAR1 = [ # '5', # '8', # '3.5', # '-1', # '-2' # ]; ok( $cc == 3, "NUMBER_TABLE input count correctness"); ok( scalar(@arr) == 5,"NUMBER_TABLE output count correctness"); my $result=1; my @r=(1, 2, 3, -1, -2); for( my $i=0 ; $i< scalar(@arr) ; $i++){ if( $r[$i] != $arr[$i] ){ $result=0; last; } } ok( $result , "NUMBER_TABLE output content") or diag( "arr=", Data::Dumper::Dumper(\@arr),"\nThough must be: ",Data::Dumper::Dumper(\@r)); } sub test_inout_array_tests($){ my $dbh=shift; $dbh->do("create table array_in_out_test (id number(12,0), name varchar2(20), value varchar2(2000))"); $dbh->do("create sequence seq_array_in_out_test start with 1"); $dbh->do(" create or replace trigger trg_array_in_out_testst before insert on array_in_out_test for each row DECLARE iCounter array_in_out_test.id%TYPE; BEGIN if INSERTING THEN Select seq_array_in_out_test.nextval INTO iCounter FROM Dual; :new.id := iCounter; END IF; END; "); my @in_array1=('one','two','three','four','five'); my @in_array2=('5','4','3','2','1'); my @out_array; my @tuple_status; my $sql = "insert into array_in_out_test (name, value) values (?,?) returning id into ?" ; my $sth = $dbh->prepare($sql); $sth->bind_param_array(1,\@in_array1 ); $sth->bind_param_array(2,\@in_array2); ok ( $sth->bind_param_inout_array(3,\@out_array,0,{ora_type => ORA_VARCHAR2}),'... bind_param_inout_array should return false'); ok ( $sth->execute_array({ArrayTupleStatus=>\@tuple_status}),'... execute_array should return false'); cmp_ok(scalar (@tuple_status), '==',5 , '... we should have 19 tuple_status'); cmp_ok(scalar (@out_array), '==',5 , '... we should have 5 out_array'); cmp_ok($out_array[0], '==', 1,'... out values should match 1'); cmp_ok($out_array[1], '==', 2,'... out values should match 2'); cmp_ok($out_array[2], '==', 3,'... out values should match 3'); cmp_ok($out_array[3], '==', 4,'... out values should match 3'); cmp_ok($out_array[4], '==', 5,'... out values should match 5'); $dbh->do("drop table array_in_out_test") or warn $dbh->errstr; $dbh->do("drop sequence seq_array_in_out_test") or die $dbh->errstr; } sub test_number_SP($){ my $dbh=shift; $dbh->do(" create or replace procedure tox_test_proc0( result in out varchar2, ids in SYS.dbms_sql.number_table ) as begin result := ''; for i in 1..ids.count loop result := result || to_char(ids(i)); end loop; end; "); my $sth = $dbh->prepare("begin tox_test_proc0( ?, ?); end;"); my $result = ""; my @array = (1, 2, 3, 4, 7); $sth->bind_param_inout(1, \$result, 5); ok ($sth->bind_param(2, \@array, { ora_type => ORA_NUMBER_TABLE, ora_internal_type => SQLT_INT }),'... bind_param_inout_array should bind 12345'); $sth->execute() ; cmp_ok($result, '==','12347' , '... we should have 12347 out string'); @array = (3, 4, 5); $sth->bind_param_inout(1, \$result, 3); ok ($sth->bind_param(2, \@array, { ora_type => ORA_NUMBER_TABLE, ora_internal_type => SQLT_INT }),'... bind_param_inout_array should bind 345'); $sth->execute() ; cmp_ok($result, '==','345' , '... we should have 345 out string'); $dbh->do("drop procedure tox_test_proc0") or warn $dbh->errstr; } SKIP: { $dbh = db_connect(0); if ($dbh) { plan tests => 15; } else { plan skip_all => "Unable to connect to Oracle" if not $dbh; } test_varchar2_table_3_tests($dbh); test_number_table_3_tests($dbh); test_inout_array_tests($dbh); }; END { eval { local $dbh->{PrintError} = 0; }; } +1; DBD-Oracle-1.74/t/26exe_array.t0000644000175000017500000000311112326332111015324 0ustar yanickyanick# $Id$ # Completely new test for DBD::Oracle which came from DBD::ODBC # Author: Martin J. Evans # # loads of execute_array and execute_for_fetch tests using DBI's methods # use Test::More; use strict; use Data::Dumper; require 'nchar_test_lib.pl'; use lib 't/lib', 't'; $| = 1; my $has_test_nowarnings = eval "require Test::NoWarnings; 1"; use DBI qw(:sql_types); use ExecuteArray; my $dsn = oracle_test_dsn(); my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; $ENV{NLS_NCHAR} = "US7ASCII"; $ENV{NLS_LANG} = "AMERICAN"; my $dbh = eval { DBI->connect($dsn, $dbuser, '', {PrintError => 0}) } or plan skip_all => "Unable to connect to Oracle"; my $ea = ExecuteArray->new($dbh, 1); # set odbc_disable_array_operations $dbh = $ea->dbh; $ea->drop_table($dbh); ok($ea->create_table($dbh), "create test table") or exit 1; $ea->simple($dbh, {array_context => 1, raise => 1}); $ea->simple($dbh, {array_context => 0, raise => 1}); $ea->error($dbh, {array_context => 1, raise => 1}); $ea->error($dbh, {array_context => 0, raise => 1}); $ea->error($dbh, {array_context => 1, raise => 0}); $ea->error($dbh, {array_context => 0, raise => 0}); $ea->row_wise($dbh, {array_context => 1, raise => 1}); $ea->update($dbh, {array_context => 1, raise => 1}); for my $raise ( 0..1 ) { for my $context ( 0..1 ) { $ea->error($dbh, { array_context => $context, raise => $raise, notuplestatus => 1 }); } } if ($dbh && $ea) { $ea->drop_table($dbh); $dbh->disconnect(); } Test::NoWarnings::had_no_warnings() if $has_test_nowarnings; done_testing; DBD-Oracle-1.74/t/14threads.t0000644000175000017500000001003512326332111014777 0ustar yanickyanick#!/usr/bin/perl $| = 1; ## ---------------------------------------------------------------------------- ## 14threads.t ## By Jeffrey Klein, ## ---------------------------------------------------------------------------- BEGIN { eval "use threads; use threads::shared;" } my $use_threads_err = $@; use DBI; use Config qw(%Config); use Test::More; BEGIN { if ( !$Config{useithreads} || $] < 5.008 ) { plan skip_all => "this $^O perl $] not configured to support iThreads"; } elsif ($DBI::VERSION <= 1.601){ plan skip_all => "DBI version ".$DBI::VERSION." does not support iThreads. Use version 1.602 or later."; } die $use_threads_err if $use_threads_err; # need threads } use strict; use DBI; use Test::More; unshift @INC, 't'; require 'nchar_test_lib.pl'; my $dsn = oracle_test_dsn(); my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; my $dbh = DBI->connect($dsn, $dbuser, '',{ PrintError => 0, }); if ($dbh) { plan tests => 19; $dbh->disconnect; } else { plan skip_all => "Unable to connect to Oracle"; } my $last_session : shared; our @pool : shared; # run five threads in sequence # each should get the same session # TESTS: 5 for my $i ( 0 .. 4 ) { threads->create( sub { my $dbh = get_dbh_from_pool(); my $session = session_id($dbh); if ( $i > 0 ) { is $session, $last_session, "session $i matches previous session"; } else { ok $session, "session $i created", } $last_session = $session; free_dbh_to_pool($dbh); } )->join; } # TESTS: 1 is scalar(@pool), 1, 'one imp_data in pool'; # get two sessions in same thread # TESTS: 2 threads->create( sub { my $dbh1 = get_dbh_from_pool(); my $s1 = session_id($dbh1); my $dbh2 = get_dbh_from_pool(); my $s2 = session_id($dbh2); ok $s1 ne $s2, 'thread gets two separate sessions'; free_dbh_to_pool($dbh1); my $dbh3 = get_dbh_from_pool(); my $s3 = session_id($dbh3); is $s3, $s1, 'get same session after free'; free_dbh_to_pool($dbh2); free_dbh_to_pool($dbh3); } )->join; # TESTS: 1 is scalar(@pool), 2, 'two imp_data in pool'; #trade dbh between threads my @thr; my @sem; use Thread::Semaphore; # create locked semaphores for my $i (0..2) { push @sem, Thread::Semaphore->new(0); } undef $last_session; # 3 threads, 3 iterations # TESTS: 9 for my $t ( 0..2 ) { $thr[$t] = threads->create( sub { my $partner = ( $t + 1 ) % 3; for my $i ( 1 .. 3 ) { $sem[$t]->down; my $dbh = get_dbh_from_pool(); my $session = session_id($dbh); if ( defined $last_session ) { is $session, $last_session, "thread $t, loop $i matches previous session"; } else { ok $session, "thread $t, loop $i created session"; } $last_session = $session; free_dbh_to_pool($dbh); # signal next thread $sem[$partner]->up; } } ); } # start thread 0! $sem[0]->up; $_->join for @thr; # TESTS: 1 empty_pool(); is scalar(@pool), 0, 'pool empty'; exit; sub get_dbh_from_pool { my $imp = pop @pool; # if pool is empty, $imp is undef # in that case, get new dbh return connect_dbh($imp); } sub free_dbh_to_pool { my $imp = $_[0]->take_imp_data or return; push @pool, $imp; } sub empty_pool { get_dbh_from_pool() while @pool; } sub connect_dbh { my $imp_data = shift; my $dsn = oracle_test_dsn(); my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; DBI->connect( $dsn, $dbuser, '', { dbi_imp_data => $imp_data } ); } sub session_id { my $dbh = shift; my ($s) = $dbh->selectrow_array("select userenv('sessionid') from dual"); return $s; } __END__ DBD-Oracle-1.74/t/rt74753-utf8-encoded.t0000644000175000017500000000321112326332111016520 0ustar yanickyanick#!/usr/bin/perl -w use strict; use warnings; use Test::More; use DBI; use Encode; unshift @INC ,'t'; require 'nchar_test_lib.pl'; my $dsn = oracle_test_dsn(); my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; $ENV{NLS_LANG} = 'AMERICAN_AMERICA.UTF8'; $ENV{NLS_NCHAR} = 'UTF8'; my $dbh = DBI->connect( $dsn, $dbuser, '', { PrintError => 0, AutoCommit => 0 }); plan skip_all => "unable to connect to Oracle database" if not $dbh; plan skip_all => "database character set is not Unicode" unless db_ochar_is_utf($dbh); plan tests => 3; $dbh->do(q(alter session set nls_territory = 'GERMANY')); my $sth = $dbh->prepare(<<"END_SQL"); SELECT ltrim(rtrim(to_char(0, 'L'))) FROM dual END_SQL $sth->execute; my ($val); $sth->bind_columns( \($val) ); $sth->fetch; is Encode::is_utf8($val) => 1, "utf8 encoded"; $sth->finish; $val = undef; $sth = $dbh->prepare(<<'END_SQL'); declare l_ret varchar2(10); begin select ltrim(rtrim(to_char(0, 'L'))) into l_ret from dual; -- :ret := l_ret; end; END_SQL $sth->bind_param_inout(':ret', \$val, 100); $sth->execute; is Encode::is_utf8($val) => 1, "utf8 encoded"; $sth = $dbh->prepare(<<'END_SQL'); declare l_ret varchar2(10); begin select ltrim(rtrim(to_char(0, 'L'))) || ltrim(rtrim(to_char(0, 'L'))) || ltrim(rtrim(to_char(0, 'L'))) into l_ret from dual; -- :ret := l_ret; end; END_SQL $val = undef; # WARNING: does *not* truncate. DBD::Oracle doesn't heed the 3rd parameter $sth->bind_param_inout(':ret', \$val, 1); $sth->execute; is Encode::is_utf8($val) => 1, "truncated, yet utf8 encoded"; $dbh->disconnect; DBD-Oracle-1.74/t/23wide_db.t0000644000175000017500000000311412326332111014742 0ustar yanickyanick#!perl -w #written by Lincoln A Baxter (lab@lincolnbaxter.com) use strict; #use warnings; use Test::More; use DBI qw(:sql_types); use DBD::Oracle qw( :ora_types ORA_OCI SQLCS_NCHAR ); unshift @INC ,'t'; require 'nchar_test_lib.pl'; my $dbh; $| = 1; SKIP: { plan skip_all => "Unable to run unicode test, perl version is less than 5.6" unless ( $] >= 5.006 ); plan skip_all => "Oracle charset tests unreliable for Oracle 8 client" if ORA_OCI() < 9.0 and !$ENV{DBD_ALL_TESTS}; #! #force Ncharset to NON UTF8! we are testing a wide database where someone #! #perversely sets nchar to non utf8, and nls_lang to utf8.... set_nls_lang_charset( (ORA_OCI >= 9.2) ? 'AL32UTF8' : 'UTF8', 1 ); #! #set_nls_nchar( 'WE8ISO8859P1' ,1 ); #it breaks and it is stupid to do this... doc it XXX $dbh = db_handle(); plan skip_all => "Unable to connect to Oracle" if not $dbh; plan skip_all => "Database character set is not Unicode" if not db_ochar_is_utf($dbh) ; # testing utf8 with char columns (wide mode database) my $tdata = test_data( 'wide_char' ); my $testcount = 0 #create table + insert_test_count( $tdata ) + select_test_count( $tdata ) * 1; ; plan tests => $testcount; show_test_data( $tdata ,0 ); drop_table($dbh); create_table( $dbh, $tdata ); insert_rows( $dbh, $tdata ,SQLCS_NCHAR); dump_table( $dbh ,'ch' ,'descr' ); select_rows( $dbh, $tdata ); } END { eval { local $dbh->{PrintError} = 0; drop_table($dbh) if $dbh and not $ENV{'DBD_SKIP_TABLE_DROP'}; }; } DBD-Oracle-1.74/t/22nchar_utf8.t0000644000175000017500000000301012326332111015400 0ustar yanickyanick#!perl -w #written by Lincoln A Baxter (lab@lincolnbaxter.com) use strict; #use warnings; use Test::More; use DBI qw(:sql_types); use DBD::Oracle qw( :ora_types ORA_OCI SQLCS_NCHAR ); unshift @INC ,'t'; require 'nchar_test_lib.pl'; my $dbh; $| = 1; SKIP: { plan skip_all => "Unable to run unicode test, perl version is less than 5.6" unless ( $] >= 5.006 ); plan skip_all => "Oracle charset tests unreliable for Oracle 8 client" if ORA_OCI() < 9.0 and !$ENV{DBD_ALL_TESTS}; set_nls_nchar( (ORA_OCI >= 9.2) ? 'AL32UTF8' : 'UTF8' ,1 ); $dbh = db_handle(); plan skip_all => "Unable to connect to Oracle" if not $dbh; plan skip_all => "Database NCHAR character set is not Unicode" if not db_nchar_is_utf($dbh) ; # testing utf8 with nchar columns show_db_charsets( $dbh ); my $tdata = test_data( 'wide_nchar' ); if ( $dbh->ora_can_unicode & 1 ) { push( @{$tdata->{rows}} ,extra_wide_rows() ) ; # added 2 rows with extra wide chars to test data } my $testcount = 0 #create table + insert_test_count( $tdata ) + select_test_count( $tdata ) * 1; ; plan tests => $testcount; show_test_data( $tdata ,0 ); drop_table($dbh); create_table( $dbh, $tdata ); insert_rows( $dbh, $tdata ,SQLCS_NCHAR); dump_table( $dbh ,'nch' ,'descr' ); select_rows( $dbh, $tdata ); } END { eval { local $dbh->{PrintError} = 0; drop_table($dbh) if $dbh and not $ENV{'DBD_SKIP_TABLE_DROP'}; }; } DBD-Oracle-1.74/t/31lob_extended.t0000644000175000017500000001154712326332111016011 0ustar yanickyanick#!perl -w ## ---------------------------------------------------------------------------- ## 31lob_extended.t ## By John Scoles, The Pythian Group ## ---------------------------------------------------------------------------- ## This run through some bugs that have been found in earlier versions of DBD::Oracle ## Checks to ensure that these bugs no longer come up ## Basically this is testing the use of LOBs when returned via stored procedures with bind_param_inout ## ---------------------------------------------------------------------------- use Test::More; use DBI; use Config; use DBD::Oracle qw(:ora_types); use strict; use warnings; use Data::Dumper; unshift @INC ,'t'; require 'nchar_test_lib.pl'; $| = 1; my $dsn = oracle_test_dsn(); my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; my $dbh = DBI->connect($dsn, $dbuser, '',{ PrintError => 0, }); if ($dbh) { plan tests => 30; $dbh->{LongReadLen} = 7000; } else { plan skip_all => "Unable to connect to Oracle"; diag('Test reported bugs'); } my ($table, $data0, $data1) = setup_test($dbh); my $PLSQL = <<"PLSQL"; BEGIN OPEN ? FOR SELECT x FROM $table; END; PLSQL $dbh->{RaiseError} = 1; # # bug in DBD::Oracle 1.21 where if ora_auto_lobs is not set and we attempt to # fetch from a table containing lobs which has more than one row # we get a segfault. This was due to prefetching more than one row. # { my $testname = "ora_auto_lobs prefetch"; my ($sth1, $ev); eval {$sth1 = $dbh->prepare($PLSQL, {ora_auto_lob => 0});}; ok(!$@, "$testname - prepare call proc"); my $sth2; ok($sth1->bind_param_inout(1, \$sth2, 500, {ora_type => ORA_RSET}), "$testname - bind out cursor"); ok($sth1->execute, "$testname - execute to get out cursor"); my ($lobl); ($lobl) = $sth2->fetchrow; test_lob($dbh, $lobl, $testname, 6000, $data0); ($lobl) = $sth2->fetchrow; test_lob($dbh, $lobl, $testname, 6000, $data1); ok($sth2->finish, "$testname - finished returned sth"); ok($sth1->finish, "$testname - finished sth"); } # # prior to DBD::Oracle 1.22 if ora_auto_lob was set on a statement which # was used to return a cursor on a result-set containing lobs, the lobs # were not automatically fetched. # { my $testname = "ora_auto_lobs not fetching"; my ($sth1, $ev, $lob); # ora_auto_lobs is supposed to default to set eval {$sth1 = $dbh->prepare($PLSQL);}; ok(!$@, "$testname prepare call proc"); my $sth2; ok($sth1->bind_param_inout(1, \$sth2, 500, {ora_type => ORA_RSET}), "$testname - bind out cursor"); ok($sth1->execute, "$testname - execute to get out cursor"); ($lob) = $sth2->fetchrow; ok($lob, "$testname - fetch returns something"); isnt(ref $lob, 'OCILobLocatorPtr', "$testname - not a lob locator"); is($lob, $data0, "$testname, first lob matches"); ($lob) = $sth2->fetchrow; ok($lob, "$testname - fetch returns something"); isnt(ref $lob, 'OCILobLocatorPtr', "$testname - not a lob locator"); is($lob, $data1, "$testname, second lob matches"); ok($sth2->finish, "$testname - finished returned sth"); ok($sth1->finish, "$testname - finished sth"); } sub test_lob { my ($h, $lobl, $testname, $size, $data) = @_; ok($lobl, "$testname - lob locator retrieved"); is(ref($lobl), 'OCILobLocatorPtr', "$testname - is a lob locator"); SKIP: { skip "did not receive a lob locator", 4 unless ref($lobl) eq 'OCILobLocatorPtr'; my ($lob_length, $lob, $ev); eval {$lob_length = $h->ora_lob_length($lobl);}; $ev = $@; diag($ev) if $ev; ok(!$ev, "$testname - first lob length $lob_length"); is($lob_length, $size, "$testname - correct lob length"); eval {$lob = $h->ora_lob_read($lobl, 1, $lob_length);}; $ev = $@; diag($ev) if ($ev); ok(!$ev, "$testname - read lob"); is($lob, $data, "$testname - lob returned matches lob inserted"); } } sub setup_test { my ($h) = @_; my ($table, $sth, $ev); eval {$table = create_table($h, {cols => [['x', 'clob']]}, 1)}; BAIL_OUT("test table not created- $@") if $@; ok(!$ev, "created test table"); eval { $sth = $h->prepare(qq/insert into $table (idx, x) values(?,?)/); }; BAIL_OUT("Failed to prepare insert into $table - $@") if $@; my $data0 = 'x' x 6000; my $data1 = 'y' x 6000; eval { $sth->execute(1, $data0); $sth->execute(2, $data1); }; BAIL_OUT("Failed to insert test data into $table - $@") if $@; ok(!$ev, "created test data"); return ($table, $data0, $data1); } END { return unless $dbh; local $dbh->{PrintError} = 0; local $dbh->{RaiseError} = 1; eval {drop_table($dbh);}; if ($@) { diag("table $table possibly not dropped - check - $@\n") if $dbh->err ne '942'; } } DBD-Oracle-1.74/t/000-report-versions-tiny.t0000644000175000017500000000515612326332111017647 0ustar yanickyanickuse strict; use warnings; use Test::More 0.88; # This is a relatively nice way to avoid Test::NoWarnings breaking our # expectations by adding extra tests, without using no_plan. It also helps # avoid any other test module that feels introducing random tests, or even # test plans, is a nice idea. our $success = 0; END { $success && done_testing; } # List our own version used to generate this my $v = "\nGenerated by Dist::Zilla::Plugin::ReportVersions::Tiny v1.10\n"; eval { # no excuses! # report our Perl details my $want = '5.006'; $v .= "perl: $] (wanted $want) on $^O from $^X\n\n"; }; defined($@) and diag("$@"); # Now, our module version dependencies: sub pmver { my ($module, $wanted) = @_; $wanted = " (want $wanted)"; my $pmver; eval "require $module;"; if ($@) { if ($@ =~ m/Can't locate .* in \@INC/) { $pmver = 'module not found.'; } else { diag("${module}: $@"); $pmver = 'died during require.'; } } else { my $version; eval { $version = $module->VERSION; }; if ($@) { diag("${module}: $@"); $pmver = 'died during VERSION check.'; } elsif (defined $version) { $pmver = "$version"; } else { $pmver = ''; } } # So, we should be good, right? return sprintf('%-45s => %-10s%-15s%s', $module, $pmver, $wanted, "\n"); } eval { $v .= pmver('B','any version') }; eval { $v .= pmver('Carp','any version') }; eval { $v .= pmver('DBI','1.51') }; eval { $v .= pmver('Data::Dumper','any version') }; eval { $v .= pmver('Devel::Peek','any version') }; eval { $v .= pmver('DynaLoader','any version') }; eval { $v .= pmver('Encode','any version') }; eval { $v .= pmver('Exporter','any version') }; eval { $v .= pmver('ExtUtils::MakeMaker','6.30') }; eval { $v .= pmver('Math::BigInt','any version') }; eval { $v .= pmver('Test::More','0.88') }; eval { $v .= pmver('Thread::Semaphore','any version') }; eval { $v .= pmver('lib','any version') }; eval { $v .= pmver('strict','any version') }; eval { $v .= pmver('utf8','any version') }; eval { $v .= pmver('vars','any version') }; eval { $v .= pmver('warnings','any version') }; # All done. $v .= <<'EOT'; Thanks for using my code. I hope it works for you. If not, please try and include this output in the bug report. That will help me reproduce the issue and solve your problem. EOT diag($v); ok(1, "we really didn't test anything, just reporting data"); $success = 1; # Work around another nasty module on CPAN. :/ no warnings 'once'; $Template::Test::NO_FLUSH = 1; exit 0; DBD-Oracle-1.74/t/12impdata.t0000644000175000017500000000305612326332111014767 0ustar yanickyanick#!/usr/bin/perl $| = 1; ## ---------------------------------------------------------------------------- ## 12imptdata.t ## By Jeffrey Klein, ## ---------------------------------------------------------------------------- use strict; use DBI; use Config qw(%Config); # must be done before Test::More - see Threads in Test::More pod BEGIN { eval "use threads; use threads::shared;" } my $use_threads_err = $@; use Test::More; BEGIN { if ($DBI::VERSION <= 1.601){ plan skip_all => "DBI version ".$DBI::VERSION." does not support iThreads. Use version 1.602 or later."; } die $use_threads_err if $use_threads_err; # need threads } unshift @INC, 't'; require 'nchar_test_lib.pl'; my $dsn = oracle_test_dsn(); my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; my $dbh = DBI->connect( $dsn, $dbuser, '', { PrintError => 0, }); if ($dbh) { plan tests => 7; } else { plan skip_all => "Unable to connect to Oracle"; } my $drh = $dbh->{Driver}; my ($sess_1) = $dbh->selectrow_array("select userenv('sessionid') from dual"); is $drh->{Kids}, 1, "1 kid"; is $drh->{ActiveKids}, 1, "1 active kid"; my $imp_data = $dbh->take_imp_data; is $drh->{Kids}, 0, "no kids"; is $drh->{ActiveKids}, 0, "no active kids"; $dbh = DBI->connect( $dsn, $dbuser, '', { dbi_imp_data => $imp_data } ); my ($sess_2) = $dbh->selectrow_array("select userenv('sessionid') from dual"); is $sess_1, $sess_2, "got same session"; is $drh->{Kids}, 1, "1 kid"; is $drh->{ActiveKids}, 1, "1 active kid"; __END__ DBD-Oracle-1.74/t/36lob_leak.t0000644000175000017500000001061512326332111015125 0ustar yanickyanick#!perl -w ##---------------------------------------------------------------------------- ## 36lob_leak.pl ## By Martin Evans, Easysoft Limited ##---------------------------------------------------------------------------- ## Test we are not leaking temporary lobs ##---------------------------------------------------------------------------- use Test::More; use DBI; use Config; use DBD::Oracle qw(:ora_types); use strict; use warnings; use Data::Dumper; unshift @INC ,'t'; require 'nchar_test_lib.pl'; $| = 1; my $dsn = oracle_test_dsn(); my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; my $dbh = DBI->connect($dsn, $dbuser, '',,{ PrintError => 0, }); if ($dbh) { plan tests => 7; } else { $dbh->{PrintError}=1; plan skip_all => "Unable to connect to Oracle"; } # get SID and cached lobs # if sid not passed in we run 2 tests, get the sid and the cached lobs # if sid passed in we run 1 test which is to get the cached lobs sub get_cached_lobs { my ($dbh, $sid) = @_; my $cached_lobs; if (!defined($sid)) { SKIP: { eval { ($sid) = $dbh->selectrow_array( q/select sid from v$session where audsid = SYS_CONTEXT('userenv', 'sessionid')/); }; skip 'unable to find sid', 2 if ($@ || !defined($sid)); pass("found sid $sid"); }; } if (defined($sid)) { SKIP: { eval { $cached_lobs = $dbh->selectrow_array( q/select CACHE_LOBS from V$TEMPORARY_LOBS where sid = ?/, undef, $sid); }; skip 'unable to find cached lobs', 1 if ($@ || !defined($cached_lobs)); pass("found $cached_lobs cached lobs"); }; } return ($sid, $cached_lobs); } sub setup_test { my ($h) = @_; my ($sth, $ev); my $fn = 'p_DBD_Oracle_drop_me'; my $createproc = << "EOT"; CREATE OR REPLACE FUNCTION $fn(pc IN CLOB) RETURN NUMBER AS BEGIN NULL; RETURN 0; END; EOT eval {$h->do($createproc);}; BAIL_OUT("Failed to create test function - $@") if $@; pass("created test function"); return $fn; } sub call_func { my ($dbh, $function, $how) = @_; eval { my $sth; my $sql = qq/BEGIN ? := $function(?); END;/; if ($how eq 'prepare') { $sth = $dbh->prepare($sql) or die($dbh->errstr); } elsif ($how eq 'prepare_cached') { $sth = $dbh->prepare_cached($sql) or die($dbh->errstr); } else { BAIL_OUT("Unknown prepare type $how"); } $sth->{RaiseError} = 1; BAIL_OUT("Cannot prepare a call to $function") if !$sth; my ($return, $clob); $clob = 'x' x 1000; $sth->bind_param_inout(1, \$return, 10); $sth->bind_param(2, $clob, {ora_type => ORA_CLOB}); $sth->execute; }; BAIL_OUT("Cannot call $function successfully") if $@; } my ($sid, $cached_lobs); my ($function); SKIP: { ($sid, $cached_lobs) = get_cached_lobs($dbh); # 1 2 skip 'Cannot find sid/cached lobs', 5 if !defined($cached_lobs); $function = setup_test($dbh); # 3 my $new_cached_lobs; foreach my $type (qw(prepare prepare_cached)) { for my $count(1..100) { call_func($dbh, $function, $type); }; ($sid, $new_cached_lobs) = get_cached_lobs($dbh, $sid); # we expect to leak 1 temporary lob as the last statement is # cached and the temp lob is not thrown away until you next # execute if ($new_cached_lobs > ($cached_lobs + 1)) { diag("Looks like we might be leaking temporary lobs from $type"); fail("old cached lobs: $cached_lobs " . "new cached lobs: $new_cached_lobs"); } else { pass("Not leaking temporary lobs on $type"); } $cached_lobs = $new_cached_lobs; } }; END { if ($dbh) { local $dbh->{PrintError} = 0; local $dbh->{RaiseError} = 1; if ($function){ eval {$dbh->do(qq/drop function $function/);}; if ($@) { diag("function p_DBD_Oracle_drop_me possibly not dropped" . "- check - $@\n") if $dbh->err ne '4043'; } else { note("function p_DBD_Oracle_drop_me dropped"); } } } } DBD-Oracle-1.74/t/24implicit_utf8.t0000644000175000017500000000366712326332111016143 0ustar yanickyanick#!perl -w #written by Lincoln A Baxter (lab@lincolnbaxter.com) use strict; #use warnings; use Test::More; unshift @INC ,'t'; require 'nchar_test_lib.pl'; use DBI qw(:sql_types); use DBD::Oracle qw(:ora_types ORA_OCI SQLCS_NCHAR ); my $dbh; $| = 1; SKIP: { plan skip_all => "Unable to run 8bit char test, perl version is less than 5.6" unless ( $] >= 5.006 ); plan skip_all => "Oracle charset tests unreliable for Oracle 8 client" if ORA_OCI() < 9.0 and !$ENV{DBD_ALL_TESTS}; $dbh = db_handle(); # just to check connection and db NCHAR character set plan skip_all => "Unable to connect to Oracle" if not $dbh; plan skip_all => "Database NCHAR character set is not Unicode" if not db_nchar_is_utf($dbh) ; plan skip_all => "database character set is not Unicode" unless db_ochar_is_utf($dbh); $dbh->disconnect(); # testing implicit csform (dbhimp.c sets csform implicitly) my $tdata = test_data( 'wide_nchar' ); my $testcount = 0 + insert_test_count( $tdata ) + select_test_count( $tdata ) * 1; ; my @nchar_cset = (ORA_OCI >= 9.2) ? qw(UTF8 AL32UTF8) : qw(UTF8); plan tests => $testcount * @nchar_cset; show_test_data( $tdata ,0 ); foreach my $nchar_cset (@nchar_cset) { $dbh->disconnect() if $dbh; undef $dbh; # testing with NLS_NCHAR=$nchar_cset SKIP: { set_nls_nchar( $nchar_cset ,1 ); $dbh = db_handle(); show_db_charsets($dbh); skip "failed to connect to oracle with NLS_NCHAR=$nchar_cset" ,$testcount if not $dbh; drop_table($dbh); create_table( $dbh, $tdata ); insert_rows( $dbh, $tdata ); dump_table( $dbh ,'nch' ,'descr' ); select_rows( $dbh, $tdata ); } } } END { eval { local $dbh->{PrintError} = 0; drop_table( $dbh ) if $dbh and not $ENV{'DBD_SKIP_TABLE_DROP'}; }; } __END__ DBD-Oracle-1.74/t/38taf.t0000644000175000017500000000202712326332111014127 0ustar yanickyanick#!perl -w # $Id$ use DBI; use DBD::Oracle(qw(:ora_fail_over)); use strict; #use Devel::Peek qw(SvREFCNT Dump); use Test::More; unshift @INC ,'t'; require 'nchar_test_lib.pl'; $| = 1; # create a database handle my $dsn = oracle_test_dsn(); my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; my $dbh = eval { DBI->connect($dsn, $dbuser, '',) } or plan skip_all => "Unable to connect to Oracle"; $dbh->disconnect; if ( !$dbh->ora_can_taf ){ eval { $dbh = DBI->connect( $dsn, $dbuser, '', {ora_taf_function => 'taf'}) }; my $ev = $@; like($ev, qr/You are attempting to enable TAF/, "'$ev' (expected)"); } else { ok $dbh = DBI->connect($dsn, $dbuser, '', {ora_taf_function=>'taf'}); is($dbh->{ora_taf_function}, 'taf', 'TAF callback'); my $x = sub {}; # diag(SvREFCNT($x)); # diag(Dump($x)); $dbh->{ora_taf_function} = $x; is(ref($dbh->{ora_taf_function}), 'CODE', 'TAF code ref'); # diag(SvREFCNT($x)); } $dbh->disconnect; done_testing(); DBD-Oracle-1.74/t/21nchar.t0000644000175000017500000000362112326332111014441 0ustar yanickyanick#!perl -w #written by Lincoln A Baxter (lab@lincolnbaxter.com) use strict; #use warnings; use Test::More; unshift @INC ,'t'; require 'nchar_test_lib.pl'; use DBI qw(:sql_types); use DBD::Oracle qw(:ora_types ORA_OCI SQLCS_NCHAR ); my $dbh; $| = 1; SKIP: { plan skip_all => "Unable to run 8bit char test, perl version is less than 5.6" unless ( $] >= 5.006 ); $dbh = db_handle(); # $dbh->{PrintError} = 1; plan skip_all => "Unable to connect to Oracle" if not $dbh; note("testing control and 8 bit chars:\n") ; note(" Database and client versions and character sets:\n"); show_db_charsets( $dbh); plan skip_all => "Oracle charset tests unreliable for Oracle 8 client" if ORA_OCI() < 9.0 and !$ENV{DBD_ALL_TESTS}; # get the database NCHARSET before we begin... if it is not UTF, then # use it as the client side ncharset, otherwise, use WE8ISO8859P1 my $ncharset = $dbh->ora_nls_parameters()->{'NLS_NCHAR_CHARACTERSET'}; $dbh->disconnect(); # we want to start over with the ncharset we select undef $dbh; if ( $ncharset =~ m/UTF/i ) { $ncharset = 'WE8ISO8859P1' ; #WE8MSWIN1252 } set_nls_nchar( $ncharset ,1 ); $dbh = db_handle(); my $tdata = test_data( 'narrow_nchar' ); my $testcount = 0 #create table + insert_test_count( $tdata ) + select_test_count( $tdata ) * 1; ; plan tests => $testcount ; show_test_data( $tdata ,0 ); drop_table($dbh); create_table( $dbh, $tdata ); insert_rows( $dbh, $tdata ,SQLCS_NCHAR); dump_table( $dbh ,'nch' ,'descr' ); select_rows( $dbh, $tdata ); # view_with_sqlplus(1,$tcols) if $ENV{DBD_NCHAR_SQLPLUS_VIEW}; # view_with_sqlplus(0,$tcols) if $ENV{DBD_NCHAR_SQLPLUS_VIEW}; } END { eval { local $dbh->{PrintError} = 0; drop_table( $dbh ) if $dbh and not $ENV{'DBD_SKIP_TABLE_DROP'}; }; } __END__ DBD-Oracle-1.74/t/70meta.t0000644000175000017500000000503612326332111014302 0ustar yanickyanick#!perl -w use Test::More; use strict; use DBI qw(:sql_types); use Data::Dumper; unshift @INC ,'t'; require 'nchar_test_lib.pl'; $| = 1; my $dsn = oracle_test_dsn(); my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; my $dbh = DBI->connect($dsn, $dbuser, '', {PrintError => 0 }); if ($dbh) { plan tests=>21; $dbh->{RaiseError} = 1; } else { plan skip_all => "Unable to connect to Oracle"; } note("type_info_all\n"); my @types = $dbh->type_info(SQL_ALL_TYPES); ok(@types >= 8, 'more than 8 types'); note(Dumper( @types )); note("tables():\n"); my @tables = $dbh->tables; note(@tables." tables\n"); ok(scalar @tables, 'tables'); my @table_info_params = ( [ 'schema list', undef, '%', undef, undef ], [ 'type list', undef, undef, undef, '%' ], [ 'table list', undef, undef, undef, undef ], ); foreach my $table_info_params (@table_info_params) { my ($name) = shift @$table_info_params; my $start = time; note("$name: table_info(".DBI::neat_list($table_info_params).")\n"); my $table_info_sth = $dbh->table_info(@$table_info_params); ok($table_info_sth, 'table_info'); my $data = $table_info_sth->fetchall_arrayref; ok($data, 'table_info fetch'); ok(scalar @$data, 'table_info data returned'); my $dur = time - $start; note("$name: ".@$data." rows, $dur seconds\n"); } my $sql_dbms_version = $dbh->get_info(18); ok($sql_dbms_version, 'dbms_version'); note "sql_dbms_version=$sql_dbms_version"; like($sql_dbms_version, qr/^\d+\.\d+\.\d+$/, 'matched'); # test long DEFAULT from column_info SKIP: { my $table = "dbd_ora__drop_me" . ($ENV{DBD_ORACLE_SEQ}||''); eval { $dbh->do("DROP TABLE $table") }; my $created = eval { $dbh->do("CREATE TABLE $table (testcol NUMBER(15) DEFAULT to_number(decode(substrb(userenv('CLIENT_INFO'),1,1),' ', null,substrb(userenv('CLIENT_INFO'),1,10))))") }; skip 'could not create test table', 8 unless $created; is $dbh->{LongReadLen}, 80, 'LongReadLen is at default'; ok((my $sth = $dbh->column_info(undef, '%', uc($table), '%')), 'column_info sth'); is $dbh->{LongReadLen}, 80, 'LongReadLen still at default'; ok((my $info = eval { $sth->fetchrow_hashref }), 'sth->fetchrow_hashref lived') or diag $@; is $info->{COLUMN_DEF}, "to_number(decode(substrb(userenv('CLIENT_INFO'),1,1),' ', null,substrb(userenv('CLIENT_INFO'),1,10)))", 'long DEFAULT matched'; ok($sth->finish, 'sth->finish'); is $dbh->{LongReadLen}, 80, 'LongReadLen still at default'; ok($dbh->do("DROP TABLE $table"), 'drop table'); } $dbh->disconnect; exit 0; DBD-Oracle-1.74/t/15nls.t0000644000175000017500000000310412326332111014141 0ustar yanickyanick#!perl use strict; use warnings; use DBI; use Test::More; unshift @INC ,'t'; require 'nchar_test_lib.pl'; my $testcount = 9; $| = 1; my $dsn = oracle_test_dsn(); my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; my $dbh = DBI->connect($dsn, $dbuser, '',{ PrintError => 0, }); if ($dbh) { plan tests => $testcount; } else { plan skip_all => "Unable to connect to Oracle"; } my ($nls_parameters_before, $nls_parameters_after); my $old_date_format = 'HH24:MI:SS DD/MM/YYYY'; my $new_date_format = 'YYYYMMDDHH24MISS'; ok($dbh->do("alter session set nls_date_format='$old_date_format'"), 'set date format'); like($dbh->ora_can_unicode, qr/^[0123]/, 'ora_can_unicode'); ok($nls_parameters_before = $dbh->ora_nls_parameters, 'fetch ora_nls_parameters'); is(ref($nls_parameters_before), 'HASH', 'check ora_nls_parameters returned hashref'); is($nls_parameters_before->{'NLS_DATE_FORMAT'}, $old_date_format, 'check returned nls_date_format'); ok($dbh->do("alter session set nls_date_format='$new_date_format'"), 'alter date format'); ok(eq_hash($nls_parameters_before, $dbh->ora_nls_parameters), 'check ora_nls_parameters caches old values'); $nls_parameters_before->{NLS_DATE_FORMAT} = 'foo'; isnt($nls_parameters_before->{NLS_DATE_FORMAT}, $dbh->ora_nls_parameters->{NLS_DATE_FORMAT}, 'check ora_nls_parameters returns a copy'); is($dbh->ora_nls_parameters(1)->{'NLS_DATE_FORMAT'}, $new_date_format, 'refetch and check new nls_date_format value'); __END__ DBD-Oracle-1.74/t/39attr.t0000755000175000017500000000371112326332111014334 0ustar yanickyanick#!perl -w # $Id$ # # Test you can set and retrieve some attributes after connect # MJE wrote this after discovering the code to set these attributes # was duplicated in connect/login6 and STORE and it did not need to be # because DBI passes attributes to STORE for you. # use DBI; use DBD::Oracle(qw(ORA_OCI)); use strict; #use Devel::Peek qw(SvREFCNT Dump); use Test::More; unshift @INC ,'t'; require 'nchar_test_lib.pl'; $| = 1; my $dsn = oracle_test_dsn(); my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; #use Devel::Leak; #use Test::LeakTrace; #no_leaks_ok { do_it(); #} -verbose; sub do_it { #my $handle; #my $count = Devel::Leak::NoteSV($handle); my $dbh = eval { DBI->connect($dsn, $dbuser, '',) } or plan skip_all => "Unable to connect to Oracle"; diag("Oracle version: " . join(".", @{$dbh->func('ora_server_version')})); diag("client version: " . ORA_OCI()); SKIP: { my @attrs = (qw(ora_module_name ora_client_info ora_client_identifier ora_action)); my @attrs112 = (qw(ora_driver_name)); skip('Oracle OCI too old', 1 + @attrs + @attrs112) if ORA_OCI() < 11; foreach my $attr (@attrs) { $dbh->{$attr} = 'fred'; is($dbh->{$attr}, 'fred', "attribute $attr set and retrieved"); } SKIP: { skip 'Oracle OCI too old', 1 + @attrs112 if ORA_OCI() < 11.2; like($dbh->{ora_driver_name}, qr/DBD/, 'Default driver name'); foreach my $attr (@attrs) { $dbh->{$attr} = 'fred'; is($dbh->{$attr}, 'fred', "attribute $attr set and retrieved"); } } }; foreach my $attr (qw(ora_oci_success_warn ora_objects)) { $dbh->{$attr} = 1; is($dbh->{$attr}, 1, "attribute $attr set and retrieved"); } $dbh->disconnect; #Devel::Leak::CheckSV($handle); } done_testing(); DBD-Oracle-1.74/t/rt85886.t0000755000175000017500000000206012326332111014252 0ustar yanickyanick#!/usr/bin/perl -w use strict; use warnings; use Test::More; use DBI qw(:sql_types); use Devel::Peek; use B qw( svref_2object SVf_IOK SVf_NOK SVf_POK ); unshift @INC ,'t'; require 'nchar_test_lib.pl'; sub is_iv { my $sv = svref_2object(my $ref = \$_[0]); my $flags = $sv->FLAGS; # See http://www.perlmonks.org/?node_id=971411 my $x = $sv->can('PV') ? $sv->PV : undef; if (wantarray) { return ($flags & SVf_IOK, $x); } else { return $flags & SVf_IOK; } } my $dsn = oracle_test_dsn(); my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; my $dbh = DBI->connect( $dsn, $dbuser, '', { PrintError => 0, FetchHashKeyName =>'NAME_lc'}); plan skip_all => "unable to connect to Oracle database" if not $dbh; plan tests => 2; my $s = $dbh->prepare(q/select 1 as one from dual/); $s->execute; $s->bind_col (1, undef, {TYPE => SQL_INTEGER, DiscardString => 1}); my $list = $s->fetchall_arrayref({}); is($list->[0]{one}, 1, "correct value returned"); ok(is_iv($list->[0]{one}), "ivok") or Dump($list->[0]{one}); $dbh->disconnect; DBD-Oracle-1.74/t/34pres_lobs.t0000644000175000017500000000664312326332111015351 0ustar yanickyanick#!perl -w use Test::More; use DBI; use Config; use DBD::Oracle qw(:ora_types); ## ---------------------------------------------------------------------------- ## 33pres_lobs.t ## By John Scoles, The Pythian Group ## ---------------------------------------------------------------------------- ## Checks to see if the Interface for Persistent LOBs is working ## Nothing fancy. Just an insert and a select if they fail this there is something up in OCI or the version ## of oci being used ## ---------------------------------------------------------------------------- unshift @INC ,'t'; require 'nchar_test_lib.pl'; $| = 1; # create a database handle my $dsn = oracle_test_dsn(); my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; my $dbh; eval {$dbh = DBI->connect($dsn, $dbuser, '', { RaiseError=>1, AutoCommit=>1, PrintError => 0 ,LongReadLen=>10000000})}; if ($dbh) { plan skip_all => "Data Interface for Persistent LOBs new in Oracle 9" if $dbh->func('ora_server_version')->[0] < 9; plan tests => 28; } else { plan skip_all => "Unable to connect to Oracle"; } # check that our db handle is good my $ora_oci = DBD::Oracle::ORA_OCI(); # dualvar SKIP: { skip "OCI version less than 9.2\n Persistent LOBs Tests skiped.", 29 unless $ora_oci >= 9.2; my $table = table(); eval { $dbh->do("DROP TABLE $table") }; ok($dbh->do(qq{ CREATE TABLE $table ( id NUMBER, clob1 CLOB, clob2 CLOB, blob1 BLOB, blob2 BLOB) }), 'create test table'); my $in_clob='ABCD' x 10_000; my $in_blob=("0\177x\0X"x 2048) x (1); my ($sql, $sth,$value); $sql = "insert into ".$table." (id,clob1,clob2, blob1,blob2) values(?,?,?,?,?)"; ok($sth=$dbh->prepare($sql ), 'prepare for insert into lobs'); $sth->bind_param(1,3); ok($sth->bind_param(2,$in_clob,{ora_type=>SQLT_CHR}), 'bind p2'); ok($sth->bind_param(3,$in_clob,{ora_type=>SQLT_CHR}), 'bind p3'); ok($sth->bind_param(4,$in_blob,{ora_type=>SQLT_BIN}), 'bind p4'); ok($sth->bind_param(5,$in_blob,{ora_type=>SQLT_BIN}), 'bind p5'); ok($sth->execute(), 'execute'); $sql='select * from '.$table; ok($sth=$dbh->prepare($sql,{ora_pers_lob=>1}), 'prepare with ora_pers_lob'); ok($sth->execute(), 'execute with ora_pers_lob'); my ($p_id,$log,$log2,$log3,$log4); ok(( $p_id,$log,$log2,$log3,$log4 )=$sth->fetchrow(), 'fetcheow for ora_pers_lob'); is($log, $in_clob, 'clob1 = in_clob'); is($log2, $in_clob, 'clob2 = in_clob'); is($log3, $in_blob, 'clob1 = in_blob'); is($log4, $in_blob, 'clob2 = in_blob'); ok($sth=$dbh->prepare($sql,{ora_clbk_lob=>1,ora_piece_size=>.5*1024*1024}), 'prepare for ora_piece_size'); ok($sth->execute(), 'execute for ora_piece_size'); ok(( $p_id,$log,$log2,$log3,$log4 )=$sth->fetchrow(), 'fetchrow'); ok($log eq $in_clob, 'clob1 = in_clob'); ok($log2 eq $in_clob, 'clob2 = in_clob'); ok($log3 eq $in_blob, 'clob1 = in_clob'); ok($log4 eq $in_blob, 'clob2 = in_clob'); ok($sth=$dbh->prepare($sql,{ora_piece_lob=>1,ora_piece_size=>.5*1024*1024}), 'prepare with ora_piece_lob/ora_piece_size'); ok($sth->execute(), 'execute'); ok( ( $p_id,$log,$log2,$log3,$log4 )=$sth->fetchrow(), 'fetchrow'); ok($log eq $in_clob, 'clob1 = in_clob'); ok($log2 eq $in_clob, 'clob2 = in_clob'); ok($log3 eq $in_blob, 'clob1 = in_clob'); ok($log4 eq $in_blob, 'clob2 = in_clob'); #no neeed to look at the data is should be ok $sth->finish(); drop_table($dbh); } $dbh->disconnect; 1; DBD-Oracle-1.74/t/56embbeded.t0000644000175000017500000000352312326332111015106 0ustar yanickyanick#!perl -w use DBI; use DBD::Oracle qw(ORA_RSET SQLCS_NCHAR); use strict; use Test::More; unshift @INC ,'t'; require 'nchar_test_lib.pl'; $| = 1; ## ---------------------------------------------------------------------------- ## 56embbeded.t ## By John Scoles, The Pythian Group ## ---------------------------------------------------------------------------- ## Just a few checks to see if I can select embedded objectes with Oracle::DBD ## Nothing fancy. ## ---------------------------------------------------------------------------- # create a database handle my $dsn = oracle_test_dsn(); my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; my $dbh; eval {$dbh = DBI->connect($dsn, $dbuser, '', { RaiseError=>1, AutoCommit=>1, PrintError => 0 })}; if ($dbh) { plan tests => 4; } else { plan skip_all => "Unable to connect to Oracle"; } # check that our db handle is good isa_ok($dbh, "DBI::db"); my $table = "table_embed"; my $type = $table.'a_type'; #do not warn if already there eval { local $dbh->{PrintError} = 0; $dbh->do(qq{drop TABLE $table }); }; eval { local $dbh->{PrintError} = 0; $dbh->do(qq{drop TYPE $type }); }; $dbh->do(qq{CREATE or replace TYPE $type as varray(10) of varchar(30) }); $dbh->do(qq{ CREATE TABLE $table ( aa_type $type) }); $dbh->do("insert into $table values ($type('1','2','3','4','5'))"); # simple execute my $sth; ok ($sth = $dbh->prepare("select * from $table"), '... Prepare should return true'); my $problems; ok ($sth->execute(), '... Select should return true'); while (my ($a)=$sth->fetchrow()){ $problems= scalar(@$a); } cmp_ok(scalar($problems), '==',5, '... we should have 5 items'); $dbh->do("drop table $table"); $dbh->do("drop type $type"); $dbh->disconnect; 1; DBD-Oracle-1.74/t/40ph_type.t0000644000175000017500000001037212326332111015020 0ustar yanickyanick#!perl -w use Test::More; use strict; use DBI qw(neat); use DBD::Oracle qw(ORA_OCI); use vars qw($tests); unshift @INC ,'t'; require 'nchar_test_lib.pl'; $| = 1; $^W = 1; # XXX ought to extend tests to check 'blank padded comparision semantics' my @tests = ( # type: oracle internal type to use for placeholder values # name: oracle name for type above # chops_space: set true if type trims trailing space characters # embed_nul: set true if type allows embedded nul characters # (also SKIP=1 to skip test, ti=N to trace insert, ts=N to trace select) { type=> 1, name=>"VARCHAR2", chops_space=>1, embed_nul=>1, }, # current DBD::Oracle { type=> 5, name=>"STRING", chops_space=>0, embed_nul=>0, SKIP=>1, ti=>8 }, # old Oraperl { type=>96, name=>"CHAR", chops_space=>0, embed_nul=>1, }, { type=>97, name=>"CHARZ", chops_space=>0, embed_nul=>0, SKIP=>1, ti=>8 }, ); $tests = 3; $_->{SKIP} or $tests+=8 for @tests; my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; my $dsn = oracle_test_dsn(); my $dbh = DBI->connect($dsn, $dbuser, '', { AutoCommit => 0, PrintError => 0, FetchHashKeyName => 'NAME_lc', }); if ($dbh) { plan tests => $tests; } else { plan skip_all => "Unable to connect to Oracle"; } eval { require Data::Dumper; $Data::Dumper::Useqq = $Data::Dumper::Useqq =1; $Data::Dumper::Terse = $Data::Dumper::Terse =1; $Data::Dumper::Indent= $Data::Dumper::Indent=1; }; my ($sth,$tmp); my $table = "dbd_ora__drop_me" . ($ENV{DBD_ORACLE_SEQ}||''); # drop table but don't warn if not there eval { local $dbh->{PrintError} = 0; $dbh->do("DROP TABLE $table"); }; ok($dbh->do("CREATE TABLE $table (name VARCHAR2(2), vc VARCHAR2(20), c CHAR(20))"), 'create test table'); my $val_with_trailing_space = "trailing "; my $val_with_embedded_nul = "embedded\0nul"; for my $test_info (@tests) { next if $test_info->{SKIP}; my $ph_type = $test_info->{type} || die; my $name = $test_info->{name} || die; note("\ntesting @{[ %$test_info ]} ...\n\n"); SKIP: { skip "skipping tests", 12 if ($test_info->{SKIP}); $dbh->{ora_ph_type} = $ph_type; ok($dbh->{ora_ph_type} == $ph_type, 'set ora_ph_type'); $sth = $dbh->prepare("INSERT INTO $table(name,vc,c) VALUES (?,?,?)"); $sth->trace($test_info->{ti}) if $test_info->{ti}; $sth->execute("ts", $val_with_trailing_space, $val_with_trailing_space); $sth->execute("en", $val_with_embedded_nul, $val_with_embedded_nul); $sth->execute("es", '', ''); # empty string $sth->trace(0) if $test_info->{ti}; $dbh->trace($test_info->{ts}) if $test_info->{ts}; $tmp = $dbh->selectall_hashref(qq{ SELECT name, vc, length(vc) as len, nvl(vc,'ISNULL') as isnull, c FROM $table}, "name"); ok(keys(%$tmp) == 3, 'right keys'); $dbh->trace(0) if $test_info->{ts}; $dbh->rollback; delete $_->{name} foreach values %$tmp; note(Data::Dumper::Dumper($tmp)); # check trailing_space behaviour my $expect = $val_with_trailing_space; $expect =~ s/\s+$// if $test_info->{chops_space}; my $ok = ($tmp->{ts}->{vc} eq $expect); if (!$ok && $ph_type==1 && $name eq 'VARCHAR2') { note " Placeholder behaviour for ora_type=1 VARCHAR2 (the default) varies with Oracle version.\n" . " Oracle 7 didn't strip trailing spaces, Oracle 8 did, until 9.2.x\n" . " Your system doesn't. If that seems odd, let us know.\n"; $ok = 1; } ok($ok, sprintf(" using ora_type %d expected %s but got %s for $name", $ph_type, neat($expect), neat($tmp->{ts}->{vc})) ); # check embedded nul char behaviour $expect = $val_with_embedded_nul; $expect =~ s/\0.*// unless $test_info->{embed_nul}; is($tmp->{en}->{vc}, $expect, sprintf(" expected %s but got %s for $name", neat($expect),neat($tmp->{en}->{vc})) ); # check empty string is NULL (irritating Oracle behaviour) ok(!defined $tmp->{es}->{vc}, 'vc defined'); ok(!defined $tmp->{es}->{c}, 'c defined'); ok(!defined $tmp->{es}->{len}, 'len defined'); is($tmp->{es}->{isnull}, 'ISNULL', 'ISNULL'); exit 1 if $test_info->{ti} || $test_info->{ts}; } } ok($dbh->do("DROP TABLE $table"), 'drop table'); ok($dbh->disconnect, 'disconnect'); __END__ DBD-Oracle-1.74/t/55nested.t0000644000175000017500000000732112326332111014640 0ustar yanickyanick#!perl -w use Test::More; use DBI; use DBD::Oracle qw(ORA_RSET); use strict; unshift @INC ,'t'; require 'nchar_test_lib.pl'; $| = 1; my $dsn = oracle_test_dsn(); my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; my $dbh = DBI->connect($dsn, $dbuser, '', { PrintError => 0 }); if ($dbh) { plan tests=> 29; } else { plan skip_all =>"Unable to connect to Oracle"; } # ref cursors may be slow due to oracle bug 3735785 # believed fixed in # 9.2.0.6 (Server Patch Set) # 10.1.0.4 (Server Patch Set) # 10.2.0.1 (Base Release) my $outer = $dbh->prepare(q{ SELECT object_name, CURSOR(SELECT object_name FROM dual) FROM all_objects WHERE rownum <= 5}); ok($outer, 'prepare select'); ok( $outer->{ora_types}[1] == ORA_RSET, 'set ORA_RSET'); ok( $outer->execute, 'outer execute'); ok( my @row1 = $outer->fetchrow_array, 'outer fetchrow'); my $inner1 = $row1[1]; is( ref $inner1, 'DBI::st', 'inner DBI::st'); ok( $inner1->{Active}, 'inner Active'); ok( my @row1_1 = $inner1->fetchrow_array, 'inner fetchrow_array'); is( $row1[0], $row1_1[0], 'rows equal'); ok( $inner1->{Active}, 'inner Active'); ok(my @row2 = $outer->fetchrow_array, 'outer fetchrow_array'); ok(!$inner1->{Active}, 'inner not Active'); ok(!$inner1->fetch, 'inner fetch finished'); is($dbh->err, -1, 'err = -1'); like($dbh->errstr, qr/ defunct /, 'defunct'); ok($outer->finish, 'outer finish'); is($dbh->{ActiveKids}, 0, 'ActiveKids'); ######################################################################### # Same test again but this time with 2 cursors ######################################################################### $outer = $dbh->prepare(q{ SELECT object_name, CURSOR(SELECT object_name FROM dual), CURSOR(SELECT object_name FROM dual) FROM all_objects WHERE rownum <= 5}); ok($outer, 'prepare select'); ok( $outer->{ora_types}[1] == ORA_RSET, 'set ORA_RSET'); ok( $outer->{ora_types}[2] == ORA_RSET, 'set ORA_RSET'); ok( $outer->execute, 'outer execute'); ok( @row1 = $outer->fetchrow_array, 'outer fetchrow'); $inner1 = $row1[1]; my $inner2 = $row1[2]; is( ref $inner1, 'DBI::st', 'inner DBI::st'); is( ref $inner2, 'DBI::st', 'inner DBI::st'); ok( $inner1->{Active}, 'inner Active'); ok( $inner2->{Active}, 'inner Active'); ok( @row1_1 = $inner1->fetchrow_array, 'inner fetchrow_array'); ok( my @row2_1 = $inner2->fetchrow_array, 'inner fetchrow_array'); is( $row1[0], $row1_1[0], 'rows equal'); is( $row1[0], $row2_1[0], 'rows equal'); ######################################################################### # Fetch speed test: START ######################################################################### $dbh->{RaiseError} = 1; sub timed_fetch { my ($rs,$caption) = @_; my $row_count = 0; my $tm_start = DBI::dbi_time(); $row_count++ while $rs->fetch; my $elapsed = DBI::dbi_time() - $tm_start; note "Fetched $row_count rows ($caption): $elapsed secs."; return $elapsed; } ################################################## # regular select ################################################## my $sql1 = q{ SELECT object_name FROM (SELECT object_name FROM all_objects WHERE ROWNUM<=70), (SELECT 1 FROM all_objects WHERE ROWNUM<=70) }; $outer = $dbh->prepare($sql1); $outer->execute(); my $dur_std = timed_fetch($outer,'select'); ################################################## # nested cursor ################################################## $outer = $dbh->prepare("SELECT CURSOR($sql1) FROM DUAL"); $outer->execute(); my $ref_csr = $outer->fetchrow_arrayref->[0]; my $dur_ref = timed_fetch($ref_csr,'nested cursor'); ######################################################################### # Fetch speed test: END ######################################################################### exit 0; DBD-Oracle-1.74/t/30long.t0000644000175000017500000004231212326332111014305 0ustar yanickyanick#!perl -w # vim:ts=8:sw=4 use DBI; use DBD::Oracle qw(:ora_types SQLCS_NCHAR SQLCS_IMPLICIT ORA_OCI); use strict; use Test::More; *BAILOUT = sub { die "@_\n" } unless defined &BAILOUT; unshift @INC ,'t'; require 'nchar_test_lib.pl'; my @test_sets; push @test_sets, [ "LONG", 0, 0 ]; push @test_sets, [ "LONG RAW", ORA_LONGRAW, 0 ]; push @test_sets, [ "NCLOB", ORA_CLOB, 0 ] unless ORA_OCI() < 9.0 or $ENV{DBD_ALL_TESTS}; push @test_sets, [ "CLOB", ORA_CLOB, 0 ] ; push @test_sets, [ "BLOB", ORA_BLOB, 0 ] ; my $tests_per_set = 96; my $tests = @test_sets * $tests_per_set-1; #very odd little thing that took a while to figure out. #Seems I now have 479 tests which is 9 more so 96 test then -1 to round it off $| = 1; my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; my $table = table(); my $use_utf8_data; # set per test_set below my %warnings; my @skip_unicode; push @skip_unicode, "Perl < 5.6 " if $] < 5.006; push @skip_unicode, "Oracle client < 9.0 " if ORA_OCI() < 9.0 and !$ENV{DBD_ALL_TESTS}; # Set size of test data (in 10KB units) # Minimum value 3 (else tests fail because of assumptions) # Normal value 8 (to test old 64KB threshold well) my $sz = 8; my($p1, $p2, $tmp, @tmp); #my $dbh = db_handle(); $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; my $dsn = oracle_test_dsn(); my $dbh = DBI->connect($dsn, $dbuser, '',{ PrintError => 0, }); if ($dbh) { plan tests => $tests; } else { plan skip_all => "Unable to connect to Oracle"; } my $ora_server_version = $dbh->func("ora_server_version"); note("ora_server_version: @$ora_server_version\n"); show_db_charsets($dbh) if $dbh; foreach (@test_sets) { my ($type_name, $type_num, $test_no_type) = @$_; $use_utf8_data = use_utf8_data($dbh,$type_name); note( qq( ========================================================================= Running long test for $type_name ($type_num) use_utf8_data=$use_utf8_data )); run_long_tests($dbh, $type_name, $type_num); run_long_tests($dbh, $type_name, 0) if $test_no_type; } exit 0; # end. END { drop_table( $dbh ) if not $ENV{DBD_SKIP_TABLE_DROP}; $dbh->disconnect if $dbh; } sub use_utf8_data { my ( $dbh, $type_name ) = @_; if ( ($type_name =~ m/^CLOB/i and db_ochar_is_utf($dbh) && client_ochar_is_utf8()) or ($type_name =~ m/^NCLOB/i and db_nchar_is_utf($dbh) && client_nchar_is_utf8()) ) { return 1 unless @skip_unicode; warn "Skipping Unicode data tests: @skip_unicode\n" if !$warnings{use_utf8_data}++; } return 0; } sub run_long_tests { my ($dbh, $type_name, $type_num) = @_; my ($sth); my $append_len; SKIP: { #it all # relationships between these lengths are important # e.g. my %long_data; my @long_data; $long_data[2] = ("2bcdefabcd" x 1024) x ($sz-1); # 70KB > 64KB && < long_data1 $long_data[1] = ("1234567890" x 1024) x ($sz ); # 80KB >> 64KB && > long_data2 $long_data[0] = ("0\177x\0X" x 2048) x (1 ); # 10KB < 64KB if ( $use_utf8_data ) { # make $long_data0 be UTF8 my $utf_x = "0\x{263A}xyX"; #lab: the ubiquitous smiley face $long_data[0] = ($utf_x x 2048) x (1 ); # 10KB < 64KB if (length($long_data[0]) > 10240) { note "known bug in perl5.6.0 utf8 support, applying workaround\n"; my $utf_z = "0\x{263A}xyZ" ; $long_data[0] = $utf_z; $long_data[0] .= $utf_z foreach (1..2047); } if ($type_name eq 'BLOB') { # convert string from utf-8 to byte encoding XXX $long_data[0] = pack "C*", (unpack "C*", $long_data[0]); } } my $be_utf8 = ($type_name eq 'BLOB') ? 0 : ($type_name eq 'CLOB') ? client_ochar_is_utf8() : ($type_name eq 'NCLOB') ? client_nchar_is_utf8() : 0; # XXX umm, what about LONGs? # special hack for long_data[0] since RAW types need pairs of HEX $long_data[0] = "00FF" x (length($long_data[0]) / 2) if $type_name =~ /RAW/i; my $len_data0 = length($long_data[0]); my $len_data1 = length($long_data[1]); my $len_data2 = length($long_data[2]); # warn if some of the key aspects of the data sizing are tampered with warn "long_data[0] is > 64KB: $len_data0\n" if $len_data0 > 65535; warn "long_data[1] is < 64KB: $len_data1\n" if $len_data1 < 65535; warn "long_data[2] is not smaller than $long_data[1] ($len_data2 > $len_data1)\n" if $len_data2 >= $len_data1; my $tdata = { cols => long_test_cols( $type_name ), rows => [] }; skip "Unable to create test table for '$type_name' data ($DBI::err)." ,$tests_per_set if (!create_table($dbh, $tdata, 1)); # typically OCI 8 client talking to Oracle 7 database note("long_data[0] length $len_data0\n"); note("long_data[1] length $len_data1\n"); note("long_data[2] length $len_data2\n"); note(" --- insert some $type_name data (ora_type $type_num)\n"); my $sqlstr = "insert into $table values (?, ?, SYSDATE)" ; ok( $sth = $dbh->prepare( $sqlstr ), "prepare: $sqlstr" ); my $bind_attr = { ora_type => $type_num }; # The explicit SQLCS_IMPLICIT is needed in some odd cases $bind_attr->{ora_csform} = ($type_name =~ /^NCLOB/) ? SQLCS_NCHAR : SQLCS_IMPLICIT; $sth->bind_param(2, undef, $bind_attr ) or die "$type_name: $DBI::errstr" if $type_num; ok($sth->execute(40, $long_data{40} = $long_data[0] ), "insert long data 40" ); ok($sth->execute(41, $long_data{41} = $long_data[1] ), "insert long data 41" ); ok($sth->execute(42, $long_data{42} = $long_data[2] ), "insert long data 42" ); ok($sth->execute(43, $long_data{43} = undef), "insert long data undef 43" ); # NULL array_test($dbh); note(" --- fetch $type_name data back again -- truncated - LongTruncOk == 1\n"); $dbh->{LongReadLen} = 20; $dbh->{LongTruncOk} = 1; note("LongReadLen $dbh->{LongReadLen}, LongTruncOk $dbh->{LongTruncOk}\n"); # This behaviour isn't specified anywhere, sigh: my $out_len = $dbh->{LongReadLen}; $out_len *= 2 if ($type_name =~ /RAW/i); $sqlstr = "select * from $table order by idx"; ok($sth = $dbh->prepare($sqlstr), "prepare: $sqlstr" ); $sth->trace(0); ok($sth->execute, "execute: $sqlstr" ); ok($tmp = $sth->fetchall_arrayref, "fetch_arrayref for $sqlstr" ); $sth->trace(0); SKIP: { if ($DBI::err && $DBI::errstr =~ /ORA-01801:/) { # ORA-01801: date format is too long for internal buffer skip " If you're using Oracle <= 8.1.7 then this error is probably\n" ." due to an Oracle bug and not a DBD::Oracle problem.\n" , 5 ; } cmp_ok(@$tmp ,'==' ,4 ,'four rows' ); #print "tmp->[0][1] = " .$tmp->[0][1] ."\n" ; for my $i (0..2) { my $v = $tmp->[$i][1]; cmp_ok_byte_nice($v, substr($long_data[$i],0,$out_len), "truncated to LongReadLen $out_len"); if ($type_name eq 'BLOB') { ok( !utf8::is_utf8($v), "BLOB non-UTF8"); } else { # allow result to have UTF8 flag even if source data didn't # (not ideal but would need better test data) ok( utf8::is_utf8($v) >= utf8::is_utf8($long_data[$i]), "$type_name UTF8 setting"); } } # use Data::Dumper; print Dumper($tmp->[3]); ok(!defined $tmp->[3][1], "last row undefined"); # NULL # known bug in DBD::Oracle <= 1.13 } note(" --- fetch $type_name data back again -- truncated - LongTruncOk == 0\n"); $dbh->{LongReadLen} = $len_data1 - 10; # so $long_data[0] fits but long_data[1] doesn't $dbh->{LongReadLen} = $dbh->{LongReadLen} / 2 if $type_name =~ /RAW/i; my $LongReadLen = $dbh->{LongReadLen}; $dbh->{LongTruncOk} = 0; note("LongReadLen $dbh->{LongReadLen}, LongTruncOk $dbh->{LongTruncOk}\n"); $sqlstr = "select * from $table order by idx"; ok($sth = $dbh->prepare($sqlstr), "prepare $sqlstr" ); ok($sth->execute, "execute $sqlstr" ); ok($tmp = $sth->fetchrow_arrayref, "fetchrow_arrayref $sqlstr" ); ok($tmp->[1] eq $long_data[0], "length tmp->[1] ".length($tmp->[1]) ); { local $sth->{PrintError} = 0; ok(!defined $sth->fetchrow_arrayref, "truncation error not triggered " ."(LongReadLen $LongReadLen, data ".length($tmp->[1]||0).")"); $tmp = $sth->err || 0; ok( ($tmp == 1406 || $tmp == 24345) ,"tmp==1406 || tmp==24345 tmp actually=$tmp" ); } $sth->finish; note(" --- fetch $type_name data back again -- complete - LongTruncOk == 0\n"); $dbh->{LongReadLen} = $len_data1 +1000; $dbh->{LongTruncOk} = 0; note("LongReadLen $dbh->{LongReadLen}, LongTruncOk $dbh->{LongTruncOk}\n"); $sqlstr = "select * from $table order by idx"; ok($sth = $dbh->prepare($sqlstr), "prepare: $sqlstr" ); ok($sth->execute, "execute $sqlstr" ); for my $i (0..2) { ok($tmp = $sth->fetchrow_arrayref, "fetchrow_arrayref $sqlstr" ); ok($tmp->[1] eq $long_data[$i], cdif($tmp->[1],$long_data[$i], "Len ".length($tmp->[1])) ); } $sth->finish; SKIP: { skip( "blob_read tests for LONGs - not currently supported", 15 ) if ($type_name =~ /LONG/i) ; #$dbh->trace(4); note(" --- fetch $type_name data back again -- via blob_read\n\n"); $dbh->{LongReadLen} = 1024 * 90; $dbh->{LongTruncOk} = 1; $sqlstr = "select idx, lng, dt from $table order by idx"; ok($sth = $dbh->prepare($sqlstr) ,"prepare $sqlstr" ); ok($sth->execute, "execute $sqlstr" ); note("fetch via fetchrow_arrayref\n"); ok($tmp = $sth->fetchrow_arrayref, "fetchrow_arrayref 1: $sqlstr" ); cmp_ok_byte_nice($tmp->[1], $long_data[0], "truncated to LongReadLen $out_len"); note("read via blob_read_all\n"); cmp_ok(blob_read_all($sth, 1, \$p1, 4096) ,'==', length($long_data[0]), "blob_read_all = length(\$long_data[0])" ); ok($p1 eq $long_data[0], cdif($p1, $long_data[0]) ); $sth->trace(0); ok($tmp = $sth->fetchrow_arrayref, "fetchrow_arrayref 2: $sqlstr" ); cmp_ok(blob_read_all($sth, 1, \$p1, 12345) ,'==', length($long_data[1]), "blob_read_all = length(long_data[1])" ); ok($p1 eq $long_data[1], cdif($p1, $long_data[1]) ); ok($tmp = $sth->fetchrow_arrayref, "fetchrow_arrayref 3: $sqlstr" ); my $len = blob_read_all($sth, 1, \$p1, 34567); cmp_ok($len,'==', length($long_data[2]), "length of long_data[2] = $len" ); cmp_ok_byte_nice($p1, $long_data[2], "3rd row via blob_read_all"); note("result is ".(utf8::is_utf8($p1) ? "UTF8" : "non-UTF8")."\n"); if ($be_utf8) { ok( utf8::is_utf8($p1), "result should be utf8"); } else { ok( !utf8::is_utf8($p1), "result should not be utf8"); } } #skip SKIP: { skip( "ora_auto_lob tests for $type_name" ."s - not supported", 7+(13*3) ) if not ( $type_name =~ /LOB/i ); note(" --- testing ora_auto_lob to access $type_name LobLocator\n\n"); my $data_fmt = "%03d foo!"; $sqlstr = qq{ SELECT lng, idx FROM $table ORDER BY idx FOR UPDATE -- needed so lob locator is writable }; my $ll_sth = $dbh->prepare($sqlstr, { ora_auto_lob => 0 } ); # 0: get lob locator instead of lob contents ok($ll_sth ,"prepare $sqlstr" ); ok($ll_sth->execute ,"execute $sqlstr" ); while (my ($lob_locator, $idx) = $ll_sth->fetchrow_array) { note("$idx: ".DBI::neat($lob_locator)."\n"); last if !defined($lob_locator) && $idx == 43; ok($lob_locator, '$lob_locator is true' ); is(ref $lob_locator , 'OCILobLocatorPtr', '$lob_locator is a OCILobLocatorPtr' ); ok( (ref $lob_locator and $$lob_locator), '$lob_locator deref ptr is true' ) ; # check ora_lob_chunk_size: my $chunk_size = $dbh->func($lob_locator, 'ora_lob_chunk_size'); ok(!$DBI::err, "DBI::errstr"); my $data = sprintf $data_fmt, $idx; #create a little data note("length of data to be written at offset 1: " .length($data) ."\n" ); ok($dbh->func($lob_locator, 1, $data, 'ora_lob_write') ,"ora_lob_write" ); } is($ll_sth->rows, 4); note(" --- round again to check contents after $type_name write updates...\n"); ok($ll_sth->execute,"execute (again 1) $sqlstr" ); while (my ($lob_locator, $idx) = $ll_sth->fetchrow_array) { note("$idx locator: ".DBI::neat($lob_locator)."\n"); next if !defined($lob_locator) && $idx == 43; diag("DBI::errstr=$DBI::errstr\n") if $DBI::err ; my $content = $dbh->func($lob_locator, 1, 20, 'ora_lob_read'); diag("DBI::errstr=$DBI::errstr\n") if $DBI::err ; ok($content,"content is true" ); note("$idx content: ".nice_string($content)."\n"); #.DBI::neat($content)."\n"; cmp_ok(length($content) ,'==', 20 ,"lenth(content)" ); # but prefix has been overwritten: my $data = sprintf $data_fmt, $idx; ok(substr($content,0,length($data)) eq $data ,"length(content)=length(data)" ); # ora_lob_length agrees: my $len = $dbh->func($lob_locator, 'ora_lob_length'); ok(!$DBI::err ,"DBI::errstr" ); cmp_ok($len ,'==', length($long_data{$idx}) ,"length(long_data{idx}) = length of locator data" ); # now trim the length $dbh->func($lob_locator, $idx, 'ora_lob_trim'); ok(!$DBI::err, "DBI::errstr" ); # and append some text SKIP: { $append_len = 0; skip( "ora_lob_append() not reliable in Oracle 8 (Oracle bug #886191)", 1 ) if ORA_OCI() < 9 or $ora_server_version->[0] < 9; my $append_data = "12345"; $append_len = length($append_data); $dbh->func($lob_locator, $append_data, 'ora_lob_append'); ok(!$DBI::err ,"ora_lob_append DBI::errstr" ); # XXX ought to test data was actually appended } } #while fetchrow is($ll_sth->rows, 4); note(" --- round again to check the $type_name length...\n"); ok($ll_sth->execute ,"execute (again 2) $sqlstr" ); while (my ($lob_locator, $idx) = $ll_sth->fetchrow_array) { note("$idx locator: ".DBI::neat($lob_locator)."\n"); next if !defined($lob_locator) && $idx == 43; my $len = $dbh->func($lob_locator, 'ora_lob_length'); #lab: possible logic error here w/resp. to len ok(!$DBI::err ,"DBI::errstr" ); cmp_ok( $len ,'==', $idx + $append_len ,"len == idx+5" ); } is($ll_sth->rows, 4); } #skip for LONG types } #skip it all (tests_per_set) $sth->finish if $sth; drop_table( $dbh ) } # end of run_long_tests sub array_test { my ($dbh) = @_; return 0; # XXX disabled eval { $dbh->{RaiseError}=1; $dbh->trace(0); my $sth = $dbh->prepare(qq{ UPDATE $table set idx=idx+1 RETURNING idx INTO ? }); my ($a,$b); $a = []; $sth->bind_param_inout(1,\$a, 2); $sth->execute; note("a=$a\n"); note("a=@$a\n"); }; die "RETURNING array: $@"; } sub print_substrs { my ($dbh,$len) = @_; my $tsql = "select substr(lng,1,$len),idx from $table order by idx" ; diag("-- prepare: $tsql\n") ; my $tsth = $dbh->prepare( $tsql ); $tsth->execute(); while ( my ( $d,$i ) = $tsth->fetchrow_array() ) { last if not defined $d; diag("$i: $d\n"); } } sub print_lengths { my ($dbh) = @_; my $tsql = "select length(lng),idx from $table order by idx" ; diag("-- prepare: $tsql\n"); my $tsth = $dbh->prepare( $tsql ); $tsth->execute(); while ( my ( $l,$i ) = $tsth->fetchrow_array() ) { last if not defined $l; diag("$i: $l\n"); } } sub blob_read_all { my ($sth, $field_idx, $blob_ref, $lump) = @_; $lump ||= 4096; # use benchmarks to get best value for you my $offset = 0; my @frags; while (1) { my $frag = $sth->blob_read($field_idx, $offset, $lump); last unless defined $frag; my $len = length $frag; last unless $len; push @frags, $frag; $offset += $len; #print "blob_read_all: offset $offset, len $len\n"; } $$blob_ref = join "", @frags; return length($$blob_ref); } sub unc { my @str = @_; foreach (@str) { s/([\000-\037\177-\377])/ sprintf "\\%03o", ord($_) /eg; } return join "", @str unless wantarray; return @str; } sub cdif { my ($s1, $s2, $msg) = @_; $msg = ($msg) ? ", $msg" : ""; my ($l1, $l2) = (length($s1), length($s2)); return "Strings are identical$msg" if $s1 eq $s2; return "Strings are of different lengths ($l1 vs $l2)$msg" # check substr matches? if $l1 != $l2; my $i; for($i=0; $i < $l1; ++$i) { my ($c1,$c2) = (ord(substr($s1,$i,1)), ord(substr($s2,$i,1))); next if $c1 == $c2; return sprintf "Strings differ at position %d (\\%03o vs \\%03o)$msg", $i,$c1,$c2; } return "(cdif error $l1/$l2/$i)"; } __END__ DBD-Oracle-1.74/t/32xmltype.t0000644000175000017500000000372712326332111015061 0ustar yanickyanick#!/usr/bin/perl use strict; use Test::More; use DBD::Oracle qw(:ora_types); use DBI; unshift @INC ,'t'; require 'nchar_test_lib.pl'; ## ---------------------------------------------------------------------------- ## 03xmlype.t ## By John Scoles, The Pythian Group ## ---------------------------------------------------------------------------- ## Just a few checks to see if one can insert small and large xml files ## Nothing fancy. ## ---------------------------------------------------------------------------- # create a database handle my $dsn = oracle_test_dsn(); my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; my $dbh; eval {$dbh = DBI->connect($dsn, $dbuser, '', { RaiseError=>1, AutoCommit=>1, PrintError => 0 })}; if ($dbh) { plan skip_all => "XMLTYPE new in Oracle 9" if $dbh->func('ora_server_version')->[0] < 9; plan tests => 3; } else { plan skip_all => "Unable to connect to Oracle" } # check that our db handle is good isa_ok($dbh, "DBI::db"); my $table = table(); eval { $dbh->do("DROP TABLE $table") }; $dbh->do(qq{ CREATE TABLE $table ( id INTEGER NOT NULL, XML_DATA XMLTYPE ) }); my ($stmt, $sth); my $small_xml=""; my $large_xml=""; my $i=0; for ($i=0;$i<=10;$i++){ $small_xml=$small_xml."the book ".$i." title"; } $small_xml=$small_xml.""; for ($i=0;$i<=10000;$i++){ $large_xml=$large_xml."the book ".$i." title"; } $large_xml=$large_xml.""; $stmt = "INSERT INTO ".$table." VALUES (1,?)"; $sth =$dbh-> prepare($stmt); $sth-> bind_param(1, $small_xml, { ora_type => ORA_XMLTYPE }); ok ($sth->execute(), '... execute for small XML return true'); $sth-> bind_param(1, $large_xml, { ora_type => ORA_XMLTYPE }); ok ($sth->execute(), '... execute for large XML return true'); drop_table($dbh); $dbh->disconnect; 1; DBD-Oracle-1.74/t/58object.t0000644000175000017500000002165512326332111014635 0ustar yanickyanick#!perl -w use DBI; use DBD::Oracle qw(ORA_RSET SQLCS_NCHAR); use strict; use Data::Dumper; use Test::More; unshift @INC ,'t'; require 'nchar_test_lib.pl'; $| = 1; $ENV{NLS_DATE_FORMAT} = 'YYYY-MM-DD"T"HH24:MI:SS'; # create a database handle my $dsn = oracle_test_dsn(); my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; my $dbh; eval {$dbh = DBI->connect($dsn, $dbuser, '',{ RaiseError=>1, AutoCommit=>1, PrintError => 0, ora_objects => 1 })}; plan skip_all => "Unable to connect to Oracle" unless $dbh; plan tests => 65; my ($schema) = $dbuser =~ m{^([^/]*)}; # Test ora_objects flag is $dbh->{ora_objects} => 1, 'ora_objects flag is set to 1'; $dbh->{ora_objects} = 0; is $dbh->{ora_objects} => 0, 'ora_objects flag is set to 0'; # check that our db handle is good isa_ok($dbh, "DBI::db"); ok( $schema = $dbh->selectrow_array( "select sys_context('userenv', 'current_schema') from dual" ), 'Fetch current schema name'); my $obj_prefix = "dbd_test_"; my $super_type = "${obj_prefix}_type_A"; my $sub_type = "${obj_prefix}_type_B"; my $table = "${obj_prefix}_obj_table"; my $outer_type = "${obj_prefix}_outer_type"; my $inner_type = "${obj_prefix}_inner_type"; my $list_type = "${obj_prefix}_list_type"; my $nest_table = "${obj_prefix}_nest_table"; my $list_table = "${obj_prefix}_list_table"; sub drop_test_objects { for my $obj ("TABLE $list_table", "TABLE $nest_table", "TYPE $list_type", "TYPE $outer_type", "TYPE $inner_type", "TABLE $table", "TYPE $sub_type", "TYPE $super_type") { #do not warn if already there eval { local $dbh->{PrintError} = 0; $dbh->do(qq{drop $obj}); }; } } &drop_test_objects; # get the user's privileges my $privs_sth = $dbh->prepare( 'SELECT PRIVILEGE from session_privs' ); $privs_sth->execute; my @privileges = map { $_->[0] } @{ $privs_sth->fetchall_arrayref }; my $ora8 = $dbh->func('ora_server_version')->[0] < 9; my $final = $ora8 ? '':'FINAL'; my $not_final = $ora8 ? '':'NOT FINAL'; SKIP: { skip q{don't have permission to create type} => 61 unless grep { $_ eq 'CREATE TYPE' } @privileges; sql_do_ok( $dbh, qq{ CREATE OR REPLACE TYPE $super_type AS OBJECT ( num INTEGER, name VARCHAR2(20) ) $not_final } ); SKIP: { skip 'Subtypes new in Oracle 9' => 1 if $ora8; sql_do_ok( $dbh, qq{ CREATE OR REPLACE TYPE $sub_type UNDER $super_type ( datetime DATE, amount NUMERIC(10,5) ) $not_final } ); } sql_do_ok( $dbh, qq{ CREATE TABLE $table (id INTEGER, obj $super_type) }); sql_do_ok( $dbh, qq{ INSERT INTO $table VALUES (1, $super_type(13, 'obj1')) }); SKIP: { skip 'Subtypes new in Oracle 9' => 2 if $ora8; sql_do_ok( $dbh, qq{ INSERT INTO $table VALUES (2, $sub_type(NULL, 'obj2', TO_DATE('2004-11-30 14:27:18', 'YYYY-MM-DD HH24:MI:SS'), 12345.6789)) } ); sql_do_ok( $dbh, qq{ INSERT INTO $table VALUES (3, $sub_type(5, 'obj3', NULL, 777.666)) } ); } sql_do_ok( $dbh, qq{ CREATE OR REPLACE TYPE $inner_type AS OBJECT ( num INTEGER, name VARCHAR2(20) ) $final }); sql_do_ok( $dbh, qq{ CREATE OR REPLACE TYPE $outer_type AS OBJECT ( num INTEGER, obj $inner_type ) $final }); sql_do_ok( $dbh, qq{ CREATE OR REPLACE TYPE $list_type AS TABLE OF $inner_type }); sql_do_ok( $dbh, qq{ CREATE TABLE $nest_table(obj $outer_type) }); sql_do_ok( $dbh, qq{ INSERT INTO $nest_table VALUES($outer_type(91, $inner_type(1, 'one'))) } ); sql_do_ok( $dbh, qq{ INSERT INTO $nest_table VALUES($outer_type(92, $inner_type(0, null))) } ); sql_do_ok( $dbh, qq{ INSERT INTO $nest_table VALUES($outer_type(93, null)) } ); sql_do_ok( $dbh, qq{ CREATE TABLE $list_table ( id INTEGER, list $list_type ) NESTED TABLE list STORE AS ${list_table}_list }); sql_do_ok( $dbh, qq{ INSERT INTO $list_table VALUES(81,$list_type($inner_type(null, 'listed'))) } ); # Test old (backward compatible) interface # test select testing objects my $sth = $dbh->prepare("select * from $table order by id"); ok ($sth, 'old: Prepare select'); ok ($sth->execute(), 'old: Execute select'); my ( @row1, @row2, @row3 ); @row1 = $sth->fetchrow(); ok (scalar @row1, 'old: Fetch first row'); cmp_ok(ref $row1[1], 'eq', 'ARRAY', 'old: Row 1 column 2 is an ARRAY'); cmp_ok(scalar(@{$row1[1]}), '==', 2, 'old: Row 1 column 2 is has 2 elements'); SKIP: { skip 'Subtypes new in Oracle 9' => 6 if $ora8; @row2 = $sth->fetchrow(); ok (scalar @row2, 'old: Fetch second row'); cmp_ok(ref $row2[1], 'eq', 'ARRAY', 'old: Row 2 column 2 is an ARRAY'); cmp_ok(scalar(@{$row2[1]}), '==', 2, 'old: Row 2 column 2 is has 2 elements'); @row3 = $sth->fetchrow(); ok (scalar @row3, 'old: Fetch third row'); cmp_ok(ref $row3[1], 'eq', 'ARRAY', 'old: Row 3 column 2 is an ARRAY'); cmp_ok(scalar(@{$row3[1]}), '==', 2, 'old: Row 3 column 2 is has 2 elements'); } ok (!$sth->fetchrow(), 'old: No more rows expected'); #print STDERR Dumper(\@row1, \@row2, \@row3); # Test new (extended) object interface # enable extended object support $dbh->{ora_objects} = 1; # test select testing objects - in extended mode $sth = $dbh->prepare("select * from $table order by id"); ok ($sth, 'new: Prepare select'); ok ($sth->execute(), 'new: Execute select'); @row1 = $sth->fetchrow(); ok (scalar @row1, 'new: Fetch first row'); cmp_ok(ref $row1[1], 'eq', 'DBD::Oracle::Object', 'new: Row 1 column 2 is an DBD:Oracle::Object'); cmp_ok(uc $row1[1]->type_name, "eq", uc "$schema.$super_type", "new: Row 1 column 2 object type"); is_deeply([$row1[1]->attributes], ['NUM', 13, 'NAME', 'obj1'], "new: Row 1 column 2 object attributes"); SKIP: { skip 'Subtypes new in Oracle 9' => 8 if $ora8; @row2 = $sth->fetchrow(); ok (scalar @row2, 'new: Fetch second row'); cmp_ok(ref $row2[1], 'eq', 'DBD::Oracle::Object', 'new: Row 2 column 2 is an DBD::Oracle::Object'); cmp_ok(uc $row2[1]->type_name, "eq", uc "$schema.$sub_type", "new: Row 2 column 2 object type"); my %attrs = $row2[1]->attributes; $attrs{AMOUNT} = sprintf "%9.4f", $attrs{AMOUNT}; is_deeply( \%attrs, {'NUM', undef, 'NAME', 'obj2', 'DATETIME', '2004-11-30T14:27:18', 'AMOUNT', '12345.6789'}, "new: Row 1 column 2 object attributes"); @row3 = $sth->fetchrow(); ok (scalar @row3, 'new: Fetch third row'); cmp_ok(ref $row3[1], 'eq', 'DBD::Oracle::Object', 'new: Row 3 column 2 is an DBD::Oracle::Object'); cmp_ok(uc $row3[1]->type_name, "eq", uc "$schema.$sub_type", "new: Row 3 column 2 object type"); %attrs = $row3[1]->attributes; $attrs{AMOUNT} = sprintf "%6.3f", $attrs{AMOUNT}; is_deeply( \%attrs, {'NUM', 5, 'NAME', 'obj3', 'DATETIME', undef, 'AMOUNT', '777.666'}, "new: Row 1 column 2 object attributes"); } ok (!$sth->fetchrow(), 'new: No more rows expected'); #print STDERR Dumper(\@row1, \@row2, \@row3); SKIP: { skip 'Subtypes new in Oracle 9' => 3 if $ora8; # Test DBD::Oracle::Object my $obj = $row3[1]; my $expected_hash = { NUM => 5, NAME => 'obj3', DATETIME => undef, AMOUNT => 777.666, }; my $attrs = $obj->attr_hash; $attrs->{AMOUNT} = sprintf "%6.3f", $attrs->{AMOUNT}; is_deeply($attrs, $expected_hash, 'DBD::Oracle::Object->attr_hash'); is_deeply($obj->attr, $expected_hash, 'DBD::Oracle::Object->attr'); is($obj->attr("NAME"), 'obj3', 'DBD::Oracle::Object->attr("NAME")'); } # try the list table $sth = $dbh->prepare("select * from $list_table"); ok ($sth, 'new: Prepare select with nested table of objects'); ok ($sth->execute(), 'new: Execute (nested table)'); @row1 = $sth->fetchrow(); ok (scalar @row1, 'new: Fetch first row (nested table)'); is_deeply($row1[1]->[0]->attr, {NUM=>undef, NAME=>'listed'}, 'Check propertes of first (and only) item in nested table'); ok (!$sth->fetchrow(), 'new: No more rows expected (nested table)'); #try the nested table $sth = $dbh->prepare("select * from $nest_table"); ok ($sth, 'new: Prepare select with nested object'); ok ($sth->execute(), 'new: Execute (nested object)'); @row1 = $sth->fetchrow(); ok (scalar @row1, 'new: Fetch first row (nested object)'); is($row1[0]->attr->{NUM}, '91', 'Check obj.num'); is_deeply($row1[0]->attr->{OBJ}->attr, {NUM=>'1', NAME=>'one'}, 'Check obj.obj'); @row2 = $sth->fetchrow(); ok (scalar @row2, 'new: Fetch second row (nested object)'); is($row2[0]->attr->{NUM}, '92', 'Check obj.num'); is_deeply($row2[0]->attr->{OBJ}->attr, {NUM=>'0', NAME=>undef}, 'Check obj.obj'); @row3 = $sth->fetchrow(); ok (scalar @row3, 'new: Fetch third row (nested object)'); is_deeply($row3[0]->attr, {NUM=>'93', OBJ=>undef}, 'Check obj'); ok (!$sth->fetchrow(), 'new: No more rows expected (nested object)'); } #cleanup &drop_test_objects; $dbh->disconnect; 1; sub sql_do_ok { my ( $dbh, $sql, $title ) = @_; $title = $sql unless defined $title; ok( $dbh->do( $sql ), $title ) or diag $dbh->errstr; } DBD-Oracle-1.74/t/50cursor.t0000644000175000017500000000615112326332111014666 0ustar yanickyanick#!perl -w # From: Jeffrey Horn use Test::More; use DBI; use DBD::Oracle qw(ORA_RSET); use strict; unshift @INC ,'t'; require 'nchar_test_lib.pl'; $| = 1; my ($limit, $tests); my $dsn = oracle_test_dsn(); my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; my $dbh = DBI->connect($dsn, $dbuser, '', { PrintError => 0 }); if ($dbh) { # ORA-00900: invalid SQL statement # ORA-06553: PLS-213: package STANDARD not accessible my $tst = $dbh->prepare( q{declare foo char(50); begin RAISE INVALID_NUMBER; end;}); if ($dbh->err && ($dbh->err==900 || $dbh->err==6553 || $dbh->err==600)) { warn "Your Oracle server doesn't support PL/SQL" if $dbh->err== 900; warn "Your Oracle PL/SQL is not properly installed" if $dbh->err==6553||$dbh->err==600; plan skip_all => 'server does not support pl/sql or not installed'; } $limit = $dbh->selectrow_array( q{SELECT value-2 FROM v$parameter WHERE name = 'open_cursors'}); # allow for our open and close cursor 'cursors' $limit -= 2 if $limit && $limit >= 2; unless (defined $limit) { # v$parameter open_cursors could be 0 :) warn("Can't determine open_cursors from v\$parameter, so using default\n"); $limit = 1; } $limit = 100 if $limit > 100; # lets not be greedy or upset DBA's $tests = 2 + 10 * $limit + 6; plan tests => $tests; note "Max cursors: $limit"; } else { plan skip_all => "Unable to connect to Oracle"; } my @cursors; my @row; note("opening cursors\n"); my $open_cursor = $dbh->prepare( qq{ BEGIN OPEN :kursor FOR SELECT * FROM all_objects WHERE rownum < 5; END; } ); ok($open_cursor, 'open cursor' ); foreach ( 1 .. $limit ) { note("opening cursor $_\n"); ok( $open_cursor->bind_param_inout( ":kursor", \my $cursor, 0, { ora_type => ORA_RSET } ), 'open cursor bind param inout' ); ok( $open_cursor->execute, 'open cursor execute' ); ok(!$open_cursor->{Active}, 'open cursor Active'); ok($cursor->{Active}, 'cursor Active' ); ok($cursor->fetchrow_arrayref, 'cursor fetcharray'); ok($cursor->fetchrow_arrayref, 'cursor fetcharray'); ok($cursor->finish, 'cursor finish' ); # finish early ok(!$cursor->{Active}, 'cursor not Active'); push @cursors, $cursor; } note("closing cursors\n"); my $close_cursor = $dbh->prepare( qq{ BEGIN CLOSE :kursor; END; } ); ok($close_cursor, 'close cursor'); foreach ( 1 .. @cursors ) { print "closing cursor $_\n"; my $cursor = $cursors[$_-1]; ok($close_cursor->bind_param( ":kursor", $cursor, { ora_type => ORA_RSET }), 'close cursor bind param'); ok($close_cursor->execute, 'close cursor execute'); } my $PLSQL = <<"PLSQL"; DECLARE TYPE t IS REF CURSOR; c t; BEGIN ? := c; END; PLSQL ok(my $sth1 = $dbh->prepare($PLSQL), 'prepare exec of proc for null cursor'); ok($sth1->bind_param_inout(1, \my $cursor, 100, {ora_type => ORA_RSET}), 'binding cursor for null cursor'); ok($sth1->execute, 'execute for null cursor'); is($cursor, undef, 'undef returned for null cursor'); ok($sth1->execute, 'execute 2 for null cursor'); is($cursor, undef, 'undef 2 returned for null cursor'); $dbh->disconnect; exit 0; DBD-Oracle-1.74/t/80ora_charset.t0000644000175000017500000000572112326332111015650 0ustar yanickyanick#!perl -w use strict; use Encode; use Devel::Peek; use DBI; use DBD::Oracle qw(ORA_OCI); use Test::More; unshift @INC ,'t'; require 'nchar_test_lib.pl'; my $tdata = { cols => [ [ 'ch', 'varchar2(20)', ], [ 'nch', 'nvarchar2(20)', ], [ 'descr', 'varchar2(50)', ], ], 'dump' => 'DUMP(%s)', rows => [ [ "\xb0", "\xb0", 'DEGREE SIGN', ], ], }; my $table = table(); my $utf8_charset = (ORA_OCI >= 9.2) ? 'AL32UTF8' : 'UTF8'; my $eight_bit_charset = 'WE8ISO8859P1'; my $dbh_utf8; my $dbh; SKIP: { plan skip_all => "Oracle 9.2 or newer required" unless ORA_OCI >= 9.2; if ($ENV{ORA_CHARSET_FAIL}) { # Connecting up here breaks because of the charset and ncharset # global variables defined in dbdimp.c $dbh_utf8 = db_connect(1); } my $testcount = 8 + insert_test_count( $tdata ); $dbh = db_connect(0); if ($dbh) { $dbh->ora_nls_parameters ()->{NLS_CHARACTERSET} =~ m/US7ASCII/ and plan skip_all => "Database is set up as US7ASCII"; plan tests => $testcount; } else { plan skip_all => "Unable to connect to Oracle"; } show_test_data( $tdata ,0 ); drop_table($dbh); create_table($dbh, $tdata); insert_rows( $dbh, $tdata); my ($ch, $nch) = $dbh->selectrow_array("select ch, nch from $table"); check($ch, $nch, 0); unless ($ENV{ORA_CHARSET_FAIL}) { $dbh_utf8 = db_connect(1); } ($ch, $nch) = $dbh_utf8->selectrow_array("select ch, nch from $table"); check($ch, $nch, 1); }; sub check { my $ch = shift; my $nch = shift; my $is_utf8 = shift; if ($is_utf8) { ok(Encode::is_utf8($ch)); ok(Encode::is_utf8($nch)); } else { ok(!Encode::is_utf8($ch)); ok(!Encode::is_utf8($nch)); } is($ch, "\xb0", "match char"); is($nch, "\xb0", "match char"); } sub db_connect { my $utf8 = shift; # Make sure we really are overriding the environment settings. my ($charset, $ncharset); if ($utf8) { set_nls_lang_charset($eight_bit_charset); set_nls_nchar($eight_bit_charset); $charset = $utf8_charset; $ncharset = $utf8_charset; } else { set_nls_lang_charset($utf8_charset); set_nls_nchar($utf8_charset); $charset = $eight_bit_charset; $ncharset = $eight_bit_charset; } my $dsn = oracle_test_dsn(); my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; my $p = { AutoCommit => 1, PrintError => 0, FetchHashKeyName => 'NAME_lc', ora_envhp => 0, # force fresh environment (with current NLS env vars) }; $p->{ora_charset} = $charset if $charset; $p->{ora_ncharset} = $ncharset if $ncharset; my $dbh = DBI->connect($dsn, $dbuser, '', $p); return $dbh; } END { eval { local $dbh->{PrintError} = 0; drop_table( $dbh ) if $dbh and not $ENV{'DBD_SKIP_TABLE_DROP'}; }; } 1; DBD-Oracle-1.74/t/51scroll.t0000644000175000017500000001014012326332111014641 0ustar yanickyanick#!/usr/bin/perl use strict; use Test::More; use DBD::Oracle qw(:ora_types :ora_fetch_orient :ora_exe_modes); use DBI; unshift @INC ,'t'; require 'nchar_test_lib.pl'; ## ---------------------------------------------------------------------------- ## 51scroll.t ## By John Scoles, The Pythian Group ## ---------------------------------------------------------------------------- ## Just a few checks to see if one can use a scrolling cursor ## Nothing fancy. ## ---------------------------------------------------------------------------- # create a database handle my $dsn = oracle_test_dsn(); my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; my $dbh; eval {$dbh = DBI->connect($dsn, $dbuser, '', { RaiseError=>1, AutoCommit=>1, PrintError => 0 })}; if ($dbh) { plan skip_all => "Scrollable cursors new in Oracle 9" if $dbh->func('ora_server_version')->[0] < 9; plan tests => 37; } else { plan skip_all => "Unable to connect to Oracle"; } ok ($dbh->{RowCacheSize} = 10); # check that our db handle is good isa_ok($dbh, "DBI::db"); my $table = table(); $dbh->do(qq{ CREATE TABLE $table ( id INTEGER ) }); my ($sql, $sth,$value); my $i=0; $sql = "INSERT INTO ".$table." VALUES (?)"; $sth =$dbh-> prepare($sql); $sth->execute($_) foreach (1..10); $sql="select * from ".$table; ok($sth=$dbh->prepare($sql, {ora_exe_mode=>OCI_STMT_SCROLLABLE_READONLY, ora_prefetch_memory=>200})); ok ($sth->execute()); #first loop all the way forward with OCI_FETCH_NEXT foreach (1..10) { $value = $sth->ora_fetch_scroll(OCI_FETCH_NEXT,0); is($value->[0], $_, '... we should get the next record'); } $value = $sth->ora_fetch_scroll(OCI_FETCH_CURRENT,0); cmp_ok($value->[0], '==', 10, '... we should get the 10th record'); # fetch off the end of the result-set $value = $sth->ora_fetch_scroll(OCI_FETCH_NEXT, 0); is($value, undef, "end of result-set"); #now loop all the way back for($i=1;$i<=9;$i++){ $value = $sth->ora_fetch_scroll(OCI_FETCH_PRIOR,0); cmp_ok($value->[0], '==', 10-$i, '... we should get the prior record'); } #now +4 records relative from the present position of 0; $value = $sth->ora_fetch_scroll(OCI_FETCH_RELATIVE,4); cmp_ok($value->[0], '==', 5, '... we should get the 5th record'); #now +2 records relative from the present position of 4; $value = $sth->ora_fetch_scroll(OCI_FETCH_RELATIVE,2); cmp_ok($value->[0], '==', 7, '... we should get the 7th record'); #now -3 records relative from the present position of 6; $value = $sth->ora_fetch_scroll(OCI_FETCH_RELATIVE,-3); cmp_ok($value->[0], '==', 4, '... we should get the 4th record'); #now get the 9th record from the start $value = $sth->ora_fetch_scroll(OCI_FETCH_ABSOLUTE,9); cmp_ok($value->[0], '==', 9, '... we should get the 9th record'); #now get the last record $value = $sth->ora_fetch_scroll(OCI_FETCH_LAST,0); cmp_ok($value->[0], '==', 10, '... we should get the 10th record'); #now get the ora_scroll_position cmp_ok($sth->ora_scroll_position(), '==', 10, '... we should get the 10 for the ora_scroll_position'); #now back to the first $value = $sth->ora_fetch_scroll(OCI_FETCH_FIRST,0); cmp_ok($value->[0], '==', 1, '... we should get the 1st record'); #check the ora_scroll_position one more time cmp_ok($sth->ora_scroll_position(), '==', 1, '... we should get the 1 for the ora_scroll_position'); # rt 76695 - fetch after fetch scroll maintains offset # now fetch forward 2 places then just call fetch # it should give us the 4th rcord and not the 5th $value = $sth->ora_fetch_scroll(OCI_FETCH_RELATIVE,2); is($value->[0], 3, '... we should get the 3rd record rt76695'); ($value) = $sth->fetchrow; is($value, 4, '... we should get the 4th record rt 76695'); # rt 76410 - fetch after fetch absolute always returns the same row $value = $sth->ora_fetch_scroll(OCI_FETCH_ABSOLUTE, 2); is($value->[0], 2, "... we should get the 2nd row rt76410_2"); ($value) = $sth->fetchrow; is($value, 3, "... we should get the 3rd row rt76410_2"); $sth->finish(); drop_table($dbh); $dbh->disconnect; 1; DBD-Oracle-1.74/t/01base.t0000755000175000017500000000115112326332111014255 0ustar yanickyanick#!perl -w use strict; use warnings; # Base DBD Driver Test use Test::More tests => 6; require_ok('DBI'); eval { import DBI; }; is $@ => '', 'successfully import DBI'; is ref DBI->internal => 'DBI::dr', 'internal'; my $drh = eval { # This is a special case. install_driver should not normally be used. DBI->install_driver('Oracle'); }; is $@ => '', 'install_driver' or diag "Failed to load Oracle extension and/or shared libraries"; SKIP: { skip 'install_driver failed - skipping remaining', 2 if $@; is ref $drh => 'DBI::dr', 'install_driver'; ok $drh->{Version}, 'version'; } DBD-Oracle-1.74/t/20select.t0000644000175000017500000001073012326332111014623 0ustar yanickyanick#!perl -w use Test::More; use DBI; use DBD::Oracle qw(:ora_types ORA_OCI); use Data::Dumper; use Math::BigInt; use strict; unshift @INC ,'t'; require 'nchar_test_lib.pl'; $| = 1; my @test_sets = ( [ "CHAR(10)", 10 ], [ "VARCHAR(10)", 10 ], [ "VARCHAR2(10)", 10 ], ); # Set size of test data (in 10KB units) # Minimum value 3 (else tests fail because of assumptions) # Normal value 8 (to test 64KB threshold well) my $sz = 8; my $tests = 3; my $tests_per_set = 11; $tests += @test_sets * $tests_per_set; my $t = 0; my $failed = 0; my %ocibug; my $table = "dbd_ora__drop_me" . ($ENV{DBD_ORACLE_SEQ}||''); my $dsn = oracle_test_dsn(); my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; my $dbh = DBI->connect($dsn, $dbuser, '', { PrintError => 0, }); if ($dbh) { plan tests=>$tests; } else { plan skip_all => "Unable to connect to oracle\n"; } # test simple select statements with [utf8] my $utf8_test = ($] >= 5.006) && client_ochar_is_utf8() # for correct output (utf8 bind vars should be fine regardless) && ($dbh->ora_can_unicode() & 2); diag("Including unicode data in test") if $utf8_test; unless(create_test_table("str CHAR(10)", 1)) { BAIL_OUT("Unable to create test table ($DBI::errstr)\n"); print "1..0\n"; exit 0; } my($sth, $p1, $p2, $tmp, @tmp); foreach (@test_sets) { run_select_tests( @$_ ); } my $ora_server_version = $dbh->func("ora_server_version"); SKIP: { skip "Oracle < 10", 1 if ($ora_server_version->[0] < 10); my $data = $dbh->selectrow_array(q! select to_dsinterval(?) from dual !, {}, "1 07:00:00"); ok ((defined $data and $data eq '+000000001 07:00:00.000000000'), "ds_interval"); } if (0) { # UNION ALL causes Oracle 9 (not 8) to describe col1 as zero length # causing "ORA-24345: A Truncation or null fetch error occurred" error # Looks like an Oracle bug $dbh->trace(9); ok 0, $sth = $dbh->prepare(qq{ SELECT :HeadCrncy FROM DUAL UNION ALL SELECT :HeadCrncy FROM DUAL}); $dbh->trace(0); ok 0, $sth->execute("EUR"); ok 0, $tmp = $sth->fetchall_arrayref; use Data::Dumper; die Dumper $tmp; } # $dbh->{USER} is just there so it works for old DBI's before Username was added my @pk = $dbh->primary_key(undef, $dbh->{USER}||$dbh->{Username}, uc $table); ok(@pk, 'primary key on table'); is(join(",",@pk), 'DT,IDX', 'DT,IDX'); exit 0; END { $dbh->do(qq{ drop table $table }) if $dbh; } sub run_select_tests { my ($type_name, $field_len) = @_; my $data0; if ($utf8_test) { $data0 = eval q{ "0\x{263A}xyX" }; #this includes the smiley from perlunicode (lab) BTW: it is busted } else { $data0 = "0\177x\0X"; } my $data1 = "1234567890"; my $data2 = "2bcdefabcd"; SKIP: { if (!create_test_table("lng $type_name", 1)) { # typically OCI 8 client talking to Oracle 7 database diag("Unable to create test table for '$type_name' data ($DBI::err)"); skip $tests_per_set; } $sth = $dbh->prepare("insert into $table values (?, ?, SYSDATE)"); ok($sth, "prepare for insert of $type_name"); ok($sth->execute(40, $data0), "insert 8bit or utf8"); ok($sth->execute(Math::BigInt->new(41), $data1), 'bind overloaded value'); ok($sth->execute(42, $data2), "insert data2"); ok(!$sth->execute(43, "12345678901234567890"), 'insert string too long'); ok($sth = $dbh->prepare("select * from $table order by idx"), "prepare select ordered by idx"); ok($sth->execute, "execute"); # allow for padded blanks $sth->{ChopBlanks} = 1; ok($tmp = $sth->fetchall_arrayref, 'fetchall'); my $dif; if ($utf8_test) { $dif = DBI::data_diff($tmp->[0][1], $data0); ok(!defined($dif) || $dif eq '', 'first row matches'); diag($dif) if $dif; } else { is($tmp->[0][1], $data0, 'first row matches'); } is($tmp->[1][1], $data1, 'second row matches'); is($tmp->[2][1], $data2, 'third row matches'); } } # end of run_select_tests # end. sub create_test_table { my ($fields, $drop) = @_; my $sql = qq{create table $table ( idx integer, $fields, dt date, primary key (dt, idx) )}; $dbh->do(qq{ drop table $table }) if $drop; $dbh->do($sql); if ($dbh->err && $dbh->err==955) { $dbh->do(qq{ drop table $table }); warn "Unexpectedly had to drop old test table '$table'\n" unless $dbh->err; $dbh->do($sql); } return 0 if $dbh->err; return 1; } __END__ DBD-Oracle-1.74/t/nchar_test_lib.pl0000644000175000017500000003627612326332111016347 0ustar yanickyanickuse strict; use warnings; use Carp; use Data::Dumper; use DBI; use DBD::Oracle qw(ORA_OCI ora_env_var); require utf8; # perl 5.6 doesn't define utf8::is_utf8() unless (defined &{"utf8::is_utf8"}) { die "Can't run this test using Perl $] without DBI >= 1.38" unless $DBI::VERSION >= 1.38; *utf8::is_utf8 = sub { my $raw = shift; return 0 if !defined $raw; my $v = DBI::neat($raw); return 1 if $v =~ /^"/; # XXX ugly hack, sufficient here return 0 if $v =~ /^'/; # XXX ugly hack, sufficient here carp "Emulated utf8::is_utf8 is unreliable for $v ($raw)"; return 0; } } =head binmode STDOUT, ':utf8' Wide character in print at t/nchar_test_lib.pl line 134 (#1) (W utf8) Perl met a wide character (>255) when it wasn't expecting one. This warning is by default on for I/O (like print). The easiest way to quiet this warning is simply to add the :utf8 layer to the output, e.g. binmode STDOUT, ':utf8'. Another way to turn off the warning is to add no warnings 'utf8'; but that is often closer to cheating. In general, you are supposed to explicitly mark the filehandle with an encoding, see open and perlfunc/binmode. =cut eval { binmode STDOUT, ':utf8' }; # Fails for perl 5.6 diag("Can't set binmode(STDOUT, ':utf8'): $@") if $@; eval { binmode STDERR, ':utf8' }; # Fails for perl 5.6 diag("Can't set binmode(STDERR, ':utf8'): $@") if $@; # Test::More duplicates STDOUT/STDERR at the start but does not copy the IO # layers from our STDOUT/STDERR. As a result any calls to Test::More::diag # with utf8 data will show warnings. Similarly, if we pass utf8 into # Test::More::pass, ok, etc etc. To get around this we specifically tell # Test::More to use our newly changed STDOUT and STDERR for failure_output # and output. my $tb = Test::More->builder; binmode($tb->failure_output, ':utf8'); binmode($tb->output, ':utf8'); sub long_test_cols { my ($type) = @_ ; return [ [ lng => $type ], ]; } sub char_cols { [ [ ch => 'varchar2(20)' ], [ descr => 'varchar2(50)' ], ]; } sub nchar_cols { [ [ nch => 'nvarchar2(20)' ], [ descr => 'varchar2(50)' ], ]; } sub wide_data { [ [ "\x{03}", "control-C" ], [ "a", "lowercase a" ], [ "b", "lowercase b" ], [ "\x{263A}", "smiley face" ], # These are not safe for db's with US7ASCII # [ "\x{A1}", "upside down bang" ], # [ "\x{A2}", "cent char" ], # [ "\x{A3}", "british pound" ], ]; } sub extra_wide_rows { # Non-BMP characters require use of surrogates with UTF-16 # So U+10304 becomes U+D800 followed by U+DF04 (I think) in UTF-16. # # When encoded as standard UTF-8, which Oracle calls AL32UTF8, it should # be a single UTF-8 code point (that happens to occupy 4 bytes). # # When encoded as "CESU-8", which Oracle calls "UTF8", each surrogate # is treated as a code point so you get 2 UTF-8 code points # (that happen to occupy 3 bytes each). That is not valid UTF-8. # See http://www.unicode.org/reports/tr26/ for more information. return unless ORA_OCI >= 9.2; # need AL32UTF8 for these to work return ( [ "\x{10304}", "SMP Plane 1 wide char" ], # OLD ITALIC LETTER E [ "\x{20301}", "SIP Plane 2 wide char" ], # CJK Unified Ideographs Extension B ); } sub narrow_data # Assuming WE8ISO8859P1 or WE8MSWIN1252 character set { my $highbitset = [ # These non-unicode strings are not safe if client charset is utf8 # because we have to let oracle assume they're utf8 but they're not [ chr(161), "upside down bang" ], [ chr(162), "cent char" ], [ chr(163), "british pound" ], ]; [ [ "a", "lowercase a" ], [ "b", "lowercase b" ], [ chr(3), "control-C" ], (nls_local_has_utf8()) ? () : @$highbitset ]; } my $tdata_hr = { narrow_char => { cols => char_cols(), rows => narrow_data() } , narrow_nchar => { cols => nchar_cols(), rows => narrow_data() } , wide_char => { cols => char_cols(), rows => wide_data() } , wide_nchar => { cols => nchar_cols(), rows => wide_data() } , }; sub test_data { my ($which) = @_; my $test_data = $tdata_hr->{$which} or die; $test_data->{dump} = "DUMP(%s)"; if ($ENV{DBD_ORACLE_TESTLOB}) { # XXX temp. needs reworking # Nvarchar -> Nclob and varchar -> clob $test_data->{cols}[0][1] =~ s/varchar.*/CLOB/; $test_data->{dump} = "DUMP(DBMS_LOB.SUBSTR(%s))"; } return $test_data; } sub oracle_test_dsn { my( $default, $dsn ) = ( 'dbi:Oracle:', $ENV{ORACLE_DSN} ); $dsn ||= $ENV{DBI_DSN} if $ENV{DBI_DSN} && ($ENV{DBI_DSN} =~ /^$default/io); $dsn ||= $default; return $dsn; } sub db_handle { my $dsn = oracle_test_dsn(); my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; my $dbh = DBI->connect($dsn, $dbuser, '', { AutoCommit => 1, PrintError => 0, ora_envhp => 0, # force fresh environment (with current NLS env vars) }); return $dbh; } sub show_test_data { my ($tdata) = @_; my $rowsR = $tdata->{rows}; my $cnt = 0; my $vcnt = 0; foreach my $recR ( @$rowsR ) { $cnt++; my $v = $$recR[0]; my $byte_string = byte_string($v); my $nice_string = nice_string($v); my $out = sprintf( "row: %3d: nice_string=%s byte_string=%s (%s, %s)\n", $cnt, $nice_string, $byte_string, $v, DBI::neat($v)); note($out); } return $cnt; } sub table { 'dbd_ora__drop_me'.($ENV{DBD_ORACLE_SEQ}||''); } sub drop_table { my ($dbh) = @_; my $table = table(); local $dbh->{PrintError} = 0; $dbh->do(qq{ drop table $table }) if $dbh->{Active}; } sub insert_handle { my ($dbh,$tcols) = @_; my $table = table(); my $sql = "insert into $table ( idx, "; my $cnt = 1; foreach my $col ( @$tcols ) { $sql .= $$col[0] . ", "; $cnt++; } $sql .= "dt ) values( " . "?, " x $cnt ."sysdate )"; my $h = $dbh->prepare( $sql ); ok( $h ,"prepared: $sql" ); return $h; } sub insert_test_count { my ( $tdata ) = @_; my $rcnt = @{$tdata->{rows}}; my $ccnt = @{$tdata->{cols}}; return 1 + $rcnt*2 + $rcnt * $ccnt; } sub insert_rows #1 + rows*2 +rows*ncols tests { my ($dbh, $tdata ,$csform) = @_; my $trows = $tdata->{rows}; my $tcols = $tdata->{cols}; my $table = table(); # local $dbh->{TraceLevel} = 4; my $sth = insert_handle($dbh, $tcols); my $cnt = 0; foreach my $rowR ( @$trows ) { my $colnum = 1; my $attrR = $csform ? { ora_csform => $csform } : {}; ok( $sth->bind_param( $colnum++ ,$cnt ) ,"bind_param idx" ); for( my $i = 0; $i < @$rowR; $i++ ) { my $note = 'withOUT attribute ora_csform'; my $val = $$rowR[$i]; my $type = $$tcols[$i][1]; #print "type=$type\n"; my $attr = {}; if ( $type =~ m/^nchar|^nvar|^nclob/i ) { $attr = $attrR; $note = $attr && $csform ? "with attribute { ora_csform => $csform }" : ""; } ok( $sth->bind_param( $colnum++ ,$val ,$attr ) ,"bind_param " . $$tcols[$i][0] ." $note" ); } $cnt++; ok( $sth->execute ,"insert row $cnt: $rowR->[-1]" ); } } sub dump_table { my ( $dbh ,@cols ) = @_; return; # not needed now select_handle() includes a DUMP column my $table = table(); my $colstr = ''; foreach my $col ( @cols ) { $colstr .= ", " if $colstr; $colstr .= "dump($col)" } my $sql = "select $colstr from $table order by idx" ; print "dumping $table\nprepared: $sql\n" ; my $colnum = 0; my $data = eval { $dbh->selectall_arrayref( $sql ) } || []; my $cnt = 0; while ( my $aref = shift @$data ) { $cnt++; my $colnum = 0; foreach my $col ( @cols ) { print "row $cnt: " ; print "$col=" .$$aref[$colnum] ."\n"; $colnum++; } } } sub select_handle #1 test { my ($dbh,$tdata) = @_; my $table = table(); my $sql = "select "; foreach my $col ( @{$tdata->{cols}} ) { $sql .= $$col[0] . ", "; } $sql .= sprintf "$tdata->{dump}, ", $tdata->{cols}[0][0]; $sql .= "dt from $table order by idx" ; my $h = $dbh->prepare( $sql ); ok( $h ,"prepared: $sql" ); return $h; } sub select_test_count { my ( $tdata ) = @_; my $rcnt = @{$tdata->{rows}}; my $ccnt = @{$tdata->{cols}}; return 2 + $ccnt + $rcnt * $ccnt * 2; } sub select_rows # 1 + numcols + rows * cols * 2 { my ($dbh,$tdata,$csform) = @_; my $table = table(); my $trows = $tdata->{rows}; my $tcols = $tdata->{cols}; my $sth = select_handle($dbh,$tdata) or do { fail(); return }; my @data = (); my $colnum = 0; foreach my $col ( @$tcols ) { ok( $sth->bind_col( $colnum+1 ,\$data[$colnum] ), "bind column " .$$tcols[$colnum][0] ); $colnum++; } my $dumpcol = sprintf $tdata->{dump}, $tdata->{cols}[0][0]; #ok( $sth->bind_col( $colnum+1 ,\$data[$colnum] ), "bind column DUMP(" .$tdata->{cols}[0][0] .")" ); $sth->bind_col( $colnum+1 ,\$data[$colnum] ); my $cnt = 0; $sth->execute(); while ( $sth->fetch() ) { my $row = $cnt + 1; my $error = 0; my $i = 0; for( $i = 0 ; $i < @$tcols; $i++ ) { my $res = $data[$i]; my $charname = $trows->[$cnt][1] || ''; my $is_utf8 = utf8::is_utf8( $res ) ? " (uft8)" : ""; my $description = "row $row: column: $tcols->[$i][0] $is_utf8 $charname"; $error += not cmp_ok_byte_nice($res, $$trows[$cnt][$i], $description); #$sth->trace(0) if $cnt >= 3 ; } if ( $error ) { warn "# row $row: $dumpcol = " .$data[$i]. "\n" ; } $cnt++; } #$sth->trace(0); my $trow_cnt = @$trows; cmp_ok( $cnt, '==', $trow_cnt, "number of rows fetched" ); } sub cmp_ok_byte_nice { my ($got, $expected, $description) = @_; my $ok1 = cmp_ok( byte_string($got), 'eq', byte_string($expected), "byte_string test of $description" ); my $ok2 = cmp_ok( nice_string($got), 'eq', nice_string($expected), "nice_string test of $description" ); return $ok1 && $ok2; } sub create_table { my ($dbh,$tdata,$drop) = @_; my $tcols = $tdata->{cols}; my $table = table(); my $sql = "create table $table ( idx integer, "; foreach my $col ( @$tcols ) { $sql .= $$col[0] . " " .$$col[1] .", "; } $sql .= " dt date )"; drop_table( $dbh ) if $drop; #$dbh->do(qq{ drop table $table }) if $drop; $dbh->do($sql); if ($dbh->err && $dbh->err==955) { $dbh->do(qq{ drop table $table }); warn "Unexpectedly had to drop old test table '$table'\n" unless $dbh->err; $dbh->do($sql); } elsif ($dbh->err) { return; } else { #$sql =~ s/ \( */(\n\t/g; #$sql =~ s/, */,\n\t/g; note("$sql\n") ; } return $table; # ok( not $dbh->err, "create table $table..." ); } sub show_db_charsets { my ( $dbh) = @_; my $out; my $ora_server_version = join ".", @{$dbh->func("ora_server_version")||[]}; my $paramsH = $dbh->ora_nls_parameters(); $out = sprintf "Database $ora_server_version CHAR set is %s (%s), NCHAR set is %s (%s)\n", $paramsH->{NLS_CHARACTERSET}, db_ochar_is_utf($dbh) ? "Unicode" : "Non-Unicode", $paramsH->{NLS_NCHAR_CHARACTERSET}, db_nchar_is_utf($dbh) ? "Unicode" : "Non-Unicode"; note($out); my $ora_client_version = ORA_OCI(); $out = sprintf "Client $ora_client_version NLS_LANG is '%s', NLS_NCHAR is '%s'\n", ora_env_var("NLS_LANG") || "", ora_env_var("NLS_NCHAR") || ""; note($out); } sub db_ochar_is_utf { return shift->ora_can_unicode & 2 } sub db_nchar_is_utf { return shift->ora_can_unicode & 1 } sub client_ochar_is_utf8 { my $NLS_LANG = ora_env_var("NLS_LANG") || ''; $NLS_LANG =~ s/.*\.//; return $NLS_LANG =~ m/utf8/i; } sub client_nchar_is_utf8 { my $NLS_LANG = ora_env_var("NLS_LANG") || ''; $NLS_LANG =~ s/.*\.//; my $NLS_NCHAR = ora_env_var("NLS_NCHAR") || $NLS_LANG; return $NLS_NCHAR =~ m/utf8/i; } sub nls_local_has_utf8 { return client_ochar_is_utf8() || client_nchar_is_utf8(); } sub set_nls_nchar { my ($cset,$verbose) = @_; if ( defined $cset ) { $ENV{NLS_NCHAR} = "$cset" } else { undef $ENV{NLS_NCHAR}; # XXX windows? (perhaps $ENV{NLS_NCHAR}=""?) } # Special treatment for environment variables under Cygwin - # see comments in dbdimp.c for details. DBD::Oracle::ora_cygwin_set_env('NLS_NCHAR', $ENV{NLS_NCHAR}||'') if $^O eq 'cygwin'; note(defined ora_env_var("NLS_NCHAR") ? # defined? "set \$ENV{NLS_NCHAR}=$cset\n" : "set \$ENV{NLS_LANG}=undef\n") # XXX ? if defined $verbose; } sub set_nls_lang_charset { my ($lang,$verbose) = @_; $ENV{NLS_LANG} = $lang ? "AMERICAN_AMERICA.$lang" : ''; note "set \$ENV{NLS_LANG='$ENV{NLS_LANG}'"; # Special treatment for environment variables under Cygwin - # see comments in dbdimp.c for details. DBD::Oracle::ora_cygwin_set_env('NLS_LANG', $ENV{NLS_LANG}||'') if $^O eq 'cygwin'; } sub byte_string { my $ret = join( "|" ,unpack( "C*" ,$_[0] ) ); return $ret; } sub nice_string { my @raw_chars = (utf8::is_utf8($_[0])) ? unpack("U*", $_[0]) # unpack unicode characters : unpack("C*", $_[0]); # not unicode, so unpack as bytes my @chars = map { $_ > 255 ? # if wide character... sprintf("\\x{%04X}", $_) : # \x{...} chr($_) =~ /[[:cntrl:]]/ ? # else if control character ... sprintf("\\x%02X", $_) : # \x.. chr($_) # else as themselves } @raw_chars; foreach my $c ( @chars ) { if ( $c =~ m/\\x\{08(..)}/ ) { $c .= "='" .chr(hex($1)) ."'"; } } my $ret = join("",@chars); } sub view_with_sqlplus { my ( $use_nls_lang ,$tdata ) = @_ ; my $table = table(); my $tcols = $tdata->{cols}; my $sqlfile = "sql.txt" ; my $cols = 'idx,nch_col' ; open F , ">$sqlfile" or die "could open $sqlfile"; print F $ENV{ORACLE_USERID} ."\n"; my $str = qq( col idx form 99 col ch_col form a8 col nch_col form a16 select $cols from $table; ) ; print F $str; print F "exit;\n" ; close F; my $nls='unset'; $nls = ora_env_var("NLS_LANG") if ora_env_var("NLS_LANG"); local $ENV{NLS_LANG} = '' if not $use_nls_lang; print "From sqlplus...$str\n ...with NLS_LANG = $nls\n" ; system( "sqlplus -s \@$sqlfile" ); unlink $sqlfile; } 1; DBD-Oracle-1.74/t/23wide_db_8bit.t0000644000175000017500000000254712326332111015701 0ustar yanickyanick#!perl -w #written by Lincoln A Baxter (lab@lincolnbaxter.com) use strict; #use warnings; use Test::More; use DBI qw(:sql_types); use DBD::Oracle qw( :ora_types ORA_OCI SQLCS_NCHAR ); unshift @INC ,'t'; require 'nchar_test_lib.pl'; my $dbh; $| = 1; SKIP: { plan skip_all => "Unable to run unicode test, perl version is less than 5.6" unless ( $] >= 5.006 ); plan skip_all => "Oracle charset tests unreliable for Oracle 8 client" if ORA_OCI() < 9.0 and !$ENV{DBD_ALL_TESTS}; set_nls_lang_charset( 'WE8MSWIN1252' ,1 ); $dbh = db_handle(); plan skip_all => "Unable to connect to Oracle" if not $dbh; plan skip_all => "Database character set is not Unicode" if not db_ochar_is_utf($dbh) ; print "testing utf8 with char columns (wide mode database)\n" ; my $tdata = test_data( 'narrow_char' ); my $testcount = 0 #create table + insert_test_count( $tdata ) + select_test_count( $tdata ) * 1; ; plan tests => $testcount; show_test_data( $tdata ,0 ); drop_table($dbh); create_table( $dbh, $tdata ); insert_rows( $dbh, $tdata ,SQLCS_NCHAR); dump_table( $dbh ,'ch' ,'descr' ); select_rows( $dbh, $tdata ); } END { local($?, $!); eval { local $dbh->{PrintError} = 0 if $dbh; drop_table($dbh) if $dbh and not $ENV{'DBD_SKIP_TABLE_DROP'}; }; } DBD-Oracle-1.74/t/60reauth.t0000644000175000017500000000162212326332111014640 0ustar yanickyanick#!perl -w use Test::More; use DBI; unshift @INC ,'t'; require 'nchar_test_lib.pl'; $| = 1; my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; my $dbuser_2 = $ENV{ORACLE_USERID_2} || ''; if ($dbuser_2 eq '') { plan skip_all => "ORACLE_USERID_2 not defined.\n"; } # strip off @ on userid_2, as the reauth presumes current server $dbuser_2 =~ s/@.*//; (my $uid1 = uc $dbuser) =~ s:/.*::; (my $uid2 = uc $dbuser_2) =~ s:/.*::; if ($uid1 eq $uid2) { plan skip_all => "ORACLE_USERID_2 not unique.\n"; } my $dsn = oracle_test_dsn(); my $dbh = DBI->connect($dsn, $dbuser, ''); if ($dbh) { plan tests => 3; } else { plan skip_all => "Unable to connect to Oracle\n"; } is(($dbh->selectrow_array("SELECT USER FROM DUAL"))[0], $uid1, 'uid1' ); ok($dbh->func($dbuser_2, '', 'reauthenticate'), 'reauthenticate'); is(($dbh->selectrow_array("SELECT USER FROM DUAL"))[0], $uid2, 'uid2' ); $dbh->disconnect; DBD-Oracle-1.74/t/rt13865.t0000644000175000017500000000435412326332111014243 0ustar yanickyanick# $Id$ use strict; use DBI; use DBD::Oracle; use Test::More; use lib 't'; require 'nchar_test_lib.pl'; my $dbh = db_handle() or plan skip_all => "can't connect to database"; my %priv = map { $_ => 1 } get_privs( $dbh ); unless ( $priv{'CREATE TABLE'} ) { plan skip_all => q{requires permissions 'CREATE TABLE'}; } plan tests => 9; $dbh->do( 'DROP TABLE RT13865' ); $dbh->do( <<'END_SQL' ) or die $dbh->errstr; CREATE TABLE RT13865( COL_INTEGER INTEGER, COL_NUMBER NUMBER, COL_NUMBER_37 NUMBER(37), COL_DECIMAL NUMBER(9,2), COL_FLOAT FLOAT(126), COL_VC2 VARCHAR2(67), COL_VC2_69CHAR VARCHAR2(69 CHAR), COL_NVC2 NVARCHAR2(69), COL_NC NCHAR(69), COL_CHAR CHAR(67), COL_CHAR_69CHAR CHAR(69 CHAR) ) END_SQL my $col_h = $dbh->column_info( undef, undef, 'RT13865', 'COL_INTEGER' ); is $col_h->fetchrow_hashref->{COLUMN_SIZE} => 38, "INTEGER is alias for NUMBER(38)"; $col_h = $dbh->column_info( undef, undef, 'RT13865', 'COL_NUMBER_37' ); is $col_h->fetchrow_hashref->{COLUMN_SIZE} => 37, "NUMBER(37)"; $col_h = $dbh->column_info( undef, undef, 'RT13865', 'COL_NUMBER' ); cmp_ok $col_h->fetchrow_hashref->{COLUMN_SIZE}, '>', 0, "NUMBER"; $col_h = $dbh->column_info( undef, undef, 'RT13865', 'COL_VC2' ); is $col_h->fetchrow_hashref->{COLUMN_SIZE} => 67, "VARCHAR(67)"; $col_h = $dbh->column_info( undef, undef, 'RT13865', 'COL_VC2_69CHAR' ); is $col_h->fetchrow_hashref->{COLUMN_SIZE} => 69, "VARCHAR(69)"; $col_h = $dbh->column_info( undef, undef, 'RT13865', 'COL_NVC2' ); is $col_h->fetchrow_hashref->{COLUMN_SIZE} => 69, "NVARCHAR2(69)"; $col_h = $dbh->column_info( undef, undef, 'RT13865', 'COL_NC' ); is $col_h->fetchrow_hashref->{COLUMN_SIZE} => 69, "NCHAR(69)"; $col_h = $dbh->column_info( undef, undef, 'RT13865', 'COL_CHAR' ); is $col_h->fetchrow_hashref->{COLUMN_SIZE} => 67, "CHAR(67)"; $col_h = $dbh->column_info( undef, undef, 'RT13865', 'COL_CHAR_69CHAR' ); is $col_h->fetchrow_hashref->{COLUMN_SIZE} => 69, "CHAR(69)"; $dbh->do( 'DROP TABLE RT13865' ); # utility functions sub get_privs { my $dbh = shift; my $sth = $dbh->prepare( 'SELECT PRIVILEGE from session_privs' ); $sth->execute; return map { $_->[0] } @{ $sth->fetchall_arrayref }; } DBD-Oracle-1.74/t/25plsql.t0000644000175000017500000002512112326332111014504 0ustar yanickyanick#!perl -w use Test::More; use DBI; use DBD::Oracle qw(ORA_RSET SQLCS_NCHAR); use strict; unshift @INC ,'t'; require 'nchar_test_lib.pl'; $| = 1; my $dsn = oracle_test_dsn(); my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; my $dbh = DBI->connect($dsn, $dbuser, '', { PrintError => 0 }); if ($dbh) { # ORA-00900: invalid SQL statement # ORA-06553: PLS-213: package STANDARD not accessible my $tst = $dbh->prepare(q{declare foo char(50); begin RAISE INVALID_NUMBER; end;}); if ($dbh->err && ($dbh->err==900 || $dbh->err==6553 || $dbh->err==600)) { diag("Your Oracle server doesn't support PL/SQL") if $dbh->err== 900; diag("Your Oracle PL/SQL is not properly installed") if $dbh->err==6553||$dbh->err==600; plan skip_all => 'Oracle server either does not support pl/sql or it is not properly installed'; } plan tests=>82; } else { plan skip_all => "Unable to connect to Oracle \n"; } my($csr, $p1, $p2, $tmp, @tmp); #DBI->trace(4,"trace.log"); # --- test raising predefined exception ok($csr = $dbh->prepare(q{ begin RAISE INVALID_NUMBER; end;}), 'prepare raising predefined exception'); # ORA-01722: invalid number ok(! $csr->execute, 'execute predefined exception'); is($DBI::err, 1722, 'err expected 1722 error'); is($DBI::err, 1722, 'err does not get cleared'); # --- test raising user defined exception ok($csr = $dbh->prepare(q{ DECLARE FOO EXCEPTION; begin raise FOO; end;}), 'prepare user defined expcetion'); # ORA-06510: PL/SQL: unhandled user-defined exception ok(! $csr->execute, 'execute user defined exception'); is($DBI::err, 6510, 'user exception 6510 error'); # --- test raise_application_error with literal values ok($csr = $dbh->prepare(q{ declare err_num number; err_msg char(510); begin RAISE_APPLICATION_ERROR(-20101,'app error'); end;}), 'prepare raise application error with literal values'); # ORA-20101: app error ok(! $csr->execute, 'execite raise application error with literal values'); is($DBI::err, 20101, 'expected 20101 error'); like($DBI::errstr, qr/app error/, 'app error'); # --- test raise_application_error with 'in' parameters ok($csr = $dbh->prepare(q{ declare err_num varchar2(555); err_msg varchar2(510); --declare err_num number; err_msg char(510); begin err_num := :1; err_msg := :2; raise_application_error(-20000-err_num, 'msg is '||err_msg); end; }), 'prepare raise application error with in params'); ok(! $csr->execute(42, "hello world"), 'execute raise application error with in params'); is($DBI::err, 20042, 'expected 20042 error'); like($DBI::errstr, qr/msg is hello world/, 'hello world msg'); # --- test named numeric in/out parameters ok($csr = $dbh->prepare(q{ begin :arg := :arg * :mult; end;}), 'prepare named numeric in/out params'); $p1 = 3; ok($csr->bind_param_inout(':arg', \$p1, 50), 'bind arg'); ok($csr->bind_param(':mult', 2), 'bind mult'); ok($csr->execute, 'execute named numeric in/out params'); is($p1, 6, 'expected 3 * 3 = 6'); # execute 10 times from $p1=1, 2, 4, 8, ... 1024 $p1 = 1; eval { foreach (1..10) { $csr->execute || die $DBI::errstr; }; }; my $ev = $@; ok(!$ev, 'execute named numeric in/out params 10 times'); is($p1, 1024, 'expected p1 = 1024'); # --- test undef parameters ok($csr = $dbh->prepare(q{ declare foo char(500); begin foo := :arg; end;}), 'prepare undef parameters'); my $undef; ok($csr->bind_param_inout(':arg', \$undef,10), 'bind arg'); ok($csr->execute, 'execute undef parameters'); # --- test named string in/out parameters ok($csr = $dbh->prepare(q{ declare str varchar2(1000); begin :arg := nvl(upper(:arg), 'null'); :arg := :arg || :append; end;}), 'prepare named string in/out parameters'); undef $p1; $p1 = "hello world"; ok($csr->bind_param_inout(':arg', \$p1, 1000), 'bind arg'); ok($csr->bind_param(':append', "!"), 'bind append'); ok($csr->execute, 'execute named string in/out parameters'); is($p1, "HELLO WORLD!", 'expected HELLO WORLD'); # execute 10 times growing $p1 to force realloc eval { foreach (1..10) { $p1 .= " xxxxxxxxxx"; $csr->execute || die $DBI::errstr; }; }; $ev = $@; ok(!$ev, 'execute named string in/out parameters 1- times'); my $expect = "HELLO WORLD!" . (" XXXXXXXXXX!" x 10); is($p1, $expect, 'p1 as expected'); # --- test binding a null and getting a string back undef $p1; ok($csr->execute, 'execute binding a null'); is($p1, 'null!', 'get a null string back'); $csr->finish; ok($csr = $dbh->prepare(q{ begin :out := nvl(upper(:in), 'null'); end;}), 'prepare nvl'); #$csr->trace(3); my $out; ok($csr->bind_param_inout(':out', \$out, 1000), 'bind out'); ok($csr->bind_param(':in', "foo", DBI::SQL_CHAR()), 'bind in'); ok($csr->execute, 'execute nvl'); is($out, "FOO", 'expected FOO'); ok($csr->bind_param(':in', ""), 'bind empty string'); ok($csr->execute, 'execute empty string'); is($out, "null", 'returned null string'); # --- test out buffer being too small ok($csr = $dbh->prepare(q{ begin select rpad('foo',200) into :arg from dual; end;}), 'prepare test output buffer too small'); #$csr->trace(3); undef $p1; # force buffer to be freed ok($csr->bind_param_inout(':arg', \$p1, 20), 'bind arg'); # Execute fails with: # ORA-06502: PL/SQL: numeric or value error # ORA-06512: at line 3 (DBD ERROR: OCIStmtExecute) $tmp = $csr->execute; #$tmp = undef if DBD::Oracle::ORA_OCI()>=8; # because BindByName given huge max len ok(!defined $tmp, 'output buffer too small'); # rebind with more space - and it should work ok($csr->bind_param_inout(':arg', \$p1, 200), 'rebind arg with more space'); ok($csr->execute, 'execute rebind with more space'); is(length($p1), 200, 'expected return length'); # --- test plsql_errstr function #$csr = $dbh->prepare(q{ # create or replace procedure perl_dbd_oracle_test as # begin # procedure filltab( stuff out tab ); asdf # end; #}); #ok(0, ! $csr); #if ($dbh->err && $dbh->err == 6550) { # PL/SQL error # warn "errstr: ".$dbh->errstr; # my $msg = $dbh->func('plsql_errstr'); # warn "plsql_errstr: $msg"; # ok(0, $msg =~ /Encountered the symbol/, "plsql_errstr: $msg"); #} #else { # warn "plsql_errstr test skipped ($DBI::err)\n"; # ok(0, 1); #} #die; # --- test dbms_output_* functions $dbh->{PrintError} = 1; ok($dbh->func(30000, 'dbms_output_enable'), 'dbms_output_enable'); #$dbh->trace(3); my @ary = ("foo", ("bar" x 15), "baz", "boo"); ok($dbh->func(@ary, 'dbms_output_put'), 'dbms_output_put'); @ary = scalar $dbh->func('dbms_output_get'); # scalar context ok(@ary==1 && $ary[0] && $ary[0] eq 'foo', 'dbms_output_get foo'); @ary = scalar $dbh->func('dbms_output_get'); # scalar context ok(@ary==1 && $ary[0] && $ary[0] eq 'bar' x 15, 'dbms_output_get bar'); @ary = $dbh->func('dbms_output_get'); # list context is(join(':',@ary), 'baz:boo', 'dbms_output_get baz:boo'); $dbh->{PrintError} = 0; #$dbh->trace(0); # --- test cursor variables if (1) { my $cur_query = q{ SELECT object_name, owner FROM all_objects WHERE object_name LIKE :p1 ORDER BY object_name }; my $cur1 = 42; #$dbh->trace(4); my $parent = $dbh->prepare(qq{ BEGIN OPEN :cur1 FOR $cur_query; END; }); ok($parent, 'prepare cursor'); ok($parent->bind_param(":p1", "V%"), 'bind p1'); ok($parent->bind_param_inout( ":cur1", \$cur1, 0, { ora_type => ORA_RSET }), 'bind cursor'); ok($parent->execute(), 'execute for cursor'); my @r; push @r, @tmp while @tmp = $cur1->fetchrow_array; ok(@r>0, "rows: ".@r); #$dbh->trace(0); $parent->trace(0); # compare results with normal execution of query my $s1 = $dbh->selectall_arrayref($cur_query, undef, "V%"); my @s1 = map { @$_ } @$s1; is("@r", "@s1", "ref = sql"); # --- test re-bind and re-execute of same 'parent' statement my $cur1_str = "$cur1"; #$dbh->trace(4); $parent->trace(4); ok($parent->bind_param(":p1", "U%"), 'bind p1'); ok($parent->execute(), 'execute for cursor'); # must be ref to new handle object isnt("$cur1", $cur1_str, 'expected ref to new handle'); @r = (); push @r, @tmp while @tmp = $cur1->fetchrow_array; #$dbh->trace(0); $parent->trace(0); $cur1->trace(0); my $s2 = $dbh->selectall_arrayref($cur_query, undef, "U%"); my @s2 = map { @$_ } @$s2; is("@r", "@s2", "ref = sql"); } # test bind_param_inout of param that's not assigned to in executed statement # See http://www.mail-archive.com/dbi-users@perl.org/msg18835.html my $sth = $dbh->prepare (q( BEGIN -- :p1 := :p1 ; -- :p2 := :p2 ; IF :p2 != :p3 THEN :p1 := 'AAA' ; :p2 := 'Z' ; END IF ; END ;)); { my ($p1, $p2, $p3) = ('Hello', 'Y', 'Y') ; $sth->bind_param_inout(':p1', \$p1, 30) ; $sth->bind_param_inout(':p2', \$p2, 1) ; $sth->bind_param_inout(':p3', \$p3, 1) ; note("Before p1=[$p1] p2=[$p2] p3=[$p3]\n"); ok($sth->execute, 'test bind_param_inout for non assigned'); is($p1, 'Hello', 'p1 ok'); is($p2, 'Y', 'p2 ok'); is($p3, 'Y', 'p3 ok'); note("After p1=[$p1] p2=[$p2] p3=[$p3]\n"); } SKIP: { # test nvarchar2 arg passing to functions # http://www.nntp.perl.org/group/perl.dbi.users/24217 my $ora_server_version = $dbh->func("ora_server_version"); skip "Client/server version < 9.0", 15 if DBD::Oracle::ORA_OCI() < 9.0 || $ora_server_version->[0] < 9; my $func_name = "dbd_oracle_nvctest".($ENV{DBD_ORACLE_SEQ}||''); $dbh->do(qq{ CREATE OR REPLACE FUNCTION $func_name(arg nvarchar2, arg2 nvarchar2) RETURN int IS BEGIN if arg is null or arg2 is null then return -1; else return 1; end if; END; }) or skip "Can't create a function ($DBI::errstr)", 15; my $sth = $dbh->prepare(qq{SELECT $func_name(?, ?) FROM DUAL}, { # Oracle 8 describe fails with ORA-06553: PLS-561: charset mismatch ora_check_sql => 0, }); ok($sth, sprintf("Can't prepare select from function (%s)",$DBI::errstr||'')); skip "Can't select from function ($DBI::errstr)", 14 unless $sth; for (1..2) { ok($sth->bind_param(1, "foo", { ora_csform => SQLCS_NCHAR }), 'bind foo'); ok($sth->bind_param(2, "bar", { ora_csform => SQLCS_NCHAR }), 'bind bar'); ok($sth->execute(), 'execute'); ok(my($returnVal) = $sth->fetchrow_array, 'fetchrow returns value'); is($returnVal, "1", 'expected return value of 1'); } ok($sth->execute("baz",undef), 'execute with baz'); ok(my($returnVal) = $sth->fetchrow_array, 'fetchrow_returns value'); is($returnVal, "-1", 'expected -1 return'); ok($dbh->do(qq{drop function $func_name}), "drop $func_name"); } # --- To do # test NULLs at first bind # NULLs later binds. # returning NULLs # multiple params, mixed types and in only vs inout exit 0; __END__ DBD-Oracle-1.74/examples/0000775000175000017500000000000012326332111014371 5ustar yanickyanickDBD-Oracle-1.74/examples/japh0000755000175000017500000000236012326332111015240 0ustar yanickyanick#!/usr/bin/perl -w # This is an example of how we could code a JAPH using DBI and DBD::Oracle. # # Original oraperl script by Kevin Stock # Date: 1st December 1992 use DBI; use strict; # Set trace level if '-# trace_level' option is given DBI->trace( shift ) if 1 < @ARGV && $ARGV[0] =~ /^-#/ && shift; die "syntax: $0 [-# trace] base user pass" if 3 > @ARGV; my ( $inst, $user, $pass ) = @ARGV; # Connect to database my $dbh = DBI->connect( "dbi:Oracle:$inst", $user, $pass, { AutoCommit => 0, RaiseError => 1, PrintError => 0 } ) or die $DBI::errstr; # Create the sample table $dbh->do( "CREATE TABLE japh ( word CHAR(7), posn NUMBER(1) )" ); # Loop to insert data into the table my $sth = $dbh->prepare( "INSERT INTO japh VALUES ( ?, ? )" ); while ( ) { chomp; $sth->execute( split ':', $_ ); } # Now retrieve the data, printing it word by word $sth = $dbh->prepare( "SELECT word FROM japh ORDER BY posn" ); $sth->execute; my $word; $sth->bind_columns( {}, \$word ); $sth->{ChopBlanks} = 1; # Wouldn't you rather use VARCHAR2 instead of CHAR? while ( $sth->fetch ) { print " $word"; } $sth->finish; print "\n"; # delete the table $dbh->do( 'DROP TABLE japh' ); $dbh->disconnect; __END__ DBI:3 another:2 hacker:4 just:1 DBD-Oracle-1.74/examples/oradump.pl0000755000175000017500000000230712326332111016400 0ustar yanickyanick#!/usr/bin/env perl # # Dump the contents of an Oracle table into a set of insert statements. # Quoting is controlled by the datatypes of each column. (new with DBI) # # Usage: oradump # # Author: Kevin Stock (original oraperl script) # Date: 28th February 1992 # use DBI; use strict; # Set trace level if '-# trace_level' option is given DBI->trace( shift ) if 1 < @ARGV && $ARGV[0] =~ /^-#/ && shift; die "syntax: $0 base user pass table\n" if 4 > @ARGV; my ( $base, $user, $pass, $table ) = @ARGV; # Connect to database my $dbh = DBI->connect( "dbi:Oracle:$base", $user, $pass, { AutoCommit => 0, RaiseError => 1, PrintError => 0 } ) or die $DBI::errstr; my $sth = $dbh->prepare( "SELECT * FROM $table"); $sth->execute; my @name = @{$sth->{NAME}}; my @type = @{$sth->{TYPE}}; my $lead = "INSERT INTO $table ( " . join( ', ', @name ) . " ) VALUES ( "; my ( @data, $i ); $sth->bind_columns( {}, \( @data[0 .. $#name] ) ); while ( $sth->fetch ) { $i = 0; print $lead . join( ", ", map { $dbh->quote( $_, $type[$i++] ) } @data ) . # print $lead . join( ", ", map { $dbh->quote( $_ ) } @data ) . # for old DBI " );\n"; } $sth->finish; $dbh->disconnect; DBD-Oracle-1.74/examples/ora_explain.pl0000644000175000017500000016704212326332111017237 0ustar yanickyanick#!/usr/bin/env perl ################################################################################ # Copyright (c) 1999 Alan Burlison # # You may distribute under the terms of either the GNU General Public License # or the Artistic License, as specified in the Perl README file. # # This code is provided with no warranty of any kind, and is used entirely at # your own risk. # # This code was written by the author as a private individual, and is in no way # endorsed or warrantied by Sun Microsystems. # # Support questions and suggestions can be directed to Alan.Burlison@uk.sun.com # ################################################################################ use strict; use warnings; use File::Basename; use DBI; use Tk; use Tk::Balloon; use Tk::ErrorDialog; use Tk::ROText; ################################################################################ # Subclassed version of Tk::Tree that allows button3 to have a callback attached package Tk::B3Tree; use strict; use base qw(Tk::Tree); Construct Tk::Widget qw(B3Tree); sub ClassInit { my ($class, $mw) = @_; $class->SUPER::ClassInit($mw); $mw->bind($class, "<3>", "Button3"); return $class; } sub Populate { my ($self, $args) = @_; $self->SUPER::Populate($args); $self->ConfigSpecs(-b3command => [ "CALLBACK", "b3command", "B3command", undef ]); } sub Button3 { my $w = shift; my $Ev = $w->XEvent; my $ent = $w->GetNearest($Ev->y); return unless (defined($ent) and length($ent)); $w->Callback(-b3command => $ent); } ################################################################################ package main; use vars qw($VERSION); $VERSION = "1.1"; # Globals # $ProgName Program name (without pathname) # $Db Database handle # $DbName Oracle database name # $User Oracle user name # $Schema Oracle schema name # $SqlMarker String used to identify SQL generated by explain # $OracleVersion Oracle version number # $CharWidth Width of a character in pixels # $Plan Current query plan as a Perl data structure # $LoginDialog Login dialog # $SchemaDialog Schema dialog # $SaveDialog Save File dialog # $OpenDialog Open File dialog # $FileDir Current file save/open directory # $PlanMain Query plan main window # $PlanTitle Title of query plan main window # $PlanTree Tree used to display the query plan # $PlanStep ROText used to display the selected plan step details # $PlanSql Text used to allow SQL editing # $Balloon For balloon help # $GrabMain SQL cache grab main window # $GrabStatus Text label used for feedback/status info # $GrabSelection Tag of currently selected SQL statement in the SQL cache # $GrabSql ROText used to hold the contents of the SQL cache # $GrabDetails ROText used to display the selected statement details use vars qw($ProgName $Db $DbName $User $Schema $SqlMarker $OracleVersion $CharWidth $Plan $LoginDialog $SchemaDialog $OpenDialog $SaveDialog $FileDir $PlanMain $PlanTitle $PlanTree $PlanStep $PlanSql $Balloon $GrabMain $GrabStatus $GrabSelection $GrabSql $GrabDetails); $SqlMarker = "/* This statement was generated by explain */"; ################################################################################ # Switch the hourglass on or off sub busy($) { my ($state) = @_; if ($state && $PlanMain->grabCurrent()) { $PlanMain->Busy(-recurse => 1); } else { $PlanMain->Unbusy(1); } } ################################################################################ # Display an error message in a dialog sub error($@) { my ($parent, @lines) = @_; my ($msg, $height, $width); $msg = join("\n", @lines); $msg =~ s/\n$//; $msg =~ s/ \(DBD:/\n(DBD:/; $msg =~ s/(indicator at char \d+ in) /$1\n/; @lines = split("\n", $msg); $height = @lines; $width = 0; foreach my $line (@lines) { my $l = length($line); $width = $l if ($l > $width); } $width = 80 if ($width > 80); $height = 4 if ($height < 4); $height = 10 if ($height > 10); busy(0); my $dialog = $PlanMain->Toplevel(-title => "Error"); $dialog->withdraw(); my $text = $dialog->Scrolled("ROText", -height => $height, -width => $width, -borderwidth => 3, -relief => "raised", -wrap => "word", -scrollbars => "oe") ->pack(-padx => 6, -pady => 6, -expand => 1, -fill => "both"); $text->insert("1.0", $msg); my $ok_cb = sub { $dialog->destroy() }; $dialog->Button(-text => "OK", -default => "active", -command => $ok_cb) ->pack(-padx => 6, -pady => 6); $dialog->bind("", $ok_cb); $dialog->Popup; } ################################################################################ sub about($;$) { my ($parent, $win) = @_; my $msg = <Toplevel(-title => "About $ProgName"); $dialog->withdraw(); $dialog->resizable(0, 0); my $text = $dialog->Text(-borderwidth => 3, -width => 80, -height => 16, -relief => "raised") ->pack(-padx => 6, -pady => 6); $text->insert("1.0", $msg); my $cb; if ($win) { $$win = $dialog; $cb = sub { $dialog->destroy(); undef($$win); }; } else { $cb = sub { $dialog->destroy(); }; } $dialog->Button(-text => "OK", -command => $cb)->pack(-padx => 6, -pady => 6); $dialog->Popup(); return($dialog); } ################################################################################ sub update_title() { $PlanMain->configure(-title => $User ? $User eq $Schema ? "$ProgName - connected to $DbName as $User" : "$ProgName - connected to $DbName as $User [schema $Schema]" : "$ProgName - not connected" ); } ################################################################################ sub help($) { my ($parent) = @_; require Tk::Pod; $parent->Pod(-file => $0, -scrollbars => "e"); } ################################################################################ # Login to the database. The new database handle is put into $Db, and the # Oracle version number is put into $OracleVersion sub login($$$) { my ($database, $username, $password) = @_; busy(1); # Close any existing handle if ($Db) { $Db->disconnect(); $Db = undef; $DbName = $User = $Schema = undef; update_title(); } # Connect and initialise $Db = DBI->connect("dbi:Oracle:$database", $username, $password, { AutoCommit => 0, PrintError => 0}) || die("Can't login to Oracle:\n$DBI::errstr\n"); $Db->{LongReadLen} = 4096; $Db->{LongTruncOk} = 1; # Get the user name and check the Oracle version my $qry = $Db->prepare(qq( $SqlMarker select user, version from product_component_version where lower(product) like '%oracle%' )); if (! $qry->execute()) { my $err = $DBI::errstr; $qry->finish(); $Db->disconnect(); $Db = undef; die("Can't fetch Oracle version:\n$err\n"); } ($User, $OracleVersion) = $qry->fetchrow_array(); $qry->finish(); $DbName = $database || $ENV{TWO_TASK} || $ENV{ORACLE_SID}; $Schema = $User; # Check there is a plan_table for this user $qry = $Db->prepare(qq( $SqlMarker select 1 from user_tables where table_name = 'PLAN_TABLE' )); $qry->execute(); if (! $qry->fetchrow_arrayref()) { $qry->finish(); $Db->disconnect(); $Db = undef; die("User $User does not have a PLAN_TABLE.\n", "Run the script utlxplan.sql to create one.\n"); } busy(0); return(1); } ################################################################################ # Clear the plan tree & details windows sub clear_plan() { $PlanTitle->configure(-text => "Query Plan") if ($PlanTitle); $PlanTree->delete("all") if ($PlanTree); $PlanStep->delete("1.0", "end") if ($PlanStep); } ################################################################################ # Clear the SQL editor pane sub clear_editor() { $PlanTitle->configure(-text => "Query Plan") if ($PlanTitle); $PlanTree->delete("all") if ($PlanTree); $PlanStep->delete("1.0", "end") if ($PlanStep); $PlanSql->delete("1.0", "end"); } ################################################################################ # Display the structure of an index sub disp_index($$) { my ($owner, $index) = @_; # Create the index definition frame busy(1); my $dialog = $PlanMain->Toplevel(-title => "Index"); $dialog->withdraw(); $dialog->resizable(0, 0); my $index_fr = $dialog->Frame(-borderwidth => 3, -relief => "raised"); $index_fr->Label(-text => "$owner.$index", -relief => "ridge", -borderwidth => 1) ->grid(-column => 0, -row => 0, -columnspan => 2, -sticky => "we", -ipadx => 3); $index_fr->Label(-text => "Table", -relief => "ridge", -borderwidth => 1) ->grid(-column => 0, -row => 1, -sticky => "we", -ipadx => 3); $index_fr->Label(-text => "Column", -relief => "ridge", -borderwidth => 1) ->grid(-column => 1, -row => 1, -sticky => "we", -ipadx => 3); # Show the table columns the index is built upon my $qry = $Db->prepare(qq( $SqlMarker select table_owner, table_name, column_name from all_ind_columns where index_owner = :1 and index_name = :2 order by column_position )); $qry->execute($owner, $index) || die("Index columns:\n$DBI::errstr\n"); # For each column in the index, display its details my ($tab_txt, $col_txt); while ((my ($tab_owner, $table, $column) = $qry->fetchrow_array())) { $tab_txt .= "$tab_owner.$table\n"; $col_txt .= "$column\n"; } $qry->finish(); chop($tab_txt, $col_txt); $index_fr->Label(-text => $tab_txt, -relief => "ridge", -borderwidth => 1, -justify => "left") ->grid(-column => 0, -row => 2, -sticky => "we", -ipadx => 3); $index_fr->Label(-text => $col_txt, -relief => "ridge", -borderwidth => 1, -justify => "left") ->grid(-column => 1, -row => 2, -sticky => "we", -ipadx => 3); $index_fr->pack(-side => "top", -fill => "x"); # Pack the grid and add the close button $dialog->Button(-text => "Close", -command => sub { $dialog->destroy(); }) ->pack(-padx => 6, -pady => 6); $dialog->Popup(); busy(0); return(1); } ################################################################################ # Callback for adding/removing index definitions to a table dialog sub disp_table_cb($$$$$) { my ($owner, $table, $num_cols, $index_fr, $index_bn) = @_; # If this is the first time through, fetch the index definitions busy(1); if (! $index_fr->children()) { # This will retrieve the names & owners of all the indexes on the table my $qry = $Db->prepare(qq( $SqlMarker select owner, index_name from all_indexes where table_owner = :1 and table_name = :2 order by owner, index_name )); # Build up a list of all the indexes $qry->execute($owner, $table) || die("Table indexes:\n$DBI::errstr\n"); my (@indexes, $ind_owner, $ind_name); while (($ind_owner, $ind_name) = $qry->fetchrow_array()) { push(@indexes, { owner => $ind_owner, name => $ind_name }); } $qry->finish(); # Special for no indexes if (@indexes == 0) { $index_fr->Label(-text => "No\nindexes\ndefined", -relief => "ridge", -borderwidth => 1)->pack(-ipadx => 3, -ipady => 4); } else { # Do the header label $index_fr->Label(-text => "Index\norder", -relief => "ridge", -borderwidth => 1) ->grid(-column => 0, -row => 0, -sticky => "we", -ipadx => 3, -ipady => 2, -columnspan => scalar(@indexes), -rowspan => 2); # This will retrieve (table column id, index position) for an index $qry = $Db->prepare(qq( $SqlMarker select atc.column_id, aic.column_position from all_tab_columns atc, all_ind_columns aic where aic.index_owner = :1 and aic.index_name = :2 and atc.owner = aic.table_owner and atc.table_name = aic.table_name and atc.column_name = aic.column_name order by aic.index_name, atc.column_id )); # For each index, add a label describing the index my $cb = sub { disp_index($_[1], $_[2]); }; my $grid_col = 0; foreach my $index (@indexes) { ($ind_owner, $ind_name) = @{$index}{qw(owner name)}; $qry->execute($ind_owner, $ind_name) || die("Index columns:\n$DBI::errstr\n"); my $index_txt; my $col = 1; while (my ($col_id, $col_pos) = $qry->fetchrow_array()) { $index_txt .= "\n" x ($col_id - $col) . "$col_pos\n"; $col = $col_id + 1; } $index_txt .= "\n" x ($num_cols - ($col - 1)); chop($index_txt); my $label = $index_fr->Label(-text => $index_txt, -relief => "ridge", -borderwidth => 1, -justify => "left") ->grid(-column => $grid_col, -row => 2, -sticky => "w", -ipadx => 3); $label->bind("<1>", [ $cb, $ind_owner, $ind_name ]); $Balloon->attach($label, -msg => "$ind_owner.$ind_name", -balloonposition => "mouse"); $grid_col++; } } } if ($index_bn->cget(-text) eq "Indexes") { $index_bn->configure(-text => "Hide Indexes"); $index_fr->pack(-side => "right", -expand => 1); } else { $index_bn->configure(-text => "Indexes"); $index_fr->packForget(); } busy(0); return(1); } ################################################################################ # Display a popup dialog showing the structure of a table sub disp_table($$) { my ($owner, $table) = @_; # Create the dialog for displaying the object details busy(1); my $dialog = $PlanMain->Toplevel(-title => "Table"); $dialog->withdraw(); $dialog->resizable(0, 0); # Create the table definition frame my $box1 = $dialog->Frame(-borderwidth => 3, -relief => "raised"); my $box2 = $box1->Frame(-borderwidth => 0); my $table_fr = $box2->Frame(-borderwidth => 1, -relief => "flat"); $table_fr->Label(-text => "$owner.$table", -relief => "ridge", -borderwidth => 1) ->grid(-column => 0, -row => 0, -columnspan => 2, -sticky => "we"); $table_fr->Label(-text => "Name", -relief => "ridge", -borderwidth => 1) ->grid(-column => 0, -row => 1, -sticky => "we", -ipadx => 3); $table_fr->Label(-text => "Type", -relief => "ridge", -borderwidth => 1) ->grid(-column => 1, -row => 1, -sticky => "we", -ipadx => 3); # This will get the table description my $qry = $Db->prepare(qq( $SqlMarker select column_name, data_type, data_length, data_precision, data_scale from all_tab_columns where owner = :1 and table_name = :2 order by column_id )); $qry->execute($owner, $table) || die("Table columns:\n$DBI::errstr\n"); my ($num_cols, $name_txt, $type_txt); while ((my ($name, $type, $length, $precision, $scale) = $qry->fetchrow_array())) { if ($precision) { $type .= "($precision"; $type .= ",$scale" if ($scale); $type .= ")"; } elsif ($type =~ /CHAR/) { $type .= "($length)"; } $name_txt .= "$name\n"; $type_txt .= "$type\n"; $num_cols++; } $qry->finish(); chop($name_txt, $type_txt); $table_fr->Label(-text => $name_txt, -relief => "ridge", -borderwidth => 1, -justify => "left") ->grid(-column => 0, -row => 2, -sticky => "we", -ipadx => 3); $table_fr->Label(-text => $type_txt, -relief => "ridge", -borderwidth => 1, -justify => "left") ->grid(-column => 1, -row => 2, -sticky => "we", -ipadx => 3); $table_fr->pack(-side => "left"); # Now create a frame for the index definition & pack the whole lot my $index_fr = $box2->Frame(-borderwidth => 1, -relief => "flat"); $box2->pack(); $box1->pack(-side => "top", -fill => "x", -expand => 1); # Create the buttons at the bottom $box1 = $dialog->Frame(-borderwidth => 0); $box1->Button(-text => "Close", -command => sub { $dialog->destroy(); }) ->pack(-padx => 6, -side => "left", -expand => 1); my $index_bn; $index_bn = $box1->Button(-text => "Indexes") ->pack(-padx => 6, -side => "left", -expand => 1); $index_bn->configure(-command => sub { disp_table_cb($owner, $table, $num_cols, $index_fr, $index_bn); }); $box1->pack(-side => "bottom", -pady => 6); $dialog->Popup(); busy(0); return(1); } ################################################################################ # Display the query plan tree sub disp_plan_tree() { $PlanTitle->configure(-text => $Plan->{title}); $PlanTree->delete("all"); my $steps = 0; foreach my $step (@{$Plan->{id}}) { my $item = $PlanTree->add($step->{key}, -text => $step->{desc}); $steps++; } $PlanTree->autosetmode(); if ($steps) { $PlanTree->selectionSet("1"); disp_plan_step("1"); } } ################################################################################ # Display the statistics for a given plan step sub disp_plan_step($) { my ($key) = @_; my $row = $Plan->{key}{$key}; $PlanStep->delete("1.0", "end"); my $info = ""; $info .= "Cost:\t\t$row->{COST}\t(Estimate of the cost of this step)\n" . "Cardinality:\t$row->{CARDINALITY}\t" . "(Estimated number of rows fetched by this step)\n" . "Bytes:\t\t$row->{BYTES}\t" . "(Estimated number of bytes fetched by this step)\n" if ($row->{COST}); $info .= "\nPartition\nStart:\t$row->{PARTITION_START}\tStop:\t\t" . "$row->{PARTITION_STOP}\tId:\t\t$row->{PARTITION_ID}\n" if ($row->{PARTITION_START}); $info .= "\nSQL used by Parallel Query Slave:\n$row->{OTHER}" if ($row->{OTHER}); $PlanStep->insert("1.0", $info); } ################################################################################ # Display a popup dialog showing the structure of the table or index used in # the passed plan step sub disp_plan_step_obj($) { my ($key) = @_; # Get the plan step & return if it doesn't refer to an object my $row = $Plan->{key}{$key}; return(1) if (! $row->{OBJECT_NAME}); # Work out the type of the object - table or index busy(1); my $qry = $Db->prepare(qq( $SqlMarker select object_type from all_objects where object_name = :1 and owner = :2 )); $qry->execute($row->{OBJECT_NAME}, $row->{OBJECT_OWNER}) || die("Object type:\n$DBI::errstr\n"); my ($object_type) = $qry->fetchrow_array(); $qry->finish(); busy(0); if ($object_type eq "TABLE") { disp_table($row->{OBJECT_OWNER}, $row->{OBJECT_NAME}); } elsif ($object_type eq "INDEX") { disp_index($row->{OBJECT_OWNER}, $row->{OBJECT_NAME}); } else { die("Unknown object type $object_type", "for $row->{OBJECT_OWNER}.$row->{OBJECT_NAME}\n"); } } ################################################################################ # Display a list of available indexes on a table, and display the selected # table definition sub disp_index_popup($) { my ($key) = @_; # Get the plan step & return if it doesn't refer to an object my $row = $Plan->{key}{$key}; return(1) if (! $row->{OBJECT_NAME}); # Work out the type of the object - table or index busy(1); my $qry = $Db->prepare(qq( $SqlMarker select object_type from all_objects where object_name = :1 and owner = :2 )); $qry->execute($row->{OBJECT_NAME}, $row->{OBJECT_OWNER}) || die("Object type:\n$DBI::errstr\n"); my ($object_type) = $qry->fetchrow_array(); $qry->finish(); if ($object_type ne "TABLE") { busy(0); return(1); } # Build the popup menu $qry = $Db->prepare(qq( $SqlMarker select owner, index_name from all_indexes where table_name = :1 and table_owner = :2 )); $qry->execute($row->{OBJECT_NAME}, $row->{OBJECT_OWNER}) || die("Table indexes:\n$DBI::errstr\n"); my $menu = $PlanMain->Menu(-tearoff => 0, -disabledforeground => "#000000"); $menu->command(-label => "Indexes", -state => "disabled"); $menu->separator(); my $count = 0; while ((my ($index_owner, $index_name) = $qry->fetchrow_array())) { $menu->command(-label => "$index_owner.$index_name", -command => [ \&disp_index, $index_owner, $index_name ]); $count++; } $qry->finish(); busy(0); $menu->Popup(-popover => "cursor", -popanchor => "nw") if ($count); return(1); } ################################################################################ # Produce the query plan for the SQL in $PlanSql and store it in $Plan sub _explain() { # Check there is some SQL my $stmt = $PlanSql->get("1.0", "end"); $stmt =~ s/;//g; die("You have not supplied any SQL\n") if ($stmt =~ /^\s*$/); # Check we are logged on die("You are not logged on to Oracle\n") if (! $Db); # Set up the various query strings # Note that for some reason you can't use bind variables in 'explain plan' my $prefix = "explain plan set statement_id = '$$' for\n"; my $plan_sql = qq( $SqlMarker select level, operation, options, object_node, object_owner, object_name, object_instance, object_type, id, parent_id, position, other); if ($OracleVersion ge "7.3") { $plan_sql .= qq(, cost, cardinality, bytes, other_tag) }; if ($OracleVersion ge "8") { $plan_sql .= qq(, partition_start, partition_stop, partition_id) }; $plan_sql .= qq( from plan_table where statement_id = :1 connect by prior id = parent_id and statement_id = :1 start with id = 0 and statement_id = :1 ); # Clean any old stuff from the plan_table busy(1); $Db->do(qq($SqlMarker delete from plan_table where statement_id = :1), undef, $$) || die("Delete from plan_table:\n$DBI::errstr\n"); $Db->commit(); # Switch schema if required if ($Schema ne $User) { $Db->do(qq($SqlMarker alter session set current_schema = $Schema)) || die("Cannot change schema to $Schema:\n$DBI::errstr\n"); } # Explain the plan - need to save message if failed! $Plan = { schema => $Schema, sql => $stmt }; my $fail; $fail = $DBI::errstr if (!$Db->do($prefix . $stmt)); # Switch back schema if required if ($Schema ne $User) { $Db->do(qq($SqlMarker alter session set current_schema = $User)) || die("Set current schema to $User:\n$DBI::errstr\n"); } # Now we can safely die if the exmplai plan failed die("Explain plan:\n$fail\n") if ($fail); # Read back the plan my $qry = $Db->prepare($plan_sql) || die("Unsupported PLAN_TABLE format:\n$DBI::errstr\n"); $qry->execute($$) || die("Read plan:\n$DBI::errstr\n"); while (my $row = $qry->fetchrow_hashref()) { if ($row->{ID} == 0) { $Plan->{title} = "Query Plan for " . lc($row->{OPERATION}); $Plan->{title} .= ". Cost = $row->{POSITION}" if ($row->{POSITION}); } else { # Line wrap the OTHER field $row->{OTHER} =~ s/((.{1,80})(\s+|,|$))/$1\n/g if ($row->{OTHER}); # Construct a descriptive string for the query step my $desc = "$row->{OPERATION}"; $desc .= " $row->{OPTIONS}" if ($row->{OPTIONS}); $desc .= " $row->{OBJECT_TYPE}" if ($row->{OBJECT_TYPE}); $desc .= " of $row->{OBJECT_OWNER}.$row->{OBJECT_NAME}" if ($row->{OBJECT_OWNER} && $row->{OBJECT_NAME}); $desc .= " using PQS $row->{OBJECT_NODE} $row->{OTHER_TAG}" if ($row->{OBJECT_NODE}); $row->{desc} = $desc; # Construct a hierarchical key for the query step if (! $row->{PARENT_ID}) { my $key = "$row->{POSITION}"; $row->{key} = $key; $Plan->{id}[$row->{ID} - 1] = $row; $Plan->{key}{$key} = $row; } else { my $parent = $Plan->{id}[$row->{PARENT_ID} - 1]; my $key = "$parent->{key}.$row->{POSITION}"; $row->{key} = $key; $Plan->{id}[$row->{ID} - 1] = $row; $Plan->{key}{$key} = $row; $parent->{child}[$row->{POSITION} - 1] = $row; } } } # Top of the tree is step 0 $Plan->{tree} = $Plan->{id}[0]; # Clean up $qry->finish(); $Db->do(qq($SqlMarker delete from plan_table where statement_id = :1), undef, $$); $Db->commit(); busy(0); return(1); } ################################################################################ # Wrapper for _explain - adds error handling sub explain { clear_plan(); if (! eval { _explain(); }) { error($PlanMain, $@); } else { disp_plan_tree(); } } ################################################################################ # Display a login dialog sub login_dialog($) { my ($parent) = @_; # Create the dialog if (! $LoginDialog) { my $username = "/"; my $password = ""; my $database = $ENV{TWO_TASK} || $ENV{ORACLE_SID}; $LoginDialog = $parent->Toplevel(-title => "Login to Oracle"); $LoginDialog->withdraw(); $LoginDialog->resizable(0, 0); my $box; # Create the entry labels & fields $box = $LoginDialog->Frame(-borderwidth => 1, -relief => "raised"); $box->Label(-text => "Username") ->grid(-column => 0, -row => 0, -sticky => "w"); $box->Entry(-textvariable => \$username, -width => 30) ->grid(-column => 1, -row => 0, -sticky => "w"); $box->Label(-text => "Password") ->grid(-column => 0, -row => 1, -sticky => "w"); $box->Entry(-textvariable => \$password, -width => 30, -show => "*") ->grid(-column => 1, -row => 1, -sticky => "w"); $box->Label(-text => "Database") ->grid(-column => 0, -row => 2, -sticky => "w"); $box->Entry(-textvariable => \$database, -width => 30) ->grid(-column => 1, -row => 2, -sticky => "w"); $box->pack(-expand => 1, -fill => "both", -ipadx => 6, -ipady => 6); # Create the buttons & callbacks $box = $LoginDialog->Frame(-borderwidth => 1, -relief => "raised"); my $cb = sub { if (! eval { login($database, $username, $password); }) { error($parent, $@); $LoginDialog->raise($parent); } else { update_title(); $LoginDialog->withdraw(); } }; $box->Button(-text => "Login", -default => "active", -command => $cb) ->pack(-side => "left", -expand => 1, -pady => 6); $box->Button(-text => "Cancel", -command => sub { $LoginDialog->withdraw() }) ->pack(-side => "right", -expand => 1, -pady => 6); $box->pack(-expand => 1, -fill => "both"); $LoginDialog->bind("", $cb); } # Activate the dialog $LoginDialog->Popup(); } ################################################################################ sub schema_dialog($) { my ($parent) = @_; if (! $Db) { error($parent, "You are not logged on to Oracle\n"); return; } # Create the dialog if (! $SchemaDialog) { $SchemaDialog = $parent->Toplevel(-title => "Change Schema"); $SchemaDialog->withdraw(); $SchemaDialog->resizable(0, 0); my ($box, $schema); # Create the entry labels & fields $box = $SchemaDialog->Frame(-borderwidth => 1, -relief => "raised"); $box->Label(-text => "Schema") ->pack(-side => "left", -anchor => "e", -expand => 1); $box->Entry(-textvariable => \$schema, -width => 30) ->pack(-side => "right", -anchor => "w", -expand => 1); $box->pack(-expand => 1, -fill => "both", -ipadx => 6, -ipady => 6); # Create the buttons & callbacks $box = $SchemaDialog->Frame(-borderwidth => 1, -relief => "raised"); my $cb = sub { # Try changing to the specified schema $schema = uc($schema); if (! $Db->do(qq($SqlMarker alter session set current_schema = $schema))) { error($parent, "Cannot change schema to $schema:", $DBI::errstr); $SchemaDialog->raise($parent); } else { # Change back to the user's schema $Db->do(qq($SqlMarker alter session set current_schema = $User)) || die("Cannot change schema to $User\n$DBI::errstr"); $Schema = $schema; update_title(); $SchemaDialog->withdraw(); } }; $box->Button(-text => "Default", -command => sub { $schema = $User; }) ->pack(-side => "left", -expand => 1, -pady => 6); $box->Button(-text => "Apply", -default => "active", -command => $cb) ->pack(-side => "left", -expand => 1, -pady => 6); $box->Button(-text => "Cancel", -command => sub { $SchemaDialog->withdraw() }) ->pack(-side => "left", -expand => 1, -pady => 6); $box->pack(-expand => 1, -fill => "both"); $SchemaDialog->bind("", $cb); } # Activate the dialog $SchemaDialog->Popup(); } ################################################################################ # Open a file and read it into the SQL editor frame sub open_file($) { # Open the file my ($file) = @_; use IO::File; my $fh; if (! ($fh = IO::File->new($file, "r"))) { error($PlanMain, "Cannot open $file:\n", $!); return(0); } # Clear the plan, plan details & SQL editor, then load into the SQL editor clear_editor(); while (my $line = $fh->getline()) { $PlanSql->insert("end", $line); } $fh->close(); return(1); } ################################################################################ # Display a file open dialog & load into the SQL editor sub open_dialog($) { my ($parent) = @_; # Put up the dialog require Cwd; import Cwd; require Tk::FileSelect; $FileDir = cwd() if (! $FileDir); if (! $OpenDialog) { $OpenDialog = $parent->FileSelect(-title => "Open File", -create => 0); } $OpenDialog->configure(-directory => $FileDir); my $file = $OpenDialog->Show(); return if (! $file); $FileDir = $OpenDialog->cget(-directory); open_file($file); } ################################################################################ # Display a file save dialog & save the contents of the passed Text widget sub save_dialog($$) { my ($parent, $text) = @_; # Put up the dialog require Cwd; import Cwd; require IO::File; require Tk::FileSelect; $FileDir = cwd() if (! $FileDir); if (! $SaveDialog) { $SaveDialog = $parent->FileSelect(-title => "Save File", -create => 1); } $SaveDialog->configure(-directory => $FileDir); my $file = $SaveDialog->Show(); return if (! $file); $FileDir = $SaveDialog->cget(-directory); # Save the Text widget contents to the selected file my $fh; if (! ($fh = IO::File->new($file, "w"))) { error($PlanMain, "Cannot open $file:\n", $!); return; } $fh->print($text->get("1.0", "end")); $fh->close(); } ################################################################################ # Copy SQL from the grab window into the explain SQL editor sub copy_sql($$) { my ($text, $tag) = @_; return if (! defined($tag)); clear_editor(); $PlanSql->insert("end", $text->get("$tag.first", "$tag.last")); $Schema = $text->tag("cget", $tag, -data); update_title(); $PlanMain->deiconify(); } ################################################################################ # Display info from v$sqlarea for the selected statement in the SQL cache sub disp_sql_cache_info($$) { my ($address, $puid) = @_; # Empty the widget & prepare the SQL $GrabDetails->delete("1.0", "end"); busy(1); my $qry = $Db->prepare(qq( $SqlMarker select executions, disk_reads, buffer_gets, rows_processed, sorts, loads, parse_calls, first_load_time from v\$sqlarea where address = :1 )) || die("Statement info:\n$DBI::errstr\n"); # Read the info. Note that the statement *may* have been purged from the cache! $qry->execute($address); if (! (my ($executions, $disk_reads, $buffer_gets, $rows_processed, $sorts, $loads, $parse_calls, $first_load_time) = $qry->fetchrow_array())) { $GrabDetails->insert("1.0", "This statement is no longer in the SQL cache"); } else { $first_load_time =~ s!/! !; $GrabDetails->insert("1.0", "First executed by user", "bold", " $puid ", "", " at", "bold", " $first_load_time\n"); $GrabDetails->insert("end", "Total ", "bold"); $GrabDetails->insert("end", sprintf("Executions: %8d\n", $executions)); my $fmt = "Disk reads: %8d Buffer gets: %8d Rows processed: %8d\n" . "Sorts: %8d Loads: %8d Parse calls: %8d\n"; $GrabDetails->insert("end", sprintf($fmt, $disk_reads, $buffer_gets, $rows_processed, $sorts, $loads, $parse_calls)); if ($executions > 0) { $GrabDetails->insert("end", "Average per Execution\n", "bold"); $fmt = "Disk reads: %8.1f Buffer gets: %8.1f " . "Rows processed: %8.1f\n" . "Sorts: %8.1f Loads: %8.1f " . "Parse calls: %8.1f\n"; $GrabDetails->insert("end", sprintf($fmt, $disk_reads / $executions, $buffer_gets / $executions, $rows_processed / $executions, $sorts / $executions, $loads / $executions, $parse_calls / $executions)); } } busy(0); # Display the formated info return(1); } ################################################################################ # Callback for whenever a bit of grabbed SQL is selected sub grab_select_cb($$) { my ($text, $tag) = @_; $text->tag("configure", $GrabSelection, -background => undef) if ($GrabSelection); $text->tag("configure", $tag, -background => "#43ce80"); my $puid = $text->tag("cget", $tag, -data); $GrabSelection = $tag; if (! eval { disp_sql_cache_info($tag, $puid); }) { error($GrabMain, $@); } } ################################################################################ # Scan v$sqlarea for SQL statements matching the specified conditions. # $order_by is a v$sqlarea column name used to rank the statements # $sort_by is "asc" or "desc" # $user is who first issued the statement (case insensitive) # $pattern is a perl regexp used to filter the SQL # $rows is the maximum number of rows to display sub grab($$$$$$$) { my ($ordering, $order_by, $sort_by, $no_sys, $user, $pattern, $rows) = @_; # Check we are logged on die("You are not logged on to Oracle\n") if (! $Db); # Munge args as necessary $no_sys = $no_sys ? qq{and user_name not in ('SYS', 'SYSTEM')} : qq{}; $rows = -1 if ($rows !~ /^\d+$/); $user = uc($user); # Clear the frames $GrabSql->delete("1.0", "end"); $GrabDetails->delete("1.0", "end"); $GrabStatus->configure(-text => "Please wait..."); # Define the callbacks for highlighting etc my $highlight = sub { my ($text, $tag) = @_; $text->tag("configure", $tag, -relief => "raised", -borderwidth => 1); }; my $normal = sub { my ($text, $tag) = @_; $text->tag("configure", $tag, -relief => "flat"); }; # Prepare the queries busy(1); my $qry1 = qq{$SqlMarker select address, username from v\$sqlarea, all_users}; $qry1 .= qq{ where sql_text not like '\%$SqlMarker\%'}; $qry1 .= qq{ and sql_text not like '\%insert into \%plan_table\%'}; $qry1 .= qq{ and sql_text not like '\%explain plan\%'}; $qry1 .= qq{ and user_id = parsing_user_id}; # if($user || $no_sys); $qry1 .= qq{ and username = :1} if ($user); $qry1 .= qq{ and username not in ('SYS', 'SYSTEM')} if ($no_sys); if ($ordering eq "total") { $qry1 .= qq{ order by $order_by $sort_by}; } elsif ($ordering eq "average") { $qry1 .= qq{ order by $order_by / greatest(executions, 1) $sort_by}; } $qry1 = $Db->prepare($qry1) || die("SQL Cache capture:\n$DBI::errstr\n"); my $qry2; if ($OracleVersion ge "7.2") { $qry2 = $Db->prepare(qq( $SqlMarker select sql_text from v\$sqltext_with_newlines where address = :1 order by piece)) || die("SQL text:\n$DBI::errstr\n"); } else{ $qry2 = $Db->prepare(qq( $SqlMarker select sql_text from v\$sqltext where address = :1 order by piece)) || die("SQL text:\n$DBI::errstr\n"); } # For each SQL query in the shared pool... if ($user) { $qry1->execute($user) || die("SQL text:\n$DBI::errstr\n"); } else { $qry1->execute() || die("SQL text:\n$DBI::errstr\n"); } my $count = 0; my $first_address; while ($count != $rows && (my ($address, $puid) = $qry1->fetchrow_array())) { # ...glue together the components of the SQL string & print out $qry2->execute($address) || die("SQL text:\n$DBI::errstr\n"); my ($sql_text) = ""; while (my ($sql) = $qry2->fetchrow_array()) { $sql_text .= $sql; } $qry2->finish(); $sql_text =~ s/^\s+//; $sql_text =~ s/\n\s*\n/\n/; $sql_text =~ s/\s+$//s; # Skip if it doesn't match the supplied pattern next if ($pattern && eval { $sql_text !~ /$pattern/is; }); # Display the statement and set up the bindings $GrabSql->insert("end", $sql_text, $address, "\n\n"); $GrabSql->tag("configure", $address, -data => $puid); $GrabSql->tag("bind", $address, "" => [ $highlight, $address ]); $GrabSql->tag("bind", $address, "" => [ $normal, $address ]); $GrabSql->tag("bind", $address, "" => [ \©_sql, $address]); $GrabSql->tag("bind", $address, "<1>" => [ \&grab_select_cb, $address ]); $GrabSql->update(); $count++; $first_address = $address if (! defined($first_address)); if ($rows > 0) { $GrabStatus->configure(-text => "$count of $rows queries grabbed"); } else { $GrabStatus->configure(-text => "$count queries grabbed"); } } # Clean up $qry1->finish(); grab_select_cb($GrabSql, $first_address) if ($first_address); $GrabStatus->configure(-text => "$count queries grabbed"); busy(0); return(1); } ################################################################################ # Create a top-level window for getting SQL from the shared pool cache sub grab_main { # If it already exists, just make it visible) if ($GrabMain) { $GrabMain->deiconify(); $GrabMain->raise($PlanMain); return; } # Otherwise, build the grab window $GrabMain = $PlanMain->Toplevel(-title => "$ProgName - SQL cache"); $GrabMain->protocol("WM_DELETE_WINDOW", sub { $GrabMain->withdraw(); }); # Defaults & callbacks my $ordering = ""; my $order_by = ""; my $sort_by = ""; my $no_sys = 1; my $user = ""; my $pattern = ""; my $rows = 100; my $grab_cb = sub { if (! eval { grab($ordering, $order_by, $sort_by, $no_sys, $user, $pattern, $rows); }) { error($GrabMain, $@); } }; my (%ord_bn, %sort_bn); # For "order by" and "sort order" buttons my $ord_bn_cb = sub { if ($ordering eq "") { $order_by = ""; $sort_by = ""; foreach my $bn (values(%ord_bn)) { $bn->configure(-state => "disabled"); } foreach my $bn (values(%sort_bn)) { $bn->configure(-state => "disabled"); } } elsif ($ordering eq "total") { $order_by = "disk_reads" if ($order_by eq ""); $sort_by = "desc" if ($sort_by eq ""); foreach my $bn (values(%ord_bn)) { $bn->configure(-state => "normal"); } foreach my $bn (values(%sort_bn)) { $bn->configure(-state => "normal"); } } else # $ordering eq "average" { $order_by = "disk_reads" if ($order_by eq "" || $order_by eq "executions"); $sort_by = "desc" if ($sort_by eq ""); foreach my $bn (values(%ord_bn)) { $bn->configure(-state => "normal"); } $ord_bn{executions}->configure(-state => "disabled"); $ord_bn{first_load_time}->configure(-state => "disabled"); foreach my $bn (values(%sort_bn)) { $bn->configure(-state => "normal"); } } }; ### Menubar my $menubar = $GrabMain->Frame(-relief => "raised", -borderwidth => 3); $menubar->pack(-fill => "x"); my $menubar_file = $menubar->Menubutton(-text => "File", -underline => 0); $menubar_file->command(-label => "Save File ...", -underline => 0, -command => sub { save_dialog($PlanMain, $GrabSql); }); $menubar_file->separator(); $menubar_file->command(-label => "Capture SQL", -underline => 0, -command => $grab_cb); $menubar_file->command(-label => "Copy to Explain", -underline => 9, -command => sub { copy_sql($GrabSql, $GrabSelection); }); $menubar_file->command(-label => "Close", -underline => 1, -command => sub { $GrabMain->withdraw(); }); $menubar_file->pack(-side => "left"); my $menubar_help = $menubar->Menubutton(-text => "Help", -underline => 0); $menubar_help->command(-label => "About ...", -underline => 0, -command => sub { about($GrabMain); }); $menubar_help->command(-label => "Usage ...", -underline => 0, -command => sub { help($GrabMain); }); $menubar_help->pack(-side => "right"); ### SQL cache display my ($frame, $frame1, $frame2, $frame3); $frame = $GrabMain->Frame(-borderwidth => 3, -relief => "raised"); $frame1 = $frame->Frame(-highlightthickness => 0); $frame1->Label(-text => "SQL Cache")->pack(-side => "left"); $GrabStatus = $frame1->Label(-text => "")->pack(-side => "right"); $frame1->pack(-fill => "x"); $GrabSql = $frame->Scrolled("ROText", -setgrid => "true", -scrollbars => "oe", -height => 15, -width => 80, -borderwidth => 0, -wrap => "word") ->pack(-fill => "both", -expand => 1); $frame->pack(-fill => "both", -expand => 1); ### SQL statement details $frame = $GrabMain->Frame(-borderwidth => 3, -relief => "raised"); $frame->Label(-text => "SQL Statement Statistics")->pack(-anchor => "nw"); $GrabDetails = $frame->ROText(-height => 7, -width => 80, -borderwidth => 0, -setgrid => "true", -wrap => "none") ->pack(-fill => "x"); $GrabDetails->tagConfigure("bold", -font => "bold"); $frame->pack(-fill => "x"); ### SQL selection $frame = $GrabMain->Frame(-borderwidth => 3, -relief => "raised"); $frame->Label(-text => "SQL Selection Criterea")->pack(-anchor => "w"); $frame1 = $frame->Frame(-highlightthickness => 1); ## SQL sort frame $frame1->Label(-text => "Order SQL by") ->grid(-column => 0, -row => 0, -sticky => "w", -columnspan => 2); $frame2 = $frame1->Frame(-highlightthickness => 0); # Ordering frame $frame3 = $frame2->Frame(-highlightthickness => 1); $frame3->Radiobutton(-text => "No ordering", -highlightthickness => 0, -value => "", -variable => \$ordering, -command => $ord_bn_cb) ->pack(-anchor => "w"); $frame3->Radiobutton(-text => "Total", -highlightthickness => 0, -value => "total", -variable => \$ordering, -command => $ord_bn_cb) ->pack(-anchor => "w"); $frame3->Radiobutton(-text => "Average per execution", -highlightthickness => 0, -value => "average", -variable => \$ordering, -command => $ord_bn_cb) ->pack(-anchor => "w"); $frame3->pack(-side => "left", -padx => 6); # Order by frame $frame3 = $frame2->Frame(-highlightthickness => 1); $ord_bn{disk_reads} = $frame3->Radiobutton(-text => "Disk reads", -highlightthickness => 0, -value => "disk_reads", -variable => \$order_by, -command => $ord_bn_cb) ->grid(-column => 0, -row => 0, -sticky => "w"); $ord_bn{buffer_gets} = $frame3->Radiobutton(-text => "Buffer gets", -highlightthickness => 0, -value => "buffer_gets", -variable => \$order_by, -command => $ord_bn_cb) ->grid(-column => 1, -row => 0, -sticky => "w"); $ord_bn{rows_processed} = $frame3->Radiobutton(-text => "Rows processed", -highlightthickness => 0, -value => "rows_processed", -variable => \$order_by, -command => $ord_bn_cb) ->grid(-column => 0, -row => 1, -sticky => "w"); $ord_bn{sorts} = $frame3->Radiobutton(-text => "Sorts", -highlightthickness => 0, -value => "sorts", -variable => \$order_by, -command => $ord_bn_cb) ->grid(-column => 1, -row => 1, -sticky => "w"); $ord_bn{loads} = $frame3->Radiobutton(-text => "Loads", -highlightthickness => 0, -value => "loads", -variable => \$order_by, -command => $ord_bn_cb) ->grid(-column => 0, -row => 2, -sticky => "w"); $ord_bn{parse_calls} = $frame3->Radiobutton(-text => "Parse calls", -highlightthickness => 0, -value => "parse_calls", -variable => \$order_by, -command => $ord_bn_cb) ->grid(-column => 1, -row => 2, -sticky => "w"); $ord_bn{executions} = $frame3->Radiobutton(-text => "Executions", -highlightthickness => 0, -value => "executions", -variable => \$order_by, -command => $ord_bn_cb) ->grid(-column => 0, -row => 3, -sticky => "w"); $ord_bn{first_load_time} = $frame3->Radiobutton(-text => "First load", -highlightthickness => 0, -value => "first_load_time", -variable => \$order_by, -command => $ord_bn_cb) ->grid(-column => 1, -row => 3, -sticky => "w"); $frame3->pack(-side => "left", -padx => 6); # Sort order frame $frame3 = $frame2->Frame(-highlightthickness => 1); $sort_bn{desc} = $frame3->Radiobutton(-text => "Descending", -highlightthickness => 0, -value => "desc", -variable => \$sort_by, -command => $ord_bn_cb) ->grid(-column => 0, -row => 0, -sticky => "w"); $sort_bn{asc} = $frame3->Radiobutton(-text => "Ascending", -highlightthickness => 0, -value => "asc", -variable => \$sort_by, -command => $ord_bn_cb) ->grid(-column => 0, -row => 1, -sticky => "w"); $frame3->pack(-side => "right", -padx => 6); $frame2->grid(-column => 0, -row => 1, -sticky => "w", -columnspan => 2); ## Other options frame $frame2 = $frame1->Frame(-highlightthickness => 0); $frame2->Checkbutton(-text => "Exclude queries by SYS or SYSTEM", -variable => \$no_sys, -offvalue => 0, -onvalue => 1, -highlightthickness => 0) ->grid(-column => 0, -row => 0, -sticky => "w", -columnspan => 2); $frame2->Label(-text => "First user to execute statement") ->grid(-column => 0, -row => 1, -sticky => "w"); $frame2->Entry(-textvariable => \$user, -width => 30) ->grid(-column => 1, -row => 1, -sticky => "w"); $frame2->Label(-text => "SQL matches pattern") ->grid(-column => 0, -row => 2, -sticky => "w"); $frame2->Entry(-textvariable => \$pattern, -width => 30) ->grid(-column => 1, -row => 2, -sticky => "w"); $frame2->Label(-text => "Maximum number of statements") ->grid(-column => 0, -row => 3, -sticky => "w"); $frame2->Entry(-textvariable => \$rows, -width => 4) ->grid(-column => 1, -row => 3, -sticky => "w"); $frame2->grid(-column => 0, -row => 2, -sticky => "we", -columnspan => 2, -padx => 6, -pady => 6); $frame1->pack(-fill => "x"); &$ord_bn_cb(); # Set the buttons to the initial state $frame->pack(-fill => "x", -padx => 6, -pady => 6); ### Buttons $frame = $GrabMain->Frame(-borderwidth => 3, -relief => "raised"); $frame->Button(-text => "Capture SQL", -command => $grab_cb) ->pack(-side => "left", -expand => 1, -pady => 6); $frame->Button(-text => "Copy to Explain", -command => sub { copy_sql($GrabSql, $GrabSelection); }) ->pack(-side => "left", -expand => 1, -pady => 6); $frame->Button(-text => "Close", -command => sub { $GrabMain->withdraw(); }) ->pack(-side => "left", -expand => 1, -pady => 6); $frame->pack(-fill => "x"); } ################################################################################ # Main ### Main window $ProgName = basename($0); $ProgName =~ s/\..*$//; $PlanMain = MainWindow->new(); $PlanMain->withdraw(); update_title(); $Balloon = $PlanMain->Balloon(); ### Splash screen my $splash; if (@ARGV == 0 || $ARGV[0] ne '-q') { about($PlanMain, \$splash); $splash->after(10000, sub { if ($splash) { $splash->destroy(); undef($splash); } }); $PlanMain->update(); } else { shift(@ARGV); } ### Menubar my $menubar = $PlanMain->Frame(-relief => "raised", -borderwidth => 3); # Create a bold font $ figure out charcter spacing my $t = $PlanMain->Text(); my $f = $t->cget(-font); $t->fontCreate("bold", $PlanMain->fontActual($f), -weight => "bold"); $CharWidth = $PlanMain->fontMeasure($f, "X"); undef($f); $t->destroy(); undef($t); my $menubar_file = $menubar->Menubutton(-text => "File", -underline => 0); $menubar_file->command(-label => "Login ...", -underline => 0, -command => sub { login_dialog($PlanMain); }); $menubar_file->command(-label => "Schema ...", -underline => 2, -command => sub { schema_dialog($PlanMain); }); $menubar_file->command(-label => "Explain", -underline => 0, -command => \&explain); $menubar_file->command(-label => "SQL Cache ...", -underline => 4, -command => \&grab_main); $menubar_file->separator(); $menubar_file->command(-label => "Open File ...", -underline => 0, -command => sub { open_dialog($PlanMain); }); $menubar_file->command(-label => "Save File ...", -underline => 0, -command => sub { save_dialog($PlanMain, $PlanSql); }); $menubar_file->separator(); $menubar_file->command(-label => "Exit", -underline => 1, -command => sub { $Db->disconnect() if ($Db); exit(0); }); $menubar_file->pack(-side => "left"); my $menubar_help = $menubar->Menubutton(-text => "Help", -underline => 0); $menubar_help->command(-label => "About ...", -underline => 0, -command => sub { about($PlanMain); }); $menubar_help->command(-label => "Usage ...", -underline => 0, -command => sub { help($PlanMain); }); $menubar_help->pack(-side => "right"); $menubar->pack(-fill => "x"); ### Query plan tree my $frame; $frame = $PlanMain->Frame(-borderwidth => 3, -relief => "raised"); $PlanTitle = $frame->Label(-text => "Query Plan")->pack(-anchor => "nw"); my $b1_cb = sub { error($PlanMain, $@) if (! eval { disp_plan_step_obj($_[0])}); }; my $b3_cb = sub { error($PlanMain, $@) if (! eval { disp_index_popup($_[0])}); }; $PlanTree = $frame->Scrolled("B3Tree", -height => 15, -width => 80, -borderwidth => 0, -highlightthickness => 1, -scrollbars => "osoe", -browsecmd => \&disp_plan_step, -command => $b1_cb, -b3command => $b3_cb) ->pack(-expand => 1, -fill => "both"); $frame->pack(-expand => 1, -fill => "both"); ### Query plan statement details $frame = $PlanMain->Frame(-borderwidth => 3, -relief => "raised"); $frame->Label(-text => "Query Step Details")->pack(-anchor => "nw"); $PlanStep = $frame->Scrolled("ROText", -height => 8, -width => 80, -borderwidth => 0, -wrap => "none", -setgrid => "true", -scrollbars => "osoe") ->pack(-fill => "x"); $frame->pack(-fill => "x"); ### SQL text editor $frame = $PlanMain->Frame(-borderwidth => 3, -relief => "raised"); $frame->Label(-text => "SQL Editor")->pack(-anchor => "nw"); $PlanSql = $frame->Scrolled("Text", -setgrid => "true", -scrollbars => "oe", -borderwidth => 0, -height => 15, -width => 80, -wrap => "word") ->pack(-expand => 1, -fill => "both"); $frame->pack(-expand => 1, -fill => "both"); ### Buttons $frame = $PlanMain->Frame(-borderwidth => 3, -relief => "raised"); $frame->Button(-text => "Explain", -command => \&explain) ->pack(-side => "left", -expand => 1, -pady => 6); $frame->Button(-text => "Clear", -command => \&clear_editor) ->pack(-side => "left", -expand => 1, -pady => 6); $frame->Button(-text => "SQL Cache", -command => \&grab_main) ->pack(-side => "left", -expand => 1, -pady => 6); $frame->pack(-fill => "x"); ### user/pass@db command-line argument processing $PlanMain->update(); $PlanMain->deiconify(); $splash->raise() if (defined($splash)); if (@ARGV >= 1 && $ARGV[0] =~ /\w*\/\w*(@\w+)?/) { my ($username, $password, $database) = split(/[\/@]/, shift(@ARGV)); if (! $username) { $username = "/"; $password = ""; } if (! $database) { $database = $ENV{TWO_TASK} || $ENV{ORACLE_SID}; } error($PlanMain, $@) if (! eval { login($database, $username, $password); }); update_title(); } else { login_dialog($PlanMain); } ### SQL filename argument processing if (@ARGV >= 1 && -r $ARGV[0]) { my $file = shift(@ARGV); if (open_file($file)) { $FileDir = dirname($file); explain() if ($Db); } } # Doncha just love GUI programming :-) MainLoop(); ################################################################################ __END__ =head1 NAME ora_explain.pl - Visualise Oracle query plans =head1 SYNOPSIS $ ora_explain.pl [ [ user/password@database ] sql script ] =head1 DESCRIPTION Explain is a GUI-based tool that enables easier visualisation of Oracle Query plans. A query plan is the access path that Oracle will use to satisfy a SQL query. The Oracle query optimiser is responsible for deciding on the optimal path to use. Needless to say, understanding such plans requires a fairly sophisticated knowledge of Oracle architecture and internals. Explain allows a user to interactively edit a SQL statemant and view the resulting query plan with the click of a single button. The effects of modifying the SQL or of adding hints can be rapidly established. Explain allows the user to capture all the SQL currently cached by Oracle. The SQL capture can be filtered and sorted by different criterea, e.g. all SQL matching a pattern, order by number of executions etc. Explain is written using Perl, DBI/DBD::Oracle and Tk. =head1 PREREQUISITES =over 2 =item 1. Oracle 7 or Oracle 8, with SQL*Net if appropriate =item 2. L or later =item 3. L version 1.02 or later =item 4. L 0.54 or later =item 5. L 800.011 or later =item 6. L 3.15 or later =back Items 2 through 6 can be obtained from any CPAN mirror. =head1 HOW TO USE Type "ora_explain.pl" at the shell prompt. A window will appear with a menu bar and three frames, labelled "Query Plan", "Query Step Details" and "SQL Editor". At the bottom of the window are three buttons labelled "Explain", "Clear" and "SQL Cache". A login dialog will also appear, into which you should enter the database username, password and database instance name (SID). The parameters you enter are passed to the DBI->connect() method, so if you have any problems refer to the DBI and DBD::Oracle documentation. Optionally you may supply up to two command-line arguments. If the first argument is of the form username/password@database, explain will use this to log in to Oracle, otherwise if it is a filename it will be loaded into the SQL editor. If two arguments are supplied, the second one will be assumed to be a filename. Examples: explain scott/tiger@DEMO query.sql explain / query.sql explain query.sql =head2 Explain functionality The menu bar has two pulldown menus, "File" and "Help". "File" allows you to login to Oracle, Change the current schema, Capture the contents of the Oracle SQL cache, Load SQL from files, Save SQL to files and to Exit the program. "Help" allows you to view release information and read this documentation. The "SQL Editor" frame allows the editing of a SQL statement. This should be just a single statement - multiple statements are not allowed. Refer to the documentation for the Tk text widget for a description of the editing keys available. Text may be loaded and saved by using the "File" pulldown menu. Once you have entered a SQL statement, the "Explain" button at the bottom of the window will generate the query plan for the statement. A tree representation of the plan will appear in the "Query Plan" frame. Individual "legs" of the plan may be expanded and collapsed by clicking on the "+' and "-" boxes on the plan tree. The tree is drawn so that the "innermost" or "first" query steps are indented most deeply. The connecting lines show the "parent-child" relationships between the query steps. For a comprehensive explanation of the meaning of query plans you should refer to the relevant Oracle documentation. The "Clear" button will empty the editor & query plan tree panes. Single-clicking on a plan step in the Query Plan pane will display more detailed information on that query step in the Query Step Details frame. This information includes Oracle's estimates of cost, cardinality and bytes returned. The exact information displayed depends on the Oracle version. Again, for detailed information on the meaning of these fields, refer to the Oracle documentation. Double-clicking on a plan step that refers to either a table or an index will pop up a dialog box showing the definition of the table or index in a format similar to that of the SQL*Plus 'desc' command. The dialog that appears has a button labelled 'Index'. Clicking on this will expand the table dialog to show all the indexes defined on the table. Each column represents an index, and the figures define the order that the table columns appears in the index. To find out the name of an index, position the mouse over the index column. A single click will display the definition of the index in a separate dialog. Right-clicking on a plan step that refers to a table will pop up a menu showing a list of the indexes available for the table. Selecting an index will display its definition in a dialog box. =head2 Capture SQL Cache functionality The explain window has an option on the "File" menu labelled "SQL Cache ...", as well as a button with the same function. Selecting this will popup a new top-level window containing a menu bar and three frames, labelled "SQL Cache", "SQL Statement Statistics" and "SQL Selection Criterea". At the bottom of the window are three buttons labelled "Capture SQL", "Explain" and "Close". The menu bar has two pulldown menus "File" and "Help". "File" allows you to Save the contents of the SQL Cache pane to a file, copy the selected SQL statement to the Explain window and Close the Grab window. The "SQL Cache" frame shows the statements currently in the Oracle SQL cache. As you move the cursor over this window, each SQL statement will be highlighted with an outline box. Single-clicking on a statement in the SQL Cache pane will highlight the stamement in green and display more detailed information on that statement in the SQL Statement Statistics frame. If you want to save the entire contents of the SQL Cache pane, you can do this from the "File" menu. The "SQL Selection Criterea" frame allows you to specify which SQL statements you are interested in, and how you want them sorted. The pattern used to select statements is a normal perl regexp. Once you have defined the selection criterea, clicking the "Capture SQL" button will read all the matching statements from the SQL cache and display them in the top frame. Double-clicking on a statement in the "SQL Cache" pane, selecting "Explain" from the "File" menu or clicking the "Explain" button will copy the currently highlighted statement in the "SQL Cache" pane to the SQL editor in the Explain window, so that the query plan for the statement can be examined. Note also that the current schema will be changed to that of the user who first executed the captured statement. =head1 SEE ALSO This tool assumes that you already know how to interpret Oracle query plans. If need an explanation of the information displayed by this tool, you should refer to the appropriate Oracle documentation. Information can be found in the "Concepts" and "Oracle Tuning" manuals - look for "Query plan" and "Explain plan". Two other useful sources of information are: Oracle Performance Tuning, 2nd ed. Mark Gurry and Peter Corrigan O'Reilly & Associates, Inc. ISBN 1-56592-237-9 Advanced Oracle Tuning and Administration Eyal Aronoff, Kevin Loney and Noorali Sonawalla Oracle Press (Osborne) ISBN 0-07-882241-6 =head1 SUPPORT Support questions and suggestions can be directed to Alan.Burlison@uk.sun.com =head1 COPYRIGHT AND DISCLAIMER Copyright (c) 1999 Alan Burlison You may distribute under the terms of either the GNU General Public License or the Artistic License, as specified in the Perl README file. This code is provided with no warranty of any kind, and is used entirely at your own risk. This code was written by the author as a private individual, and is in no way endorsed or warrantied by Sun Microsystems. =cut DBD-Oracle-1.74/examples/commit.pl0000755000175000017500000000262312326332111016222 0ustar yanickyanick#!/usr/bin/env perl # # commit.pl # # Simple example of using commit and rollback. use DBI; use strict; # Set trace level if '-# trace_level' option is given DBI->trace( shift ) if 1 < @ARGV && $ARGV[0] =~ /^-#/ && shift; die "syntax: $0 [-# trace] base user pass" if 3 > @ARGV; my ( $inst, $user, $pass ) = @ARGV; # Connect to database my $dbh = DBI->connect( "dbi:Oracle:$inst", $user, $pass, { AutoCommit => 0, RaiseError => 1, PrintError => 0 } ) or die $DBI::errstr; # Create the table to hold prime numbers print "Creating table\n"; eval { $dbh->do( 'CREATE TABLE primes ( prime NUMBER )' ); }; warn $@ if $@; print "Loading table"; my $sth = $dbh->prepare( 'INSERT INTO primes VALUES ( ? )' ); while ( ) { chomp; print " $_"; $sth->execute( $_ ); print " commit (", $dbh->commit, ")" if 11 == $_; } print "\n"; my $prime; print "Reading table for the first time\n"; $sth = $dbh->prepare( 'SELECT prime FROM primes ORDER BY prime' ); $sth->execute; $sth->bind_columns( {}, \$prime ); while ( $sth->fetch ) { print " $prime"; } $sth->finish; print "\n"; print "rollback (", $dbh->rollback, ")\n"; print "Reading table for the second time.\n"; $sth->execute; $sth->bind_columns( {}, \$prime ); while ( $sth->fetch ) { print " $prime"; } $sth->finish; print "\n"; $dbh->do( 'DROP TABLE primes' ); print "Table Dropped\n"; $dbh->disconnect; __END__ 2 3 5 7 11 13 17 19 23 29 DBD-Oracle-1.74/examples/bind.pl0000755000175000017500000000204612326332111015645 0ustar yanickyanick#!/usr/bin/env perl # # bind.pl # # This shows how a placeholder may be used to implement a simple lookup. use DBI; use strict; # Set trace level if '-# trace_level' option is given DBI->trace( shift ) if 1 < @ARGV && $ARGV[0] =~ /^-#/ && shift; die "syntax: $0 [-# trace] base user pass" if 3 > @ARGV; my ( $inst, $user, $pass ) = @ARGV; # Connect to database my $dbh = DBI->connect( "dbi:Oracle:$inst", $user, $pass, { AutoCommit => 0, RaiseError => 1, PrintError => 0 } ) or die $DBI::errstr; # Prepare the SELECT statement using a placeholder my $sth = $dbh->prepare( 'SELECT created FROM all_users WHERE username = ?' ); my ( $created ); $| = 1; print "Enter an empty line to finish\n"; print "Userid? "; while ( ) { chomp; last if ! $_; $sth->execute( uc( $_ ) ); # Note that the variable is in parenthesis to give an array context if ( ( $created ) = $sth->fetchrow_array ) { print "$created\n"; } else { print "unknown\n"; } print "Userid? "; } $sth->finish; $dbh->disconnect; DBD-Oracle-1.74/examples/curref.pl0000755000175000017500000000520712326332111016221 0ustar yanickyanick#!/usr/bin/env perl # # curref.pl - by Geoffrey Young # # for this example, we create a package that contains # two procedures: # emp_cursor - returns a specific cursor reference # ref_cursor_close - closes any cursor reference # # to actually run this example as is, you will need the # oracle demo tables. otherwise, it's just sample code... use DBI; use DBD::Oracle qw(:ora_types); use strict; # Set trace level if '-# trace_level' option is given DBI->trace( shift ) if 1 < @ARGV && $ARGV[0] =~ /^-#/ && shift; die "syntax: $0 [-# trace] base user pass" if 3 > @ARGV; my ( $inst, $user, $pass ) = @ARGV; # Connect to database my $dbh = DBI->connect( "dbi:Oracle:$inst", $user, $pass, { AutoCommit => 0, RaiseError => 1, PrintError => 0 } ) or die $DBI::errstr; my $sql = qq( CREATE OR REPLACE PACKAGE curref_test IS TYPE cursor_ref IS REF CURSOR; PROCEDURE emp_cursor (job_in IN VARCHAR2, curref IN OUT cursor_ref); PROCEDURE ref_cursor_close (curref IN cursor_ref); END; ); my $rv = $dbh->do($sql); print "The package has been created...\n"; $sql = qq( CREATE OR REPLACE PACKAGE BODY curref_test IS PROCEDURE emp_cursor (job_in IN VARCHAR2, curref IN OUT cursor_ref) IS BEGIN OPEN curref FOR select ename, job from emp where job = job_in; END; PROCEDURE ref_cursor_close (curref IN cursor_ref) IS BEGIN close curref; END; END; ); $rv = $dbh->do($sql); print "The package body has been created...\n"; print "These are the results from the ref cursor:\n"; $sql = qq( BEGIN curref_test.emp_cursor(:job_in, :curref); END; ); my $curref; my $sth = $dbh->prepare($sql); $sth->bind_param(":job_in", "CLERK"); $sth->bind_param_inout(":curref", \$curref, 0, {ora_type => ORA_RSET}); $sth->execute; $curref->dump_results; open_cursors(); $sql = qq( BEGIN curref_test.ref_cursor_close(:curref); END; ); $sth = $dbh->prepare($sql); $sth->bind_param(":curref", $curref, {ora_type => ORA_RSET}); $sth->execute; print "The cursor is now closed\n"; print "just to prove it...\n"; open_cursors(); $sql = "DROP PACKAGE curref_test"; # Also drops PACKAGE BODY $rv = $dbh->do($sql); print "The package has been dropped...\n"; $dbh->disconnect; sub open_cursors { eval { $sth = $dbh->prepare( 'SELECT user, sql_text FROM sys.v_$open_cursor ORDER BY user, sql_text'); $sth->execute; print "Here are the open cursors:\n"; $sth->dump_results; }; if ( $@ ) { print "Unable to SELECT from SYS.V_\$OPEN_CURSOR:\n"; if ( 942 == $DBI::err ) { print " User $user needs SELECT permission.\n"; } else { print "$@\n"; } } } DBD-Oracle-1.74/examples/ex.pl0000755000175000017500000000240412326332111015343 0ustar yanickyanick#!/usr/bin/env perl # Short example using bind_columns() to list a table's values use DBI; use strict; # Set trace level if '-# trace_level' option is given DBI->trace( shift ) if 1 < @ARGV && $ARGV[0] =~ /^-#/ && shift; die "syntax: $0 [-# trace] base user pass [max]" if 3 > @ARGV; my ( $inst, $user, $pass, $max ) = @ARGV; $max = 20 if ! $max || 0 > $max; my ( $name, $id, $created ); format STDOUT_TOP = Name ID Created ============================== ========= ========= . format STDOUT = @<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @>>>>>>>> @<<<<<<<< $name, $id, $created . # Connect to database my $dbh = DBI->connect( "dbi:Oracle:$inst", $user, $pass, { AutoCommit => 0, RaiseError => 1, PrintError => 0 } ) or die $DBI::errstr; my $sth = $dbh->prepare( "SELECT username, user_id, created FROM all_users ORDER BY username" ); $sth->execute; my $nfields = $sth->{NUM_OF_FIELDS}; print "Query will return $nfields fields\n\n"; $sth->bind_columns( {}, \( $name, $id, $created ) ); while ( $sth->fetch ) { last if ! --$max; # mark any NULL fields found foreach ( $name, $id, $created ) { $_ = 'NULL' if ! defined; } write; } $sth->finish; $dbh->disconnect; DBD-Oracle-1.74/examples/read_long_via_blob_read.pl0000644000175000017500000000132512326332111021507 0ustar yanickyanick#!/usr/bin/env perl use strict; use warnings; use DBI; my $dbh = DBI->connect( 'dbi:Oracle:mydb', 'username', 'password' ); $dbh->{RaiseError} = 1; $dbh->{LongTruncOk} = 1; # truncation on initial fetch is ok my $sth = $dbh->prepare("SELECT key, long_field FROM table_name"); $sth->execute; while ( my ($key) = $sth->fetchrow_array) { my $offset = 0; my $lump = 4096; # use benchmarks to get best value for you my @frags; while (1) { my $frag = $sth->blob_read(1, $offset, $lump); last unless defined $frag; my $len = length $frag; last unless $len; push @frags, $frag; $offset += $len; } my $blob = join "", @frags; print "$key: $blob\n"; } DBD-Oracle-1.74/examples/tabinfo.pl0000755000175000017500000000345712326332111016362 0ustar yanickyanick#!/usr/bin/env perl # # tabinfo # # Usage: tabinfo base user password table # # Displays the structure of the specified table. # Note that the field names are restricted to the length of the field. # This is mainly to show the use of &ora_lengths, &ora_titles and &ora_types. # use DBI; use strict; # Set trace level if '-# trace_level' option is given DBI->trace( shift ) if 1 < @ARGV && $ARGV[0] =~ /^-#/ && shift; # read the compulsory arguments die "syntax: $0 base user password table ...\n" if 4 > @ARGV; my ( $base, $user, $pass, @table ) = @ARGV; my ( $table, @name, @length, @type, %type_name, $i ); format STDOUT_TOP = Structure of @<<<<<<<<<<<<<<<<<<<<<<< $table Field name | Length | Type | Type Name ----------------------------------------------+--------+------+----------------- . format STDOUT = @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | @>>>>> | @>>> | @<<<<<<<<<<<<<<< $name[$i], $length[$i], $type[$i], $type_name{$type[$i]} . # Connect to database my $dbh = DBI->connect( "dbi:Oracle:$base", $user, $pass, { AutoCommit => 0, RaiseError => 1, PrintError => 0 } ) or die $DBI::errstr; # Associate type names to types { my $type_info_all = $dbh->type_info_all; my $iname = $type_info_all->[0]{TYPE_NAME}; my $itype = $type_info_all->[0]{DATA_TYPE}; my $rtype; shift @$type_info_all; foreach $rtype ( @$type_info_all ) { $type_name{$$rtype[$itype]} = $$rtype[$iname] if ! exists $type_name{$$rtype[$itype]}; } } my $sth; foreach $table ( @table ) { $sth = $dbh->prepare( "SELECT * FROM $table WHERE 1 = 2"); @name = @{$sth->{NAME}}; @length = @{$sth->{PRECISION}}; @type = @{$sth->{TYPE}}; foreach $i ( 0 .. $#name ) { write; } $- = 0; $sth->finish; } $dbh->disconnect; DBD-Oracle-1.74/examples/proc.pl0000755000175000017500000001065512326332111015701 0ustar yanickyanick#!/usr/bin/env perl # Short examples of procedure calls from Oracle.pm # These PL/SQL examples come from: Eric Bartley . use DBI; use strict; # Set trace level if '-# trace_level' option is given DBI->trace( shift ) if 1 < @ARGV && $ARGV[0] =~ /^-#/ && shift; die "syntax: $0 [-# trace] base user pass" if 3 > @ARGV; my ( $inst, $user, $pass ) = @ARGV; # So we don't have to check every DBI call we set RaiseError. # See the DBI docs if you're not familiar with RaiseError. # AutoCommit is currently encouraged and may be required later. my $dbh = DBI->connect( "dbi:Oracle:$inst", $user, $pass, { AutoCommit => 0, RaiseError => 1, PrintError => 0 } ) or die "Unable to connect: $DBI::errstr"; # Create the package for the examples $dbh->do( <do( <prepare( q{ BEGIN plsql_example.proc_np; END; } ); $sth->execute; print "\nExample 2\n"; # Now we call a procedure that has 1 IN parameter. Here we use bind_param # to bind out parameter to the prepared statement just like you might # do for an INSERT, UPDATE, DELETE, or SELECT statement. # # I could have used positional placeholders (e.g. :1, :2, etc.) or # ODBC style placeholders (e.g. ?), but I prefer Oracle's named # placeholders (but few DBI drivers support them so they're not portable). # # proc_in() will RAISE_APPLICATION_ERROR which will cause the execute to 'fail'. # Because we set RaiseError, the DBI will die() so we catch that with eval {}. my $err_code = -20001; $sth = $dbh->prepare( q{ BEGIN plsql_example.proc_in( :err_code ); END; } ); $sth->bind_param( ":err_code", $err_code ); eval { $sth->execute; }; print 'After proc_in: $@ = ', "'$@', errstr = '$DBI::errstr'\n"; print "\nExample 3\n"; # Building on the last example, I've added 1 IN OUT parameter. We still # use a placeholders in the call to prepare, the difference is that # we now call bind_param_inout to bind the value to the place holder. # # Note that the third parameter to bind_param_inout is the maximum size # of the variable. You normally make this slightly larger than necessary. # But note that the perl variable will have that much memory assigned to # it even if the actual value returned is shorter. my $test_num = 5; my $is_odd; $sth = $dbh->prepare( q{ BEGIN plsql_example.proc_in_inout( :test_num, :is_odd ); END; } ); # The value of $test_num is _copied_ here $sth->bind_param( ":test_num", $test_num ); $sth->bind_param_inout( ":is_odd", \$is_odd, 1 ); # The execute will automagically update the value of $is_odd $sth->execute; print "$test_num is ", $is_odd ? "odd - ok" : "even - error!", "\n"; print "\nExample 4\n"; # What about the return value of a PL/SQL function? Well treat it the same # as you would a call to a function from SQL*Plus. We add a placeholder # for the return value and bind it with a call to bind_param_inout so # we can access it's value after execute. my $whoami = ""; $sth = $dbh->prepare( q{ BEGIN :whoami := plsql_example.func_np; END; } ); $sth->bind_param_inout( ":whoami", \$whoami, 30 ); $sth->execute; print "Your database user name is $whoami\n"; # Get rid of the example package $dbh->do( 'DROP PACKAGE plsql_example' ); $dbh->disconnect; DBD-Oracle-1.74/examples/sql0000755000175000017500000001624712326332111015126 0ustar yanickyanick#!/usr/bin/perl -w 'di'; 'ig00'; # See usage() for syntax use Getopt::Long; use DBI; use strict; # Default values for options my ( $trace, $inst, $cache, $delim, $format, $headers, $page_len, $null_str ) = ( 0, $ENV{TWO_TASK} || $ENV{ORACLE_SID} || '', '', "\t", 0, 0, 60, '' ); # Syntax description sub usage { my ( $sOpt, $sVal, @sMsg ) = @_; my $sHelpText = < \&usage, 'trace|t=i' => \$trace, 'base|b=s' => \$inst, 'cache|c=i' => \$cache, 'delim|d=s' => \$delim, 'Format!' => \$format, 'F!' => \$format, 'Headers!' => \$headers, 'H!' => \$headers, 'len|len=i' => \$page_len, 'null|n=s' => \$null_str, ) or usage( 'die', 1 ); usage( 'die', 1, "Only one of -F and -H may be specified\n" ) if $format && $headers; usage( 'die', 1, 'Username and password are required' ) if 2 > @ARGV; my ( $user, $pass, @stmt ) = @ARGV; if ( ! @stmt ) { print "Enter the statement to execute (^D to end):\n"; @stmt = ; } usage( 'die', 1, "A statement is required" ) if ! @stmt; $\ = "\n"; # each record terminated with newline $, = $delim; # set column delimiter $= = $page_len; # set page length # Set trace level DBI->trace( $trace ); # Connect to database my $dbh = DBI->connect( "dbi:Oracle:$inst", $user, $pass, { AutoCommit => 0, RaiseError => 1, PrintError => 0 } ) or die $DBI::errstr; $dbh->{RowCacheSize} = $cache if $cache; # set fetch cache # Start statement my $sth = $dbh->prepare( join "\n", @stmt ); $sth->execute; my $nfields = $sth->{NUM_OF_FIELDS}; # print out any information which comes back if ( $nfields ) { # the statement has output columns my ( @col, $col ); my @name = @{$sth->{NAME}}; if ( $format ) { # build format statements for the data my @size = @{$sth->{PRECISION}}; # First, the header - a list of field names, formatted # in columns of the appropriate width my $fmt = join '|', map { "%-${_}.${_}s" } @size; $fmt = sprintf $fmt, @name; $format = "format STDOUT_TOP =\n" . $fmt . "\n"; # Then underlines for the field names $fmt =~ tr/|/-/c; $fmt =~ tr/|/+/; $format .= $fmt . "\n.\n"; # Then for the data format, a @<<... field per column $fmt =~ tr/-+/<|/; $fmt =~ s/(^|\|)bind_columns( {}, \( @col[0 .. $#name] ) ); while ( $sth->fetch ) { foreach $col ( @col ) { $col = $null_str if ! defined $col; } $format ? write : print @col; } } # finish off neatly $sth->finish; $dbh->disconnect; __END__ # no need for perl even to scan the rest ############################################################################## # These next few lines are legal in both Perl and nroff. .00; # finish .ig 'di \" finish diversion--previous line must be blank .nr nl 0-1 \" fake up transition to first page again .nr % 0 \" start at page 1 ';<<'.ex'; ############## From here on it's a standard manual page ############ .TH SQL L "5th July 1999" .ad .nh .SH NAME sql \- execute an Oracle SQL statement from the command line .SH SYNOPSIS \fBsql\fP [\fB\-b\fP\fIbase\fP] [\fB\-c\fP\fIcache\fP] [\fB\-d\fP\fIdelim\fP] [\fB\-F\fP|\fB\-H\fP] [\fB\-l\fP\fIpage_len\fP] [\fB\-n\fP\fIstring\fP] \fIname\fP \fIpassword\fP \fIstatement\fP .SH DESCRIPTION .I Sql connects to an Oracle database using the \fIname\fP and \fIpassword\fP supplied and executes the given SQL \fIstatement\fP displaying the result on its standard output. The \fB\-b\fP\fIbase\fP flag may be supplied to specify the database to be used. If it is not given, the database specified by the environment variable \fBTWO_TASK\fP or \fBORACLE_SID\fP is used. The \fB\-c\fP\fIcache\fP flag may be supplied to set the size of fetch cache to be used. If it is not given, the default is used. If the \fB\-n\fP\fIstring\fP flag is supplied, \fBNULL\fP fields (in the \fIOracle\fP sense) will replaced in the output by \fIstring\fP. Normally, they are left blank. The \fB\-F\fP and \fB\-H\fP flags may be used to modify the form of the output. Without either flag, no field headers are printed and fields are not padded. With the \fB\-H\fP flag, field headers are added to the top of the output, but the format is otherwise unchanged. With the \fB\-F\fP flag, the output is formatted in a tabular form similar to that used by \fIsqlplus\fP, except that all fields are left\-justified, regardless of their data type. Column headers are printed at the top of each page; a page is assumed to be 60 lines long, but this may be overridden with the \fB\-l\fP\fIpage_len\fP flag. Without the \fB\-F\fP flag, fields are separated with tabs; this may be changed to any desired string (\fIdelim\fP) using the \fB\-d\fP flag. .SH ENVIRONMENT The environment variable \fBTWO_TASK\fP or \fBORACLE_SID\fP determines the Oracle database to be used if the \fB\-b\fP\fIbase\fP flag is not supplied. .SH DIAGNOSTICS .in +5 .ti -5 \fBonly one of \-F and \-H may be specified\fP .br the \fB\-F\fP and \fB\-H\fP options are mutually exclusive, but both were specified .in -5 The only other diagnostics generated by \fIsql\fP are usage messages, which should be self\-explanatory. However, you may also encounter error messages from DBI (unlikely) or from Oracle (more common). See the \fIOracle Error Messages and Codes Manual\fP for details. .SH NOTES This program is only intended for use from the command line. If you use it within a shell script then you should consider rewriting your script in DBI to use Perl's text manipulation and formatting commands. .SH "SEE ALSO" \fISQL Language Reference Manual\fP .br perl(1), oraperl(1) .SH AUTHOR Kevin Stock, .if t .ft C .if t .ft P .ex DBD-Oracle-1.74/examples/mktable.pl0000755000175000017500000000465412326332111016357 0ustar yanickyanick#!/usr/bin/env perl # Sample DBI program to create a new table and load data into it. # # Author: Kevin Stock (original oraperl script) # Date: 5th August 1991 # Date: 25th September 1992 use DBI; use strict; # Set trace level if '-# trace_level' option is given DBI->trace( shift ) if 1 < @ARGV && $ARGV[0] =~ /^-#/ && shift; die "syntax: $0 [-# trace] base user pass" if 3 > @ARGV; my ( $inst, $user, $pass ) = @ARGV; # Connect to database my $dbh = DBI->connect( "dbi:Oracle:$inst", $user, $pass, { AutoCommit => 0, RaiseError => 1, PrintError => 0 } ) or die $DBI::errstr; # set these as strings to make the code more readable my $CREATE = "CREATE TABLE tryit ( name VARCHAR2(10), ext NUMBER(3) )"; my $INSERT = "INSERT INTO tryit VALUES ( ?, ? )"; my $LIST = "SELECT * FROM tryit ORDER BY name"; my $DELETE = "DELETE FROM tryit WHERE name = ?"; my $DELETE_NULL = "DELETE FROM tryit WHERE name IS NULL"; my $DROP = "DROP TABLE tryit"; # Can use dynamic variables in write as long as they are visible at format time my ( $msg, $name, $ext ); # Prepare formats for output format STDOUT_TOP = @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< $msg Name Ext ==== === . format STDOUT = @<<<<<<<<< @>> $name, $ext . # function to list the table sub list { $msg = join "\n", @_; $- = 0; my $sth = $dbh->prepare( $LIST ); $sth->execute; $sth->bind_columns( {}, \( $name, $ext ) ); while ( $sth->fetch ) { $name = '' unless defined $name; $ext = '' unless defined $ext; write; } $sth->finish; } # create the database $dbh->do( $CREATE ); # put some data into it my $sth = $dbh->prepare( $INSERT ); while ( ) { chomp; $sth->execute( map { 'NULL' eq $_ ? undef : $_ } split /:/, $_, 2 ); } $dbh->commit; list( 'Initial Data' ); # remove a few rows $sth = $dbh->prepare( $DELETE ); foreach $name ( 'catherine', 'angela', 'arnold', 'julia' ) { $sth->execute( $name ); } $dbh->commit; list( 'After removing selected people' ); # Remove some rows with NULLs $dbh->do( $DELETE_NULL ); list( 'After removing NULL names' ); # remove the table and disconnect $dbh->do( $DROP ); $dbh->disconnect; # This is the data which will go into the table __END__ julia:292 angela:208 NULL:999 larry:424 catherine:201 nonumber:NULL randal:306 arnold:305 NULL:NULL DBD-Oracle-1.74/examples/inserting_longs.pl0000644000175000017500000000223112326332111020126 0ustar yanickyanick#!/usr/bin/env perl use strict; use warnings; use DBI; my $db = DBI->connect( 'dbi:Oracle:mydb', 'username', 'password' ); my $table = 'TABLE'; my %clauses; my %attrib; my @types; my $longrawtype; my @row; # Assuming the existence of @row and an associative array (%clauses) containing the # column names and placeholders, and an array @types containing column types ... my $ih = $db->prepare("INSERT INTO $table ($clauses{names}) VALUES ($clauses{places})") or die "prepare insert into $table: " . $db->errstr; $attrib{'ora_type'} = $longrawtype; # $longrawtype == 24 ##-- bind the parameter for each of the columns for my $i ( 0..$#types ) { ##-- long raw values must have their type attribute explicitly specified if ($types[$i] == $longrawtype) { $ih->bind_param($i+1, $row[$i], \%attrib) || die "binding placeholder for LONG RAW " . $db->errstr; } ##-- other values work OK with the default attributes else { $ih->bind_param($i+1, $row[$i]) || die "binding placeholder" . $db->errstr; } } $ih->execute || die "execute INSERT into $table: " . $db->errstr; DBD-Oracle-1.74/examples/README0000644000175000017500000000332512326332111015252 0ustar yanickyanickThis directory contains a few sample DBI/DBD::Oracle scripts. Some are genuinely useful while others are just demonstrations of different things. They are adapted from the Oraperl example scripts in ../Oraperl.ex/ to show how to do the same things in Perl 5 and DBI. $dbh->{RaiseError} is set to 1 in all scripts for automatic error checking. bind.pl Demonstrates how execute() and fetchrow_array() may be combined to make a simple table lookup program with placeholders. commit.pl Demonstrates the use of commit() and rollback(). curref.pl Demonstrates how to use a cursor bind variable. ex.pl Reads data from a table and prints it using a format. Also illustrates how to recognise NULL fields and bind_columns with known column names. japh Just another Perl hacker, written for DBI. This is no one-liner, but it demonstrates a few things. mktable.pl Creates a table, puts some data into it, drops it. Demonstrates do(), placeholders, inserting and reading NULL values, and bind_columns() with known columns. oradump.pl Dumps an Oracle table as a set of INSERT statements. Demonstrates the use of $sth->{TYPE}, $dbh->quote(), and bind_columns() with unknown column names. proc.pl Demonstrates how to get values into and out of stored procedures and how to receive result sets. sql Demonstrates the use of $sth->{NUM_OF_FIELDS}, $sth->{NAME}, $sth->{PRECISION}, and bind_columns() with unknown column names. tabinfo.pl Displays the structure of the specified table. Demonstrates the use of $sth->{NAME}, $sth->{PRECISION}, $sth->{TYPE}, and type_info_all(). DBD-Oracle-1.74/mkta.pl0000755000175000017500000000563512326332111014056 0ustar yanickyanick#!/bin/env perl -w # mkta - make-test-all # # quick hack to run test suite against multiple dbs # for each db runn alternate charset tests in parallel # keep log files from failures use strict; use Symbol; local $| = 1; use DBI; use DBD::Oracle qw(ORA_OCI); my @sid = DBI->data_sources('Oracle'); s/^dbi:Oracle://i for @sid; # set TEST_FILES env var to override which tests are run my $opt_full = 1; my $opt_dir = "mkta"; my $opt_tf = $ENV{TEST_FILES}; my $opt_j = 6; my $seq = 0; my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger'; my (@queue, @run, %running, %skipped, @fail, $tested); my @cs_utf8 = (ORA_OCI() < 9.2) ? ("UTF8") : ("AL32UTF8", ($opt_full) ? ("UTF8") : ()); my @cs_8bit = ($opt_full) ? ("WE8ISO8859P1", "WE8MSWIN1252") : ("WE8MSWIN1252"); my @charsets = ("", @cs_utf8, @cs_8bit); # need to add in: # multiple perl versions/achitectures # multiple oracle versions for my $sid (@sid) { mkta_sid_cs($sid, \@charsets); } sub mkta_sid_cs { my ($sid, $charsets) = @_; my $start_time = time; local $ENV{ORACLE_SID} = $sid; my $dbh = DBI->connect("dbi:Oracle:", $dbuser, undef, { PrintError=>0 }); unless ($dbh) { (my $errstr = $DBI::errstr) =~ s/\n.*//s; push @{ $skipped{$errstr} }, $sid; return; } mkdir $opt_dir, 0771 unless -d $opt_dir; print "$sid: testing with @$charsets ...\n"; system("make") == 0 or die "$0 aborted - make failed\n"; system("rm -f $opt_dir/$sid-*-*.log"); for my $ochar (@$charsets) { for my $nchar (@$charsets) { # because empty NLS_NCHAR is same as NLS_LANG charset next if $nchar eq '' && $ochar ne ''; push @queue, [ $sid, $ochar, $nchar ]; } } while (@queue) { while (@queue && keys %running < $opt_j) { my ($tag, $fh) = start_test(@{ shift @queue }); $running{$tag} = $fh; push @run, $tag; ++$tested; } wait_for_tests(); } wait_for_tests(); printf "$sid: completed in %.1f minutes\n", (time-$start_time)/60; print "\n"; } sub start_test { my ($sid, $ochar, $nchar) = @_; local $ENV{NLS_LANG} = ($ochar) ? ".$ochar" : ""; local $ENV{NLS_NCHAR} = ($nchar) ? $nchar : ""; local $ENV{DBD_ORACLE_SEQ} = ++$seq; # unique id for parallel runs my $tag = join "-", map { $_ || "unset" } ($sid, $ochar, $nchar); my $fh = gensym(); my @make_opts; push @make_opts, "TEST_FILES='$opt_tf'" if $opt_tf; open $fh, "make test @make_opts > $opt_dir/$tag.log 2>&1 && rm $opt_dir/$tag.log |"; print "$tag: started\n"; return ($tag, $fh); } sub wait_for_tests { while(%running) { my @running = grep { $running{$_} } @run; my $tag = $running[0] or die; close $running{ $tag }; printf "$tag: %s\n", ($?) ? "FAILED" : "pass"; push @fail, $tag if $?; delete $running{$tag}; } } print "Skipped due to $_: @{ $skipped{$_} }\n" for keys %skipped; printf "Failed %d out of %d: @fail\n", scalar @fail, $tested; print "done.\n" DBD-Oracle-1.74/Todo0000644000175000017500000000634512326332111013411 0ustar yanickyanick[ In no particular order ] **************************** NOTE: ora_db_shutdown/ora_dv_startup/StrictlyType/DiscardString not documented User requested a document/link anywhere that details what Oracle client attributes are supported and which are not for Oracle 11g and interacting with a RAC and using things like TAF, FAN, etc... Seems this file has been neglected for quite a while so I will try to keep it up to date for now For release 1.26 or later Add support for TAF Add support for New Lob Functions Add support for Statement Cacheing Add support for callbacks?? Drop support for ProC connections For release 1.22 or later --> done 1.22Drop support for Oralce 8 and earlier add support for $dbh->trace('SQL'); Replace OCIInitialize + OCIEnvInit, with OCIEnvCreate --> done 1.22 dbd_verbose ora_verbose Add in the DBD only debugging flag --> done 1.22 Add new method oci_exe_mode to get the Name of the Execution Modes Add support for OCIClientVersion(),OCIPing(),OCIServerVersion() -->done 1.22 Expand support for Data Interface for Persistent LOBs by setting up support for Piecewise Fetch and Piecewise Fetch with Callback and perhaps Array Fetch as well Add support for version 2 of lob functions Add support for OCIStmtPrepare2(), Statement caching The below might of been done but this list has not been maintained; Add column_info test Add info about getting help - mailing lists etc. Public Oracle docs: http://www.csis.gvsu.edu/GeneralInfo/Oracle/nav/docindex.htm LOBs http://www.csis.gvsu.edu/GeneralInfo/Oracle/appdev.920/a96595/dci06mlt.htm http://technet.oracle.com/tech/oci/htdocs/faq.html#1000425 Convert most of test.pl into standard t/*.t tests. Record ORACLE_HOME when building (auto::DBD::Oracle::mk) Check emails from Oracle about that. Check fix for unassigned placeholder (alen==SvLEN) can't be triggered by a valid assignment that's exactly that long. Resolve imp_sth->stmt_type != OCI_STMT_SELECT issue - add an attribute for it? connect with $user = "/ as sysdba" etc as per SQL*Plus Move urls from README into Oracle.pm Change all uses of perl global na (SvPV & sv_2pv) to local variables for better thread safety. Test script for bind type / field type / length / null interactions of char/varchar types. add docs about OPS$ login Add hint about SQL*Plus commands if execute gets an ORA-0900 invalid SQL statement? Maybe just if common SQL*Plus command word is first word. Support SERVICE_NAME in new connect syntax (allow inplace of SID) warn (trace_msg?) if ORACLE_HOME changes after first connect relates to Apache::DBI scenario where changing ORACLE_HOME upsets existing connections. PRECISION for oci7 on VARCHAR etc Detect "Error while trying to retrieve text for error ORA-XXXX" and add "refer to oracle docs or use 'oerr ora XXXX'". blob_read for oci8 with LONGs $sth = $dbh->prepare("select ... for update"); $dbh->commit; $sth->execute; # fails ? auto-re-prepare? ora_bind() failed err = ORA-01026: multiple buffers of size > 4000 in the bind list (DBD: oexec error) http://outside.organic.com/mail-archives/dbi-users/Nov1997/0116.html Handle PL/SQL arrays. Non-blocking Tests: RAW types at max length http://www.oracle-users.com/html/freeware.html http://freespace.virgin.net/j.hatcher/ociwrap.htm DBD-Oracle-1.74/dbdimp.h0000644000175000017500000004016512326332111014167 0ustar yanickyanick/* Copyright (c) 1994-2006 Tim Bunce Copyright (c) 2006-2008 John Scoles (The Pythian Group), Canada See the COPYRIGHT section in the Oracle.pm file for terms. */ /* ====== define data types ====== */ typedef struct taf_callback_st taf_callback_t; struct taf_callback_st { SV *function; /*User supplied TAF functiomn*/ SV *dbh_ref; }; typedef struct imp_fbh_st imp_fbh_t; struct imp_drh_st { dbih_drc_t com; /* MUST be first element in structure */ OCIEnv *envhp; SV *ora_long; SV *ora_trunc; SV *ora_cache; SV *ora_cache_o; /* for ora_open() cache override */ }; /* Define dbh implementor data structure */ struct imp_dbh_st { dbih_dbc_t com; /* MUST be first element in structure */ #ifdef USE_ITHREADS int refcnt ; /* keep track of duped handles. MUST be first after com */ struct imp_dbh_st * shared_dbh ; /* pointer to shared space from which to dup and keep refcnt */ SV * shared_dbh_priv_sv ; #endif void *(*get_oci_handle) _((imp_dbh_t *imp_dbh, int handle_type, int flags)); OCIEnv *envhp; /* copy of drh pointer */ OCIError *errhp; OCIServer *srvhp; OCISvcCtx *svchp; OCISession *seshp; #ifdef ORA_OCI_112 OCIAuthInfo *authp; OCISPool *poolhp; text *pool_name; ub4 pool_namel; bool using_drcp; text *pool_class; ub4 pool_classl; ub4 pool_min; ub4 pool_max; ub4 pool_incr; char *driver_name;/*driver name user defined*/ #endif SV *taf_function; /*User supplied TAF functiomn*/ taf_callback_t taf_ctx; char *client_info; /*user defined*/ ub4 client_infol; char *module_name; /*module user defined */ ub4 module_namel; char *client_identifier; /*user defined*/ ub4 client_identifierl; char *action; /*user defined*/ ub4 actionl; int RowCacheSize; /* both of these are defined by DBI spec*/ int RowsInCache; /* this vaue is RO and cannot be set*/ int ph_type; /* default oratype for placeholders */ ub1 ph_csform; /* default charset for placeholders */ int parse_error_offset; /* position in statement of last error */ int max_nested_cursors; /* limit on cached nested cursors per stmt */ int array_chunk_size; /* the max size for an array bind */ ub4 server_version; /* version of Oracle server */ }; #define DBH_DUP_OFF sizeof(dbih_dbc_t) #define DBH_DUP_LEN (sizeof(struct imp_dbh_st) - sizeof(dbih_dbc_t)) typedef struct lob_refetch_st lob_refetch_t; /* Define sth implementor data structure */ /*statement structure */ struct imp_sth_st { dbih_stc_t com; /* MUST be first element in structure */ void *(*get_oci_handle) _((imp_sth_t *imp_sth, int handle_type, int flags)); OCIEnv *envhp; /* copy of dbh pointer */ OCIError *errhp; /* copy of dbh pointer */ OCIServer *srvhp; /* copy of dbh pointer */ OCISvcCtx *svchp; /* copy of dbh pointer */ OCIStmt *stmhp; /* oci statement handle */ OCIDescribe *dschp; /* oci describe handle */ int is_child; /* if this is child from a ref cursor or SP*/ ub2 stmt_type; /* OCIAttrGet OCI_ATTR_STMT_TYPE */ U16 auto_lob; /* use auto lobs*/ int pers_lob; /*use dblink for lobs only for 10g Release 2. or later*/ int clbk_lob; /*use dblink for lobs only for 10g Release 2. or later*/ int piece_lob; /*use piece fetch for lobs*/ ub4 piece_size; /*used in callback to set the size of the piece to get*/ int has_lobs; /*Statement has bound LOBS */ int ret_lobs; /*Statement returns LOBS */ lob_refetch_t *lob_refetch; int nested_cursor; /* cursors fetched from SELECTs */ AV *bind_tuples; /* Bind tuples in array execute, or NULL */ int rowwise; /* If true, bind_tuples is list of */ /* tuples, otherwise list of columns. */ /* Input Details */ char *statement; /* sql (see sth_scan) */ HV *all_params_hv; /* all params, keyed by name */ AV *out_params_av; /* quick access to inout params */ int ora_pad_empty; /* convert ""->" " when binding */ /* Select Column Output Details */ int done_desc; /* have we described this sth yet ? */ imp_fbh_t *fbh; /* array of imp_fbh_t structs */ char *fbh_cbuf; /* memory for all field names */ int t_dbsize; /* raw data width of a row */ UV long_readlen; /* local copy to handle oraperl */ HV *fbh_tdo_hv; /* hash of row #(0 based) and tdo object name from ora_oci_type_names hash */ /* Select Row Cache Details */ sb4 cache_rows; int in_cache; int next_entry; int eod_errno; int est_width; /* est'd avg row width on-the-wire */ /* (In/)Out Parameter Details */ bool has_inout_params; /* execute mode*/ /* will be using this alot later me thinks */ ub4 exe_mode; /* fetch scrolling values */ int fetch_orient; int fetch_offset; int fetch_position; int prefetch_memory; /* OCI_PREFETCH_MEMORY*/ int prefetch_rows; /* OCI_PREFETCH_ROWS */ /* array fetch: state variables */ int row_cache_off; int rs_fetch_count; /*fetch count*/ int rs_array_size; /*array size local value for RowCacheSize as I do not want to change RowCacheSize */ int rs_array_num_rows; /* num rows in last fetch */ int rs_array_idx; /* index of current row */ sword rs_array_status; /* status of last fetch */ int RowCacheSize; /* both of these are defined by DBI spec*/ int RowsInCache; /* this vaue is RO and cannot be set*/ }; #define IMP_STH_EXECUTING 0x0001 typedef struct fb_ary_st fb_ary_t; /* field buffer array */ struct fb_ary_st { /* field buffer array EXPERIMENTAL */ ub4 bufl; /* length of data buffer */ ub4 cb_bufl; /* length of piece of data fetched in callback.*/ ub4 piece_count;/*# of pieces retrieved*/ sb2 *aindp; /* null/trunc indicator variable */ ub1 *abuf; /* data buffer (points to sv data) */ ub1 *cb_abuf; /*yet another buffer for picewise callbacks this means I only need to allocate memory once a prepare rather than at each fetch*/ ub2 *arlen; /* length of returned data */ ub2 *arcode; /* field level error status */ }; typedef struct fbh_obj_st fbh_obj_t; /*Ebbedded Object Descriptor */ struct fbh_obj_st { /* embedded object or table will work recursively*/ text *type_name; /*object's name (TDO)*/ ub4 type_namel; /*length of the name*/ OCIParam *parmdp; /*Describe attributes of the object OCI_DTYPE_PARAM*/ OCIParam *parmap; /*Describe attributes of the object OCI_ATTR_COLLECTION_ELEMENT OCI_ATTR_PARAM*/ OCIType *tdo; /*object's TDO handle */ OCITypeCode typecode; /*object's OOCI_ATTR_TYPECODE */ OCITypeCode col_typecode; /*if collection this is its OCI_ATTR_COLLECTION_TYPECODE */ OCITypeCode element_typecode; /*if collection this is its element's OCI_ATTR_TYPECODE*/ OCIRef *obj_ref; /*if an embeded object this is ref handle to its TDO*/ OCIInd *obj_ind; /*Null indictator for object */ OCIComplexObject *obj_value; /*the actual value from the DB*/ OCIType *obj_type; /*if an embeded object this is the OCIType returned by a OCIObjectPin*/ ub1 is_final_type; /*object's OCI_ATTR_IS_FINAL_TYPE*/ fbh_obj_t *fields; /*one object for each field/property*/ ub2 field_count; /*The number of fields Not really needed but nice to have*/ fbh_obj_t *next_subtype; /*There is strored information about subtypes for inteherited objects*/ AV *value; /*The value to send back to Perl This way there are no memory leaks*/ SV *full_type_name; /*Perl value of full type name = schema_name "." type_name*/ }; struct imp_fbh_st { /* field buffer EXPERIMENTAL */ imp_sth_t *imp_sth; /* 'parent' statement */ int field_num; /* 0..n-1 */ /* Oracle's description of the field */ OCIParam *parmdp; OCIDefine *defnp; void *desc_h; /* descriptor if needed (LOBs, cursors etc) */ ub4 desc_t; /* OCI type of descriptor */ ub4 define_mode; /*the normal case for a define*/ int (*fetch_func) _((SV *sth, imp_fbh_t *fbh, SV *dest_sv)); void (*fetch_cleanup) _((SV *sth, imp_fbh_t *fbh)); ub2 dbtype; /* actual type of field (see ftype) */ ub2 dbsize; ub2 prec; /* XXX docs say ub1 but ub2 is needed */ sb1 scale; ub1 nullok; char *name; SV *name_sv; /* only set for OCI8 */ /* OCI docs say OCI_ATTR_CHAR_USED is ub4, they're wrong */ ub1 len_char_used; /* OCI_ATTR_CHAR_USED */ ub2 len_char_size; /* OCI_ATTR_CHAR_SIZE */ ub2 csid; /* OCI_ATTR_CHARSET_ID */ ub1 csform; /* OCI_ATTR_CHARSET_FORM */ ub4 disize; /* max display/buffer size */ ub4 piece_size; /*used in callback to set the size of the piece to get*/ char *bless; /* for Oracle::OCI style handle data */ void *special; /* hook for special purposes (LOBs etc) */ int pers_lob; /*for persistant lobs 10g Release 2. or later*/ int clbk_lob; /*for persistant lobs 10g Release 2. or later*/ int piece_lob; /*use piecewise fetch for lobs*/ /* Our storage space for the field data as it's fetched */ sword ftype; /* external datatype we wish to get */ IV req_type; /* type passed to bind_col */ UV bind_flags; /* flags passed to bind_col */ fb_ary_t *fb_ary ; /* field buffer array */ /* if this is an embedded object we use this */ fbh_obj_t *obj; }; /* Placeholder structure */ /* Note: phs_t is serialized into scalar value, and de-serialized then. */ /* Be carefull! */ typedef struct phs_st phs_t; /* scalar placeholder */ struct phs_st { /* scalar placeholder EXPERIMENTAL */ imp_sth_t *imp_sth; /* 'parent' statement */ sword ftype; /* external OCI field type */ SV *sv; /* the scalar holding the value */ U32 sv_type; /* original sv type at time of bind */ ub2 csid_orig; /* original oracle default csid */ ub2 csid; /* 0 for automatic */ ub1 csform; /* 0 for automatic */ ub4 maxdata_size; /* set OCI_ATTR_MAXDATA_SIZE if >0 */ bool is_inout; IV maxlen; /* max possible len (=allocated buffer) */ /* Note: for array bind = buffer for each entry */ OCIBind *bndhp; void *desc_h; /* descriptor if needed (LOBs etc) */ ub4 desc_t; /* OCI type of desc_h */ ub4 alen; ub2 arcode; int idx; /* 0-based index for ?/:1 style, or -1 */ sb2 indp; /* null indicator */ char *progv; int(*out_prepost_exec)_((SV *, imp_sth_t *, phs_t *, int pre_exec)); SV *ora_field; /* from attribute (for LOB binds) */ ub4 alen_incnull; /* 0 or 1 if alen should include null */ /* Array bind support */ char *array_buf; /* Temporary buffer = malloc(array_buflen) */ int array_buflen; /* Allocated length of array_buf */ int array_numstruct; /* Number of bound structures in buffer */ OCIInd *array_indicators; /* Indicator array = malloc( array_numallocated * sizeof(OCIInd) ) */ unsigned short *array_lengths; /* Array entries lengths = malloc( array_numallocated * sizeof(unsigned short) ) */ int array_numallocated; /* Allocated number of indicators/lengths */ int ora_maxarray_numentries; /* Number of entries to send allocated to Oracle. (may be less, than total allocated) */ /* Support for different internal C-types, representing Oracle data */ int ora_internal_type; /* Which C-type would be bound instead of SQLT_CHR. */ char name[1]; /* struct is malloc'd bigger as needed */ }; /* ------ define functions and external variables ------ */ extern int ora_fetchtest; extern int dbd_verbose; extern int oci_warn; extern int ora_objects; extern int ora_ncs_buff_mtpl; extern ub2 charsetid; extern ub2 ncharsetid; extern ub2 us7ascii_csid; extern ub2 utf8_csid; extern ub2 al32utf8_csid; extern ub2 al16utf16_csid; #define CS_IS_UTF8( cs ) \ ( ( cs == utf8_csid ) || ( cs == al32utf8_csid ) ) #define CS_IS_NOT_UTF8_COMPATIBLE( cs ) \ ( cs == us7ascii_csid ) #define CS_IS_UTF16( cs ) ( cs == al16utf16_csid ) #define CSFORM_IMPLIED_CSID(csform) \ ((csform==SQLCS_NCHAR) ? ncharsetid : charsetid) #define CSFORM_IMPLIES_UTF8(csform) \ CS_IS_UTF8( CSFORM_IMPLIED_CSID( csform ) ) void dbd_init_oci _((dbistate_t *dbistate)); void dbd_preparse _((imp_sth_t *imp_sth, char *statement)); void dbd_fbh_dump(imp_sth_t *imp_sth, imp_fbh_t *fbh, int i, int aidx); void ora_free_fbh_contents _((SV *sth, imp_fbh_t *fbh)); void ora_free_templob _((SV *sth, imp_sth_t *imp_sth, OCILobLocator *lobloc)); int ora_dbtype_is_long _((int dbtype)); fb_ary_t *fb_ary_alloc _((ub4 bufl, int size)); fb_ary_t *fb_ary_cb_alloc _((ub4 piece_size,ub4 max_len, int size)); int ora_db_reauthenticate _((SV *dbh, imp_dbh_t *imp_dbh, char *uid, char *pwd)); void dbd_phs_sv_complete _((imp_sth_t *imp_sth, phs_t *phs, SV *sv, I32 debug)); void dbd_phs_avsv_complete _((imp_sth_t *imp_sth, phs_t *phs, I32 index, I32 debug)); int pp_exec_rset _((SV *sth, imp_sth_t *imp_sth, phs_t *phs, int pre_exec)); int pp_rebind_ph_rset_in _((SV *sth, imp_sth_t *imp_sth, phs_t *phs)); #define OTYPE_IS_LONG(t) ((t)==8 || (t)==24 || (t)==94 || (t)==95) int oci_error_err _((SV *h, OCIError *errhp, sword status, char *what, sb4 force_err)); #define oci_error(h, errhp, status, what) oci_error_err(h, errhp, status, what, 0) char *oci_stmt_type_name _((int stmt_type)); char *oci_typecode_name _((int typecode)); char *sql_typecode_name _((int dbtype)); char *oci_status_name _((sword status)); char *oci_mode _((ub4 mode)); char *oci_bind_options _((ub4 options)); char *oci_define_options _((ub4 options)); char *oci_hdtype_name _((ub4 hdtype)); char *oci_attr_name _((ub4 attr)); char *oci_exe_mode _((ub4 mode)); char *dbd_yes_no _((int yes_no)); char *oci_col_return_codes _((int rc)); char *oci_csform_name _((ub4 attr)); /*char *oci_sql_function_code_name _((int sqlfncode)); char *oci_ptype_name _((int ptype));*/ int dbd_rebind_ph_lob _((SV *sth, imp_sth_t *imp_sth, phs_t *phs)); int dbd_rebind_ph_nty _((SV *sth, imp_sth_t *imp_sth, phs_t *phs)); int ora_st_execute_array _((SV *sth, imp_sth_t *imp_sth, SV *tuples, SV *tuples_status, SV *columns, ub4 exe_count, SV *err_count)); SV * ora_create_xml _((SV *dbh, char *source)); void ora_free_lob_refetch _((SV *sth, imp_sth_t *imp_sth)); void dbd_phs_avsv_complete _((imp_sth_t *imp_sth, phs_t *phs, I32 index, I32 debug)); void dbd_phs_sv_complete _((imp_sth_t *imp_sth, phs_t *phs, SV *sv, I32 debug)); int post_execute_lobs _((SV *sth, imp_sth_t *imp_sth, ub4 row_count)); ub4 ora_parse_uid _((imp_dbh_t *imp_dbh, char **uidp, char **pwdp)); char *ora_sql_error _((imp_sth_t *imp_sth, char *msg)); char *ora_env_var(char *name, char *buf, unsigned long size); #ifdef __CYGWIN32__ void ora_cygwin_set_env(char *name, char *value); #endif /* __CYGWIN32__ */ sb4 dbd_phs_in _((dvoid *octxp, OCIBind *bindp, ub4 iter, ub4 index, dvoid **bufpp, ub4 *alenp, ub1 *piecep, dvoid **indpp)); sb4 dbd_phs_out _((dvoid *octxp, OCIBind *bindp, ub4 iter, ub4 index, dvoid **bufpp, ub4 **alenpp, ub1 *piecep, dvoid **indpp, ub2 **rcodepp)); sb4 presist_lob_fetch_cbk _((dvoid *octxp, OCIDefine *dfnhp, ub4 iter, dvoid **bufpp, ub4 **alenpp, ub1 *piecep, dvoid **indpp, ub2 **rcpp)); int dbd_rebind_ph_rset _((SV *sth, imp_sth_t *imp_sth, phs_t *phs)); void * oci_db_handle(imp_dbh_t *imp_dbh, int handle_type, int flags); void * oci_st_handle(imp_sth_t *imp_sth, int handle_type, int flags); void fb_ary_free(fb_ary_t *fb_ary); void rs_array_init(imp_sth_t *imp_sth); ub4 ora_db_version _((SV *dbh, imp_dbh_t *imp_dbh)); sb4 reg_taf_callback _((SV *dbh, imp_dbh_t *imp_dbh)); /* These defines avoid name clashes for multiple statically linked DBD's */ #define dbd_init ora_init #define dbd_db_login ora_db_login #define dbd_db_login6 ora_db_login6 #define dbd_db_do ora_db_do #define dbd_db_commit ora_db_commit #define dbd_db_rollback ora_db_rollback #define dbd_db_cancel ora_db_cancel #define dbd_db_disconnect ora_db_disconnect #define dbd_db_destroy ora_db_destroy #define dbd_db_STORE_attrib ora_db_STORE_attrib #define dbd_db_FETCH_attrib ora_db_FETCH_attrib #define dbd_st_prepare ora_st_prepare #define dbd_st_rows ora_st_rows #define dbd_st_cancel ora_st_cancel #define dbd_st_execute ora_st_execute #define dbd_st_fetch ora_st_fetch #define dbd_st_finish ora_st_finish #define dbd_st_destroy ora_st_destroy #define dbd_st_blob_read ora_st_blob_read #define dbd_st_STORE_attrib ora_st_STORE_attrib #define dbd_st_FETCH_attrib ora_st_FETCH_attrib #define dbd_describe ora_describe #define dbd_bind_ph ora_bind_ph #define dbd_st_bind_col ora_st_bind_col #include "ocitrace.h" /* end */ DBD-Oracle-1.74/hints/0000775000175000017500000000000012326332111013700 5ustar yanickyanickDBD-Oracle-1.74/hints/macos_syms.pl0000644000175000017500000001172412326332111016415 0ustar yanickyanick#!/usr/bin/perl -w use strict; # # Perl program that *should* generate a list of duplicate symbols # between DBD::Oracle and Oracle client library. It produces useful # output as-is, but it's not a general solution as it forces a # symbol in that isn't reported, and eliminates a bunch of symbols # that can't be removed for one reason or another. # # This file may prove useful in the long run as a starting point, so # I've included it. # my %unstrippable = map { $_ => 1 } qw( _OCIAttrGet _OCIAttrSet _OCIBindByName _OCIBindDynamic _OCIBreak _OCIDefineByPos _OCIDescribeAny _OCIDescriptorAlloc _OCIDescriptorFree _OCIEnvInit _OCIErrorGet _OCIHandleAlloc _OCIHandleFree _OCIInitialize _OCILobGetLength _OCILobFileClose _OCILobFileOpen _OCILobRead _OCILobTrim _OCILobWrite _OCIParamGet _OCIServerAttach _OCIServerDetach _OCISessionBegin _OCISessionEnd _OCIStmtExecute _OCIStmtFetch _OCIStmtPrepare _OCITransCommit _OCITransRollback __dyld_func_lookup _atoi _fprintf _fwrite _getenv _kgefac_ _kgesec0 _korfpoid _kotgtivn _kpgdcd _kpggGetPG _kpugsqlt _kpumfs _kpumgs _kpummLtsCtx _kpusc _kpuscn _kpuucf _kpuuch _lmsagbf _lmsaicmt _lstmup _ltsmxd _ltstidd _lxhLangEnv _lxhci2h _lxhnsize _lxlterm _lxsCnvCase _main _memcmp _memcpy _memset _ociepgoe _sprintf _strcasecmp _strcat _strchr _strcpy _strlen _strncpy _ttckpu _upiacp0 _upigdl _upihst _upioep _upirtr _upirtrc dyld_func_lookup_pointer dyld_lazy_symbol_binding_entry_point dyld_stub_binding_helper ); print "_main\n"; #print "_dlsym\n"; #print "\n\n"; my %oracle; open FH,'nm /Users/oracle/9iR2/orahome/lib/libclntsh.dylib.9.0 |'; while ( ) { unless ( /^\// || /^\n/ ) { s/...........(\w+)\n/$1/; $oracle{$_} = 1; } } close FH; open FH,'nm ../blib/arch/auto/DBD/Oracle/Oracle.bundle |'; while ( ) { unless ( /^\// || /^\n/ ) { s/...........(\w+)\n/$1/; if ( exists($oracle{$_}) && ! exists($unstrippable{$_}) ) { print "$_\n"; } } } close FH; DBD-Oracle-1.74/hints/macos_bundle.syms0000644000175000017500000000030612326332111017245 0ustar yanickyanick_main _kpuach _kpuasav _kpucer _kpudbcx _kpudc _kpudcx _kpuddb _kpudex _kpudsc _kpuexes _kpugbccx _kpugbncx _kpugc _kpugdcx _kpugml _kpuic _kpuicx _kpulsc _kpumcf _kpusdl _kpusdt _kpusnchr _kpusvar DBD-Oracle-1.74/hints/macos_lib.syms0000644000175000017500000000002712326332111016542 0ustar yanickyanick_dlsym _dlclose _poll DBD-Oracle-1.74/hints/dgux.pl0000644000175000017500000000050212326332111015177 0ustar yanickyanickmy $archname = $Config::Config{archname} || die; $att{LIBS} ||= []; $att{LIBS}->[0] ||= ''; push @libs, '-lc', '-lm'; warn "$^O LIBS attribute defaulted to '$att{LIBS}->[0]' for '$archname'"; $att{LIBS}->[0] .= " ".join(" ", @libs); # append libs warn "$^O LIBS attribute updated to '$att{LIBS}->[0]'"; __END__ DBD-Oracle-1.74/hints/svr4.pl0000644000175000017500000001147012326332111015134 0ustar yanickyanickmy $archname = $Config::Config{archname} || die; $att{LIBS} ||= []; $att{LIBS}->[0] ||= ''; # Some SVR4 systems may need to link against -lc to pick up things like # fpsetmask, sys_nerr and ecvt. my @libs = qw(-lsocket -lnsl -lm -ldl); # general svr4 default # modified by Davide Migliavacca if ($archname eq 'RM400-svr4') { @libs = qw(-lucb); } push @libs, '-lc'; warn "$^O LIBS attribute defaulted to '$att{LIBS}->[0]' for '$archname'"; $att{LIBS}->[0] .= " ".join(" ", @libs); # append libs warn "$^O LIBS attribute updated to '$att{LIBS}->[0]'"; __END__ From doughera@lafcol.lafayette.edu Mon Aug 21 07:01:51 1995 Date: Fri, 18 Aug 1995 15:33:22 -0400 (EDT) From: Andy Dougherty Subject: Re: [MM] Re: hints file for Oracle To: Tim Bunce In-Reply-To: <9508181853.ab12333@post.demon.co.uk> Mime-Version: 1.0 Content-Type: TEXT/PLAIN; charset=US-ASCII On Fri, 18 Aug 1995, Tim Bunce wrote: > > From: Alan Burlison > > > > Tim, > > > > The following hints file is required for DBD::Oracle on svr4, you might > > like to add it to the next release :-) > > > > File: Oracle/hints/svr4.pl > > > > # Some SVR4 systems may need to link against -lc to pick up things like > > $att{LIBS} = [ '-lsocket -lnsl -lm -ldl -lc' ]; > > Umm, 'some', 'may', 'things like'. Care to clarify? > > Why _exactly_ is this needed, and why doesn't MakeMaker do this already? > (CC'd to the MakeMaker mailing list.) That looks like a bad editing of the ODBM_File/hints/svr4.pl: ########################## hints/svr4.pl ######################### # Some SVR4 systems may need to link against routines in -lucb for # odbm. Some may also need to link against -lc to pick up things like # ecvt. $att{LIBS} = ['-ldbm -lucb -lc']; ################################################################### "Some" includes Unisys 6000 (or something like that). I don't know if it includes anything else. It doesn't include Unixware 2.1, but it might include Esix. It's *really* hard to get accurate info. "May" because some do and some don't, and any listing gets out of date quickly as vendors issue different versions, and probably more than half the info you *do* get about specific versions is wrong. Hence all the vague weasel-words. "Things like" is ecvt() for Unisys (for ODBM_File). Since some linkers only report the first missing symbol, it's sometimes hard (and sometimes pointless) to get a complete list of things that you need). Basically, there are *many* SVR4-derived systems out there, and there are many little idiosyncracies; the best bet is to put someone else's name and email address in the hint file so you can blame them :-). Andy Dougherty doughera@lafcol.lafayette.edu From: Tye McQueen Subject: Re: [MM] Re: hints file for Oracle Date: Fri, 18 Aug 1995 16:01:39 -0500 (CDT) Cc: aburlison@cix.compulink.co.uk, perldb-interest@vix.com, makemaker@franz.ww.tu-berlin.de Excerpts from the mail message of Tim Bunce: ) > From: Alan Burlison ) > ) > The following hints file is required for DBD::Oracle on svr4, you might ) > like to add it to the next release :-) ) > ) > File: Oracle/hints/svr4.pl ) > ) > # Some SVR4 systems may need to link against -lc to pick up things like ) > $att{LIBS} = [ '-lsocket -lnsl -lm -ldl -lc' ]; ) ) Umm, 'some', 'may', 'things like'. Care to clarify? ) ) Why _exactly_ is this needed, and why doesn't MakeMaker do this already? ) (CC'd to the MakeMaker mailing list.) ) ) Is anyone else using DBD::Oracle on an svr4 system (not solaris 2)? That looks like something I wrote. I'll take credit and blame for it at least for the sake of the next paragraph. So far "some" is only whatever Unisys system Alan and one other person have used. "may" is because, as far as I could tell from my end, some of the dynamically loaded extensions worked okay before this fix but one of them didn't. "thinks like" must be because I couldn't remember which routine was not being found and then forgot to finish my sentence. I think it was _ecvt(). The description is very vague because it doesn't make sense to me why it is needed and I don't have access to a system to play around with it if I really wanted to try to figure it out. But it seems to fix the few problems it addresses and have not heard of it hurting anything yet (and I've tested it on my machines). I'm putting together a README.svr4 for Perl that will describe this and many other things in case people are curious or run into a problem and need to know why some of the strange things were done. -- Tye McQueen tye@metronet.com || tye@doober.usu.edu Nothing is obvious unless you are overlooking something http://www.metronet.com/~tye/ (scripts, links, nothing fancy) DBD-Oracle-1.74/dbdimp.c0000644000175000017500000043705012326332111014165 0ustar yanickyanick/* vim: sw=4:ts=8 dbdimp.c Copyright (c) 1994-2006 Tim Bunce Ireland Copyright (c) 2006-2008 John Scoles (The Pythian Group), Canada See the COPYRIGHT section in the Oracle.pm file for terms. */ #ifdef WIN32 #define strcasecmp strcmpi #endif #ifdef __CYGWIN32__ #include "w32api/windows.h" #include "w32api/winbase.h" #endif /* __CYGWIN32__ */ #include "Oracle.h" /* XXX DBI should provide a better version of this */ #define IS_DBI_HANDLE(h) \ (SvROK(h) && SvTYPE(SvRV(h)) == SVt_PVHV && \ SvRMAGICAL(SvRV(h)) && (SvMAGIC(SvRV(h)))->mg_type == 'P') #ifndef SvPOK_only_UTF8 #define SvPOK_only_UTF8(sv) SvPOK_only(sv) #endif DBISTATE_DECLARE; int ora_fetchtest; /* internal test only, not thread safe */ int is_extproc = 0; /* not ProC but ExtProc.pm */ int dbd_verbose = 0; /* DBD only debugging*/ int oci_warn = 0; /* show oci warnings */ int ora_objects = 0; /* get oracle embedded objects as instance of DBD::Oracle::Object */ int ora_ncs_buff_mtpl = 4; /* a mulitplyer for ncs clob buffers */ /* bitflag constants for figuring out how to handle utf8 for array binds */ #define ARRAY_BIND_NATIVE 0x01 #define ARRAY_BIND_UTF8 0x02 #define ARRAY_BIND_MIXED (ARRAY_BIND_NATIVE|ARRAY_BIND_UTF8) ub2 charsetid = 0; ub2 ncharsetid = 0; ub2 us7ascii_csid = 1; ub2 utf8_csid = 871; ub2 al32utf8_csid = 873; ub2 al16utf16_csid = 2000; typedef struct sql_fbh_st sql_fbh_t; struct sql_fbh_st { int dbtype; int prec; int scale; }; static sql_fbh_t ora2sql_type _((imp_fbh_t* fbh)); static void disable_taf(imp_dbh_t *imp_dbh); static int enable_taf(SV *dbh, imp_dbh_t *imp_dbh); void ora_free_phs_contents _((imp_sth_t *imp_sth, phs_t *phs)); static void dump_env_to_trace(imp_dbh_t *imp_dbh); static sb4 oci_error_get(imp_xxh_t *imp_xxh, OCIError *errhp, sword status, char *what, SV *errstr, int debug) { dTHX; text errbuf[1024]; ub4 recno = 0; sb4 errcode = 0; sb4 eg_errcode = 0; sword eg_status; if (!SvOK(errstr)) sv_setpv(errstr,""); if (!errhp) { sv_catpv(errstr, oci_status_name(status)); if (what) { sv_catpv(errstr, " "); sv_catpv(errstr, what); } return status; } while( ++recno && OCIErrorGet_log_stat(imp_xxh, errhp, recno, (text*)NULL, &eg_errcode, errbuf, (ub4)sizeof(errbuf), OCI_HTYPE_ERROR, eg_status) != OCI_NO_DATA && eg_status != OCI_INVALID_HANDLE && recno < 100 ) { if (debug >= 4 || recno>1/*XXX temp*/ || dbd_verbose >= 4 ) PerlIO_printf(DBIc_LOGPIO(imp_xxh), " OCIErrorGet after %s (er%ld:%s): %d, %ld: %s\n", what ? what : "", (long)recno, (eg_status==OCI_SUCCESS) ? "ok" : oci_status_name(eg_status), status, (long)eg_errcode, errbuf); errcode = eg_errcode; sv_catpv(errstr, (char*)errbuf); if (*(SvEND(errstr)-1) == '\n') --SvCUR(errstr); } if (what || status != OCI_ERROR) { sv_catpv(errstr, (debug<0) ? " (" : " (DBD "); sv_catpv(errstr, oci_status_name(status)); if (what) { sv_catpv(errstr, ": "); sv_catpv(errstr, what); } sv_catpv(errstr, ")"); } return errcode; } static int GetRegKey(char *key, char *val, char *data, unsigned long *size) { #ifdef WIN32 unsigned long len = *size - 1; HKEY hKey; long ret; ret = RegOpenKeyEx(HKEY_LOCAL_MACHINE, key, 0, KEY_QUERY_VALUE, &hKey); if (ret != ERROR_SUCCESS) return 0; ret = RegQueryValueEx(hKey, val, NULL, NULL, data, size); RegCloseKey(hKey); if ((ret != ERROR_SUCCESS) || (*size >= len)) return 0; return 1; #else /* For gcc not to warn on unused parameters. */ if( key ){} if( val ){} if( data ){} if( size ){} return 0; #endif } char * ora_env_var(char *name, char *buf, unsigned long size) { #define WIN32_REG_BUFSIZE 80 dTHX; char last_home_id[WIN32_REG_BUFSIZE+1]; char ora_home_key[WIN32_REG_BUFSIZE+1]; unsigned long len = WIN32_REG_BUFSIZE; char *e = getenv(name); if (e) return e; if (!GetRegKey("SOFTWARE\\ORACLE\\ALL_HOMES", "LAST_HOME", last_home_id, &len)) return Nullch; last_home_id[2] = 0; sprintf(ora_home_key, "SOFTWARE\\ORACLE\\HOME%s", last_home_id); size -= 1; /* allow room for null termination */ if (!GetRegKey(ora_home_key, name, buf, &size)) return Nullch; buf[size] = 0; return buf; } #ifdef __CYGWIN32__ /* Under Cygwin there are issues with setting environment variables * at runtime such that Windows-native libraries loaded by a Cygwin * process can see those changes. * * Cygwin maintains its own cache of environment variables, and also * only writes to the Windows environment using the "_putenv" win32 * call. This call writes to a Windows C runtime cache, rather than * the true process environment block. * * In order to change environment variables so that the Oracle client * DLL can see the change, the win32 function SetEnvironmentVariable * must be called. This function gives an interface to that API. * * It is only available when building under Cygwin, and is used by * the testsuite. * * Whilst it could be called by end users, it should be used with * caution, as it bypasses the environment variable conversions that * Cygwin typically performs. */ void ora_cygwin_set_env(char *name, char *value) { SetEnvironmentVariable(name, value); } #endif /* __CYGWIN32__ */ void dbd_init(dbistate_t *dbistate) { dTHX; DBIS = dbistate; dbd_init_oci(dbistate); } int dbd_discon_all(SV *drh, imp_drh_t *imp_drh) { dTHR; dTHX; /* The disconnect_all concept is flawed and needs more work */ if (!PL_dirty && !SvTRUE(perl_get_sv("DBI::PERL_ENDING",0))) { DBIh_SET_ERR_CHAR(drh, (imp_xxh_t*)imp_drh, Nullch, 1, "disconnect_all not implemented", Nullch, Nullch); return FALSE; } return FALSE; } void dbd_fbh_dump(imp_sth_t *imp_sth, imp_fbh_t *fbh, int i, int aidx) { dTHX; PerlIO_printf(DBIc_LOGPIO(imp_sth), " fbh %d: '%s'\t%s, ", i, fbh->name, (fbh->nullok) ? "NULLable" : "NO null "); PerlIO_printf(DBIc_LOGPIO(imp_sth), "otype %3d->%3d, dbsize %ld/%ld, p%d.s%d\n", fbh->dbtype, fbh->ftype, (long)fbh->dbsize,(long)fbh->disize, fbh->prec, fbh->scale); if (fbh->fb_ary) { PerlIO_printf(DBIc_LOGPIO(imp_sth), " out: ftype %d, bufl %d. indp %d, rlen %d, rcode %d\n", fbh->ftype, fbh->fb_ary->bufl, fbh->fb_ary->aindp[aidx], fbh->fb_ary->arlen[aidx], fbh->fb_ary->arcode[aidx]); } } int ora_dbtype_is_long(int dbtype) { /* Is it a LONG, LONG RAW, LONG VARCHAR or LONG VARRAW type? */ /* Return preferred type code to use if it's a long, else 0. */ if (dbtype == 8 || dbtype == 24) /* LONG or LONG RAW */ return dbtype; /* --> same */ if (dbtype == 94) /* LONG VARCHAR */ return 8; /* --> LONG */ if (dbtype == 95) /* LONG VARRAW */ return 24; /* --> LONG RAW */ return 0; } static int oratype_bind_ok(int dbtype) /* It's a type we support for placeholders */ { /* basically we support types that can be returned as strings */ switch(dbtype) { case 1: /* VARCHAR2 */ case 2: /* NVARCHAR2 */ case 5: /* STRING */ case 8: /* LONG */ case 21: /* BINARY FLOAT os-endian */ case 22: /* BINARY DOUBLE os-endian */ case 23: /* RAW */ case 24: /* LONG RAW */ case 96: /* CHAR */ case 97: /* CHARZ */ case 100: /* BINARY FLOAT oracle-endian */ case 101: /* BINARY DOUBLE oracle-endian */ case 106: /* MLSLABEL */ case 102: /* SQLT_CUR OCI 7 cursor variable */ case 112: /* SQLT_CLOB / long */ case 113: /* SQLT_BLOB / long */ case 116: /* SQLT_RSET OCI 8 cursor variable */ case ORA_VARCHAR2_TABLE: /* 201 */ case ORA_NUMBER_TABLE: /* 202 */ case ORA_XMLTYPE: /* SQLT_NTY must be carefull here as its value (108) is the same for an embedded object Well realy only XML clobs not embedded objects */ return 1; } return 0; } #ifdef THIS_IS_NOT_CURRENTLY_USED static int oratype_rebind_ok(int dbtype) /* all are vrcar any way so just use it */ { /* basically we support types that can be returned as strings */ switch(dbtype) { case 1: /* VARCHAR2 */ case 2: /* NVARCHAR2 */ case 5: /* STRING */ case 8: /* LONG */ case 21: /* BINARY FLOAT os-endian */ case 22: /* BINARY DOUBLE os-endian */ case 23: /* RAW */ case 24: /* LONG RAW */ case 96: /* CHAR */ case 97: /* CHARZ */ case 100: /* BINARY FLOAT oracle-endian */ case 101: /* BINARY DOUBLE oracle-endian */ case 106: /* MLSLABEL */ case 102: /* SQLT_CUR OCI 7 cursor variable */ case 116: /* SQLT_RSET OCI 8 cursor variable */ case ORA_VARCHAR2_TABLE: /* 201 */ case ORA_NUMBER_TABLE: /* 202 */ case ORA_XMLTYPE: /* SQLT_NTY must be carefull here as its value (108) is the same for an embedded object Well realy only XML clobs not embedded objects */ case 113: /* SQLT_BLOB / long */ return SQLT_BIN; case 112: /* SQLT_CLOB / long */ return SQLT_CHR; } return dbtype; } #endif /* THIS_IS_NOT_CURRENTLY_USED */ /* --- allocate and free oracle oci 'array' buffers --- */ /* --- allocate and free oracle oci 'array' buffers for callback--- */ fb_ary_t * fb_ary_cb_alloc(ub4 piece_size, ub4 max_len, int size) { fb_ary_t *fb_ary; /* these should be reworked to only to one Newz() */ /* and setup the pointers in the head fb_ary struct */ Newz(42, fb_ary, sizeof(fb_ary_t), fb_ary_t); Newz(42, fb_ary->abuf, size * piece_size, ub1); Newz(42, fb_ary->cb_abuf, size * max_len, ub1); Newz(42, fb_ary->aindp,(unsigned)size,sb2); Newz(42, fb_ary->arlen,(unsigned)size,ub2); Newz(42, fb_ary->arcode,(unsigned)size,ub2); fb_ary->bufl = piece_size; fb_ary->cb_bufl = max_len; return fb_ary; } /* --- allocate and free oracle oci 'array' buffers --- */ fb_ary_t * fb_ary_alloc(ub4 bufl, int size) { fb_ary_t *fb_ary; /* these should be reworked to only to one Newz() */ /* and setup the pointers in the head fb_ary struct */ Newz(42, fb_ary, sizeof(fb_ary_t), fb_ary_t); Newz(42, fb_ary->abuf, size * bufl, ub1); Newz(42, fb_ary->aindp, (unsigned)size,sb2); Newz(42, fb_ary->arlen, (unsigned)size,ub2); Newz(42, fb_ary->arcode,(unsigned)size,ub2); fb_ary->bufl = bufl; /* fb_ary->cb_bufl = bufl;*/ return fb_ary; } void fb_ary_free(fb_ary_t *fb_ary) { Safefree(fb_ary->abuf); Safefree(fb_ary->aindp); Safefree(fb_ary->arlen); Safefree(fb_ary->arcode); Safefree(fb_ary->cb_abuf); Safefree(fb_ary); } /* ================================================================== */ int dbd_db_login(SV *dbh, imp_dbh_t *imp_dbh, char *dbname, char *uid, char *pwd) { return dbd_db_login6(dbh, imp_dbh, dbname, uid, pwd, Nullsv); } /* from shared.xs */ typedef struct { SV *sv; /* The actual SV - in shared space */ /* we don't need the following two */ /*recursive_lock_t lock; */ /*perl_cond user_cond;*/ /* For user-level conditions */ } shared_sv; int dbd_db_login6(SV *dbh, imp_dbh_t *imp_dbh, char *dbname, char *uid, char *pwd, SV *attr) { dTHR; dTHX; sword status; SV **svp; shared_sv * shared_dbh_ssv = NULL ; imp_dbh_t * shared_dbh = NULL ; D_imp_drh_from_dbh; ub2 new_charsetid = 0; ub2 new_ncharsetid = 0; int forced_new_environment = 0; #if defined(USE_ITHREADS) && defined(PERL_MAGIC_shared_scalar) SV ** shared_dbh_priv_svp ; SV * shared_dbh_priv_sv ; STRLEN shared_dbh_len = 0 ; #endif #ifdef ORA_OCI_112 /*check to see if the user is connecting with DRCP */ if (DBD_ATTRIB_TRUE(attr,"ora_drcp",8,svp)) imp_dbh->using_drcp = 1; /* some connection pool atributes */ if ((svp=DBD_ATTRIB_GET_SVP(attr, "ora_drcp_class", 14)) && SvOK(*svp)) { STRLEN svp_len; if (!SvPOK(*svp)) croak("ora_drcp_class is not a string"); imp_dbh->pool_class = (text *) SvPV (*svp, svp_len ); imp_dbh->pool_classl= (ub4) svp_len; } if (DBD_ATTRIB_TRUE(attr,"ora_drcp_min",12,svp)) DBD_ATTRIB_GET_IV( attr, "ora_drcp_min", 12, svp, imp_dbh->pool_min); if (DBD_ATTRIB_TRUE(attr,"ora_drcp_max",12,svp)) DBD_ATTRIB_GET_IV( attr, "ora_drcp_max", 12, svp, imp_dbh->pool_max); if (DBD_ATTRIB_TRUE(attr,"ora_drcp_incr",13,svp)) DBD_ATTRIB_GET_IV( attr, "ora_drcp_incr", 13, svp, imp_dbh->pool_incr); imp_dbh->driver_name = "DBD01.50_00"; #endif #ifdef ORA_OCI_112 OCIAttrSet_log_stat(imp_dbh, imp_dbh->seshp,OCI_HTYPE_SESSION, imp_dbh->driver_name, (ub4)strlen(imp_dbh->driver_name), OCI_ATTR_DRIVER_NAME,imp_dbh->errhp, status); #endif /* TAF Events */ if ((svp=DBD_ATTRIB_GET_SVP(attr, "ora_taf_function", 16)) && SvOK(*svp)) { if ((SvROK(*svp) && (SvTYPE(SvRV(*svp)) == SVt_PVCV)) || (SvPOK(*svp))) { imp_dbh->taf_function = newSVsv(*svp); } else { croak("ora_taf_function needs to be a string or code reference"); } /* avoid later STORE: */ /* See DBI::DBB problem with ATTRIB_DELETE until DBI 1.607 */ /* DBD_ATTRIB_DELETE(attr, "ora_taf_function", 16); */ (void)hv_delete((HV*)SvRV(attr), "ora_taf_function", 16, G_DISCARD); } imp_dbh->server_version = 0; /* check to see if DBD_verbose or ora_verbose is set*/ if (DBD_ATTRIB_TRUE(attr,"dbd_verbose",11,svp)) DBD_ATTRIB_GET_IV( attr, "dbd_verbose", 11, svp, dbd_verbose); if (DBD_ATTRIB_TRUE(attr,"ora_verbose",11,svp)) DBD_ATTRIB_GET_IV( attr, "ora_verbose", 11, svp, dbd_verbose); if (DBIc_DBISTATE(imp_dbh)->debug >= 6 || dbd_verbose >= 6 ) dump_env_to_trace(imp_dbh); /* dbi_imp_data code adapted from DBD::mysql */ if (DBIc_has(imp_dbh, DBIcf_IMPSET)) { /* dbi_imp_data from take_imp_data */ if (DBIc_has(imp_dbh, DBIcf_ACTIVE)) { if (DBIc_DBISTATE(imp_dbh)->debug >= 2 || dbd_verbose >= 3 ) PerlIO_printf(DBIc_LOGPIO(imp_dbh), "dbd_db_login6 skip connect\n"); /* tell our parent we've adopted an active child */ ++DBIc_ACTIVE_KIDS(DBIc_PARENT_COM(imp_dbh)); return 1; } /* not ACTIVE so connect not skipped */ if (DBIc_DBISTATE(imp_dbh)->debug >= 2 || dbd_verbose >= 3 ) PerlIO_printf(DBIc_LOGPIO(imp_dbh), "dbd_db_login6 IMPSET but not ACTIVE so connect not skipped\n"); } imp_dbh->envhp = imp_drh->envhp; /* will be NULL on first connect */ #if defined(USE_ITHREADS) && defined(PERL_MAGIC_shared_scalar) shared_dbh_priv_svp = (DBD_ATTRIB_OK(attr)?hv_fetch((HV*)SvRV(attr), "ora_dbh_share", 13, 0):NULL) ; shared_dbh_priv_sv = shared_dbh_priv_svp?*shared_dbh_priv_svp:NULL ; if (shared_dbh_priv_sv && SvROK(shared_dbh_priv_sv)) shared_dbh_priv_sv = SvRV(shared_dbh_priv_sv) ; if (shared_dbh_priv_sv) { MAGIC * mg ; SvLOCK (shared_dbh_priv_sv) ; /* some magic from shared.xs (no public api yet :-( */ mg = mg_find(shared_dbh_priv_sv, PERL_MAGIC_shared_scalar) ; shared_dbh_ssv = (shared_sv * )(mg?mg -> mg_ptr:NULL) ; /*sharedsv_find(*shared_dbh_priv_sv) ;*/ if (!shared_dbh_ssv) croak ("value of ora_dbh_share must be a scalar that is shared") ; shared_dbh = (imp_dbh_t *)SvPVX(shared_dbh_ssv -> sv) ; shared_dbh_len = SvCUR((shared_dbh_ssv -> sv)) ; if (shared_dbh_len > 0 && shared_dbh_len != sizeof (imp_dbh_t)) croak ("Invalid value for ora_dbh_dup") ; if (shared_dbh_len == sizeof (imp_dbh_t)) { /* initialize from shared data */ memcpy (((char *)imp_dbh) + DBH_DUP_OFF, ((char *)shared_dbh) + DBH_DUP_OFF, DBH_DUP_LEN) ; shared_dbh -> refcnt++ ; imp_dbh -> shared_dbh_priv_sv = shared_dbh_priv_sv ; imp_dbh -> shared_dbh = shared_dbh ; if (DBIc_DBISTATE(imp_dbh)->debug >= 2 || dbd_verbose >= 3 ) PerlIO_printf(DBIc_LOGPIO(imp_dbh), " dbd_db_login: use shared Oracle database handles.\n"); } else { shared_dbh = NULL ; } } #endif imp_dbh->get_oci_handle = oci_db_handle; if ((svp=DBD_ATTRIB_GET_SVP(attr, "ora_envhp", 9)) && SvOK(*svp)) { if (!SvTRUE(*svp)) { imp_dbh->envhp = NULL; /* force new environment */ forced_new_environment = 1; } } /* RT46739 */ if (imp_dbh->envhp) { OCIError *errhp; OCIHandleAlloc_ok(imp_dbh, imp_dbh->envhp, &errhp, OCI_HTYPE_ERROR, status); if (status != OCI_SUCCESS) { imp_dbh->envhp = NULL; } else { OCIHandleFree_log_stat(imp_dbh, errhp, OCI_HTYPE_ERROR, status); } } if (!imp_dbh->envhp ) { SV **init_mode_sv; ub4 init_mode = OCI_OBJECT;/* needed for LOBs (8.0.4) */ DBD_ATTRIB_GET_IV(attr, "ora_init_mode",13, init_mode_sv, init_mode); #if defined(USE_ITHREADS) || defined(MULTIPLICITY) || defined(USE_5005THREADS) init_mode |= OCI_THREADED; #endif { size_t rsize = 0; /* Get CLIENT char and nchar charset id values */ OCINlsEnvironmentVariableGet_log_stat(imp_dbh, &charsetid,(size_t) 0, OCI_NLS_CHARSET_ID, 0, &rsize ,status ); if (status != OCI_SUCCESS) { oci_error(dbh, NULL, status, "OCINlsEnvironmentVariableGet(OCI_NLS_CHARSET_ID) Check NLS settings etc."); return 0; } OCINlsEnvironmentVariableGet_log_stat(imp_dbh, &ncharsetid,(size_t) 0, OCI_NLS_NCHARSET_ID, 0, &rsize ,status ); if (status != OCI_SUCCESS) { oci_error(dbh, NULL, status, "OCINlsEnvironmentVariableGet(OCI_NLS_NCHARSET_ID) Check NLS settings etc."); return 0; } /*{ After using OCIEnvNlsCreate() to create the environment handle, **the actual lengths and returned lengths of bind and define handles are always in number of bytes**. This applies to the following calls: * OCIBindByName() * OCIBindByPos() * OCIBindDynamic() * OCIDefineByPos() * OCIDefineDynamic() This function enables you to set charset and ncharset ids at environment creation time. [...] This function sets nonzero charset and ncharset as client side database and national character sets, replacing the ones specified by NLS_LANG and NLS_NCHAR. When charset and ncharset are 0, it behaves exactly the same as OCIEnvCreate(). Specifically, charset controls the encoding for metadata and data with implicit form attribute and ncharset controls the encoding for data with SQLCS_NCHAR form attribute. }*/ OCIEnvNlsCreate_log_stat(imp_dbh, &imp_dbh->envhp, init_mode, 0, NULL, NULL, NULL, 0, 0, charsetid, ncharsetid, status ); if (status != OCI_SUCCESS) { oci_error(dbh, NULL, status, "OCIEnvNlsCreate. Check ORACLE_HOME (Linux) env var or PATH (Windows) and or NLS settings, permissions, etc."); return 0; } if (!imp_drh->envhp) /* cache first envhp info drh as future default */ imp_drh->envhp = imp_dbh->envhp; svp = DBD_ATTRIB_GET_SVP(attr, "ora_charset", 11);/*get the charset passed in by the user*/ if (svp) { if (!SvPOK(*svp)) { croak("ora_charset is not a string"); } new_charsetid = OCINlsCharSetNameToId(imp_dbh->envhp, (oratext*)SvPV_nolen(*svp)); if (!new_charsetid) { croak("ora_charset value (%s) is not valid", SvPV_nolen(*svp)); } } svp = DBD_ATTRIB_GET_SVP(attr, "ora_ncharset", 12); /*get the ncharset passed in by the user*/ if (svp) { if (!SvPOK(*svp)) { croak("ora_ncharset is not a string"); } new_ncharsetid = OCINlsCharSetNameToId(imp_dbh->envhp, (oratext*)SvPV_nolen(*svp)); if (!new_ncharsetid) { croak("ora_ncharset value (%s) is not valid", SvPV_nolen(*svp)); } } if (new_charsetid || new_ncharsetid) { /* reset the ENV with the new charset from above*/ if (new_charsetid) charsetid = new_charsetid; if (new_ncharsetid) ncharsetid = new_ncharsetid; imp_dbh->envhp = NULL; OCIEnvNlsCreate_log_stat(imp_dbh, &imp_dbh->envhp, init_mode, 0, NULL, NULL, NULL, 0, 0, charsetid, ncharsetid, status ); if (status != OCI_SUCCESS) { oci_error(dbh, NULL, status, "OCIEnvNlsCreate. Check ORACLE_HOME (Linux) env var or PATH (Windows) and or NLS settings, permissions, etc"); return 0; } if (!imp_drh->envhp) /* cache first envhp info drh as future default */ imp_drh->envhp = imp_dbh->envhp; } /* update the hard-coded csid constants for unicode charsets */ utf8_csid = OCINlsCharSetNameToId(imp_dbh->envhp, (void*)"UTF8"); al32utf8_csid = OCINlsCharSetNameToId(imp_dbh->envhp, (void*)"AL32UTF8"); al16utf16_csid = OCINlsCharSetNameToId(imp_dbh->envhp, (void*)"AL16UTF16"); } } if (shared_dbh_ssv) { /*is this a cached or shared handle from DBI*/ if (!imp_dbh->envhp) { /*no hande so create a new one*/ OCIEnvInit_log_stat(imp_dbh, &imp_dbh->envhp, OCI_DEFAULT, 0, 0, status); if (status != OCI_SUCCESS) { oci_error(dbh, (OCIError*)imp_dbh->envhp, status, "OCIEnvInit"); return 0; } } } OCIHandleAlloc_ok(imp_dbh, imp_dbh->envhp, &imp_dbh->errhp, OCI_HTYPE_ERROR, status); OCIAttrGet_log_stat(imp_dbh, imp_dbh->envhp, OCI_HTYPE_ENV, &charsetid, (ub4)0 , OCI_ATTR_ENV_CHARSET_ID, imp_dbh->errhp, status); if (status != OCI_SUCCESS) { oci_error(dbh, imp_dbh->errhp, status, "OCIAttrGet OCI_ATTR_ENV_CHARSET_ID"); return 0; } OCIAttrGet_log_stat(imp_dbh, imp_dbh->envhp, OCI_HTYPE_ENV, &ncharsetid, (ub4)0 , OCI_ATTR_ENV_NCHARSET_ID, imp_dbh->errhp, status); if (status != OCI_SUCCESS) { oci_error(dbh, imp_dbh->errhp, status, "OCIAttrGet OCI_ATTR_ENV_NCHARSET_ID"); return 0; } /* At this point we have charsetid & ncharsetid * note that it is possible for charsetid and ncharestid to * be distinct if NLS_LANG and NLS_NCHAR are both used. * BTW: NLS_NCHAR is set as follows: NSL_LANG=AL32UTF8 */ if (DBIc_DBISTATE(imp_dbh)->debug >= 3 || dbd_verbose >= 3 ) { oratext charsetname[OCI_NLS_MAXBUFSZ]; oratext ncharsetname[OCI_NLS_MAXBUFSZ]; OCINlsCharSetIdToName(imp_dbh->envhp,charsetname, sizeof(charsetname),charsetid ); OCINlsCharSetIdToName(imp_dbh->envhp,ncharsetname, sizeof(ncharsetname),ncharsetid ); PerlIO_printf( DBIc_LOGPIO(imp_dbh), " charset id=%d, name=%s, ncharset id=%d, name=%s" " (csid: utf8=%d al32utf8=%d)\n", charsetid,charsetname, ncharsetid,ncharsetname, utf8_csid, al32utf8_csid); #ifdef ORA_OCI_112 if (imp_dbh->using_drcp) PerlIO_printf(DBIc_LOGPIO(imp_dbh)," Using DRCP Connection\n "); #endif } if (!shared_dbh) { OCIHandleAlloc_ok(imp_dbh, imp_dbh->envhp, &imp_dbh->srvhp, OCI_HTYPE_SERVER, status); if (status != OCI_SUCCESS) { oci_error(dbh, imp_dbh->errhp, status, "OCIServerAttach"); OCIHandleFree_log_stat(imp_dbh, imp_dbh->srvhp, OCI_HTYPE_SERVER, status); OCIHandleFree_log_stat(imp_dbh, imp_dbh->errhp, OCI_HTYPE_ERROR, status); return 0; } { SV **sess_mode_type_sv; ub4 sess_mode_type = OCI_DEFAULT; ub4 cred_type; DBD_ATTRIB_GET_IV(attr, "ora_session_mode",16, sess_mode_type_sv, sess_mode_type); #ifdef ORA_OCI_112 if (imp_dbh->using_drcp) { /* connect uisng a DRCP */ ub4 purity = OCI_ATTR_PURITY_SELF; /* pool Default values */ if (!imp_dbh->pool_min ) imp_dbh->pool_min = 4; if (!imp_dbh->pool_max ) imp_dbh->pool_max = 40; if (!imp_dbh->pool_incr) imp_dbh->pool_incr = 2; OCIHandleAlloc_ok(imp_dbh, imp_dbh->envhp, &imp_dbh->poolhp, OCI_HTYPE_SPOOL, status); OCISessionPoolCreate_log_stat( imp_dbh, imp_dbh->envhp, imp_dbh->errhp, imp_dbh->poolhp, (OraText **) &imp_dbh->pool_name, (ub4 *) &imp_dbh->pool_namel, (OraText *) dbname, strlen(dbname), imp_dbh->pool_min, imp_dbh->pool_max, imp_dbh->pool_incr, (OraText *) uid, strlen(uid), (OraText *) pwd, strlen(pwd), status); if (status != OCI_SUCCESS) { oci_error(dbh, imp_dbh->errhp, status, "OCISessionPoolCreate"); OCIServerDetach_log_stat(imp_dbh, imp_dbh->srvhp, imp_dbh->errhp, OCI_DEFAULT, status); OCIHandleFree_log_stat(imp_dbh, imp_dbh->poolhp, OCI_HTYPE_SPOOL,status); OCIHandleFree_log_stat(imp_dbh, imp_dbh->srvhp, OCI_HTYPE_SERVER, status); OCIHandleFree_log_stat(imp_dbh, imp_dbh->errhp, OCI_HTYPE_ERROR, status); return 0; } OCIHandleAlloc_ok(imp_dbh, imp_dbh->envhp, &imp_dbh->authp, OCI_HTYPE_AUTHINFO, status); OCIAttrSet_log_stat(imp_dbh, imp_dbh->authp, (ub4) OCI_HTYPE_AUTHINFO, &purity, (ub4) 0,(ub4) OCI_ATTR_PURITY, imp_dbh->errhp, status); if (imp_dbh->pool_class) /*pool_class may or may not be used */ OCIAttrSet_log_stat(imp_dbh, imp_dbh->authp, (ub4) OCI_HTYPE_AUTHINFO, (OraText *) imp_dbh->pool_class, (ub4) imp_dbh->pool_classl, (ub4) OCI_ATTR_CONNECTION_CLASS, imp_dbh->errhp, status); cred_type = ora_parse_uid(imp_dbh, &uid, &pwd); OCISessionGet_log_stat(imp_dbh, imp_dbh->envhp, imp_dbh->errhp, &imp_dbh->svchp, imp_dbh->authp, imp_dbh->pool_name, (ub4)strlen((char *)imp_dbh->pool_name), status); if (status != OCI_SUCCESS) { oci_error(dbh, imp_dbh->errhp, status, "OCISessionGet"); OCIServerDetach_log_stat(imp_dbh, imp_dbh->srvhp, imp_dbh->errhp, OCI_DEFAULT, status); OCISessionPoolDestroy_log_stat( imp_dbh, imp_dbh->poolhp, imp_dbh->errhp,status); OCIHandleFree_log_stat(imp_dbh, imp_dbh->poolhp, OCI_HTYPE_SPOOL,status); OCIHandleFree_log_stat(imp_dbh, imp_dbh->srvhp, OCI_HTYPE_SERVER, status); OCIHandleFree_log_stat(imp_dbh, imp_dbh->errhp, OCI_HTYPE_ERROR, status); return 0; } if (DBIc_DBISTATE(imp_dbh)->debug >= 4 || dbd_verbose >= 4 ) { PerlIO_printf( DBIc_LOGPIO(imp_dbh), "Using DRCP with session settings min=%d, max=%d, and increment=%d\n", imp_dbh->pool_min, imp_dbh->pool_max, imp_dbh->pool_incr); if (imp_dbh->pool_class) PerlIO_printf( DBIc_LOGPIO(imp_dbh), "with connection class=%s\n",imp_dbh->pool_class); } } else { #endif /* ORA_OCI_112 */ OCIHandleAlloc_ok(imp_dbh, imp_dbh->envhp, &imp_dbh->svchp, OCI_HTYPE_SVCCTX, status); OCIServerAttach_log_stat(imp_dbh, dbname,OCI_DEFAULT, status); if (status != OCI_SUCCESS) { oci_error(dbh, imp_dbh->errhp, status, "OCIServerAttach"); OCIHandleFree_log_stat(imp_dbh, imp_dbh->seshp, OCI_HTYPE_SESSION,status); OCIHandleFree_log_stat(imp_dbh, imp_dbh->srvhp, OCI_HTYPE_SERVER, status); OCIHandleFree_log_stat(imp_dbh, imp_dbh->errhp, OCI_HTYPE_ERROR, status); OCIHandleFree_log_stat(imp_dbh, imp_dbh->svchp, OCI_HTYPE_SVCCTX, status); if (forced_new_environment) OCIHandleFree_log_stat(imp_dbh, imp_dbh->envhp, OCI_HTYPE_ENV, status); return 0; } OCIAttrSet_log_stat(imp_dbh, imp_dbh->svchp, OCI_HTYPE_SVCCTX, imp_dbh->srvhp, (ub4) 0, OCI_ATTR_SERVER, imp_dbh->errhp, status); OCIHandleAlloc_ok(imp_dbh, imp_dbh->envhp, &imp_dbh->seshp, OCI_HTYPE_SESSION, status); cred_type = ora_parse_uid(imp_dbh, &uid, &pwd); OCISessionBegin_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, imp_dbh->seshp,cred_type, sess_mode_type, status); if (status == OCI_SUCCESS_WITH_INFO) { /* eg ORA-28011: the account will expire soon; change your password now */ oci_error(dbh, imp_dbh->errhp, status, "OCISessionBegin"); status = OCI_SUCCESS; } if (status != OCI_SUCCESS) { oci_error(dbh, imp_dbh->errhp, status, "OCISessionBegin"); OCIServerDetach_log_stat(imp_dbh, imp_dbh->srvhp, imp_dbh->errhp, OCI_DEFAULT, status); OCIHandleFree_log_stat(imp_dbh, imp_dbh->seshp, OCI_HTYPE_SESSION,status); OCIHandleFree_log_stat(imp_dbh, imp_dbh->srvhp, OCI_HTYPE_SERVER, status); OCIHandleFree_log_stat(imp_dbh, imp_dbh->errhp, OCI_HTYPE_ERROR, status); OCIHandleFree_log_stat(imp_dbh, imp_dbh->svchp, OCI_HTYPE_SVCCTX, status); if (forced_new_environment) OCIHandleFree_log_stat(imp_dbh, imp_dbh->envhp, OCI_HTYPE_ENV, status); return 0; } OCIAttrSet_log_stat(imp_dbh, imp_dbh->svchp, (ub4) OCI_HTYPE_SVCCTX, imp_dbh->seshp, (ub4) 0,(ub4) OCI_ATTR_SESSION, imp_dbh->errhp, status); #ifdef ORA_OCI_112 } #endif } } DBIc_IMPSET_on(imp_dbh); /* imp_dbh set up now */ DBIc_ACTIVE_on(imp_dbh); /* call disconnect before freeing */ imp_dbh->ph_type = 1; /* SQLT_CHR "(ORANET TYPE) character string" */ imp_dbh->ph_csform = 0; /* meaning auto (see dbd_rebind_ph) */ if (!imp_drh->envhp) /* cache first envhp info drh as future default */ imp_drh->envhp = imp_dbh->envhp; #if defined(USE_ITHREADS) && defined(PERL_MAGIC_shared_scalar) if (shared_dbh_ssv && !shared_dbh) { /* much of this could be replaced with a single sv_setpvn() */ (void)SvUPGRADE(shared_dbh_priv_sv, SVt_PV); SvGROW(shared_dbh_priv_sv, sizeof(imp_dbh_t) + 1) ; SvCUR (shared_dbh_priv_sv) = sizeof(imp_dbh_t) ; imp_dbh->refcnt = 1 ; imp_dbh->shared_dbh_priv_sv = shared_dbh_priv_sv ; memcpy(SvPVX(shared_dbh_priv_sv) + DBH_DUP_OFF, ((char *)imp_dbh) + DBH_DUP_OFF, DBH_DUP_LEN) ; SvSETMAGIC(shared_dbh_priv_sv); imp_dbh->shared_dbh = (imp_dbh_t *)SvPVX(shared_dbh_ssv->sv); } #endif /* set up TAF callback if wanted */ if (imp_dbh->taf_function){ if (enable_taf(dbh, imp_dbh) == 0) return 0; } return 1; } int dbd_db_commit(SV *dbh, imp_dbh_t *imp_dbh) { dTHX; sword status; OCITransCommit_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, OCI_DEFAULT, status); if (status != OCI_SUCCESS) { oci_error(dbh, imp_dbh->errhp, status, "OCITransCommit"); return 0; } return 1; } int dbd_st_cancel(SV *sth, imp_sth_t *imp_sth) { dTHX; sword status; status = OCIBreak(imp_sth->svchp, imp_sth->errhp); if (status != OCI_SUCCESS) { oci_error(sth, imp_sth->errhp, status, "OCIBreak"); return 0; } /* if we are using a scrolling cursor we should get rid of the cursor by fetching row 0 */ if (imp_sth->exe_mode==OCI_STMT_SCROLLABLE_READONLY){ OCIStmtFetch_log_stat(imp_sth, imp_sth->stmhp, imp_sth->errhp, 0,OCI_FETCH_NEXT,0, status); } return 1; } int dbd_db_rollback(SV *dbh, imp_dbh_t *imp_dbh) { dTHX; sword status; OCITransRollback_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, OCI_DEFAULT, status); if (status != OCI_SUCCESS) { oci_error(dbh, imp_dbh->errhp, status, "OCITransRollback"); return 0; } return 1; } int dbd_st_bind_col(SV *sth, imp_sth_t *imp_sth, SV *col, SV *ref, IV type, SV *attribs) { dTHX; int field; if (!SvIOK(col)) { croak ("Invalid column number") ; } field = SvIV(col); if ((field < 1) || (field > DBIc_NUM_FIELDS(imp_sth))) { croak("cannot bind to non-existent field %d", field); } if (type != 0) { imp_sth->fbh[field-1].req_type = type; } if (attribs) { imp_sth->fbh[field-1].bind_flags = 0; /* default to none */ } #if DBIXS_REVISION >= 13590 /* DBIXS 13590 added StrictlyTyped and DiscardString attributes */ if (attribs) { HV *attr_hash; SV **attr; if (!SvROK(attribs)) { croak ("attributes is not a reference"); } else if (SvTYPE(SvRV(attribs)) != SVt_PVHV) { croak ("attributes not a hash reference"); } attr_hash = (HV *)SvRV(attribs); attr = hv_fetch(attr_hash, "StrictlyTyped", (U32)13, 0); if (attr && SvTRUE(*attr)) { imp_sth->fbh[field-1].bind_flags |= DBIstcf_STRICT; } attr = hv_fetch(attr_hash, "DiscardString", (U32)13, 0); if (attr && SvTRUE(*attr)) { imp_sth->fbh[field-1].bind_flags |= DBIstcf_DISCARD_STRING; } } #endif /* DBIXS_REVISION >= 13590 */ return 1; } int dbd_db_disconnect(SV *dbh, imp_dbh_t *imp_dbh) { dTHX; dTHR; int refcnt = 1 ; #if defined(USE_ITHREADS) && defined(PERL_MAGIC_shared_scalar) if (DBIc_IMPSET(imp_dbh) && imp_dbh->shared_dbh) { SvLOCK (imp_dbh->shared_dbh_priv_sv) ; refcnt = imp_dbh -> shared_dbh -> refcnt ; } #endif /* We assume that disconnect will always work */ /* since most errors imply already disconnected. */ DBIc_ACTIVE_off(imp_dbh); /* Oracle will commit on an orderly disconnect. */ /* See DBI Driver.xst file for the DBI approach. */ if (refcnt == 1 ) { sword s_se, s_sd; #ifdef ORA_OCI_112 if (imp_dbh->using_drcp) { OCISessionRelease_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp,s_se); } else { #endif OCISessionEnd_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, imp_dbh->seshp, OCI_DEFAULT, s_se); #ifdef ORA_OCI_112 } #endif if (s_se) oci_error(dbh, imp_dbh->errhp, s_se, "OCISessionEnd"); OCIServerDetach_log_stat(imp_dbh, imp_dbh->srvhp, imp_dbh->errhp, OCI_DEFAULT, s_sd); if (s_sd) oci_error(dbh, imp_dbh->errhp, s_sd, "OCIServerDetach"); if (s_se || s_sd) return 0; } /* We don't free imp_dbh since a reference still exists */ /* The DESTROY method is the only one to 'free' memory. */ /* Note that statement objects may still exists for this dbh! */ return 1; } void dbd_db_destroy(SV *dbh, imp_dbh_t *imp_dbh) { dTHX ; int refcnt = 1 ; sword status; #if defined(USE_ITHREADS) && defined(PERL_MAGIC_shared_scalar) if (DBIc_IMPSET(imp_dbh) && imp_dbh->shared_dbh) { SvLOCK (imp_dbh->shared_dbh_priv_sv) ; refcnt = imp_dbh -> shared_dbh -> refcnt-- ; } #endif if (refcnt == 1) { sword status; if (DBIc_ACTIVE(imp_dbh)) dbd_db_disconnect(dbh, imp_dbh); if (is_extproc) goto dbd_db_destroy_out; if (imp_dbh->taf_function){ disable_taf(imp_dbh); } if (imp_dbh->taf_function) { SvREFCNT_dec(imp_dbh->taf_function); imp_dbh->taf_function = NULL; } if (imp_dbh->taf_ctx.dbh_ref) { SvREFCNT_dec(SvRV(imp_dbh->taf_ctx.dbh_ref)); imp_dbh->taf_ctx.dbh_ref = NULL; } #ifdef ORA_OCI_112 if (imp_dbh->using_drcp) { OCIHandleFree_log_stat(imp_dbh, imp_dbh->authp, OCI_HTYPE_SESSION,status); OCISessionPoolDestroy_log_stat(imp_dbh, imp_dbh->poolhp, imp_dbh->errhp,status); OCIHandleFree_log_stat(imp_dbh, imp_dbh->poolhp, OCI_HTYPE_SPOOL,status); } else { #endif OCIHandleFree_log_stat(imp_dbh, imp_dbh->seshp, OCI_HTYPE_SESSION,status); OCIHandleFree_log_stat(imp_dbh, imp_dbh->svchp, OCI_HTYPE_SVCCTX, status); #ifdef ORA_OCI_112 } #endif OCIHandleFree_log_stat(imp_dbh, imp_dbh->srvhp, OCI_HTYPE_SERVER, status); } OCIHandleFree_log_stat(imp_dbh, imp_dbh->errhp, OCI_HTYPE_ERROR, status); dbd_db_destroy_out: DBIc_IMPSET_off(imp_dbh); } int dbd_db_STORE_attrib(SV *dbh, imp_dbh_t *imp_dbh, SV *keysv, SV *valuesv) { dTHX; STRLEN kl; STRLEN vl; sword status; char *key = SvPV(keysv,kl); int on = SvTRUE(valuesv); int cacheit = 1; if (kl==17 && strEQ(key, "ora_ncs_buff_mtpl") ) { ora_ncs_buff_mtpl = SvIV (valuesv); } #ifdef ORA_OCI_112 else if (kl==15 && strEQ(key, "ora_driver_name") ) { imp_dbh->driver_name = (char *) SvPV (valuesv, vl ); OCIAttrSet_log_stat( imp_dbh, imp_dbh->seshp, OCI_HTYPE_SESSION, imp_dbh->driver_name, (ub4)vl, OCI_ATTR_DRIVER_NAME, imp_dbh->errhp, status); } else if (kl==8 && strEQ(key, "ora_drcp") ) { imp_dbh->using_drcp = 1; } else if (kl==14 && strEQ(key, "ora_drcp_class") ) { STRLEN vl; imp_dbh->pool_class = (text *) SvPV (valuesv, vl ); imp_dbh->pool_classl= (ub4) vl; } else if (kl==12 && strEQ(key, "ora_drcp_min") ) { imp_dbh->pool_min = SvIV (valuesv); } else if (kl==12 && strEQ(key, "ora_drcp_max") ) { imp_dbh->pool_max = SvIV (valuesv); } else if (kl==13 && strEQ(key, "ora_drcp_incr") ) { imp_dbh->pool_incr = SvIV (valuesv); } #endif else if (kl==16 && strEQ(key, "ora_taf_function") ) { if (imp_dbh->taf_function) SvREFCNT_dec(imp_dbh->taf_function); imp_dbh->taf_function = newSVsv(valuesv); if (SvTRUE(valuesv)) { enable_taf(dbh, imp_dbh); } else { disable_taf(imp_dbh); } } #ifdef OCI_ATTR_ACTION else if (kl==10 && strEQ(key, "ora_action") ) { imp_dbh->action = (char *) SvPV (valuesv, vl ); imp_dbh->actionl= (ub4) vl; OCIAttrSet_log_stat(imp_dbh, imp_dbh->seshp,OCI_HTYPE_SESSION, imp_dbh->action,imp_dbh->actionl,OCI_ATTR_ACTION,imp_dbh->errhp, status); } #endif else if (kl==21 && strEQ(key, "ora_client_identifier") ) { imp_dbh->client_identifier = (char *) SvPV (valuesv, vl ); imp_dbh->client_identifierl= (ub4) vl; OCIAttrSet_log_stat(imp_dbh, imp_dbh->seshp,OCI_HTYPE_SESSION, imp_dbh->client_identifier,imp_dbh->client_identifierl,OCI_ATTR_CLIENT_IDENTIFIER,imp_dbh->errhp, status); } #ifdef OCI_ATTR_CLIENT_INFO else if (kl==15 && strEQ(key, "ora_client_info") ) { imp_dbh->client_info = (char *) SvPV (valuesv, vl ); imp_dbh->client_infol= (ub4) vl; OCIAttrSet_log_stat(imp_dbh, imp_dbh->seshp,OCI_HTYPE_SESSION, imp_dbh->client_info,imp_dbh->client_infol,OCI_ATTR_CLIENT_INFO,imp_dbh->errhp, status); } #endif #ifdef OCI_ATTR_MODULE else if (kl==15 && strEQ(key, "ora_module_name") ) { imp_dbh->module_name = (char *) SvPV (valuesv, vl ); imp_dbh->module_namel= (ub4) vl; OCIAttrSet_log_stat(imp_dbh, imp_dbh->seshp,OCI_HTYPE_SESSION, imp_dbh->module_name,imp_dbh->module_namel,OCI_ATTR_MODULE,imp_dbh->errhp, status); } #endif else if (kl==20 && strEQ(key, "ora_oci_success_warn") ) { oci_warn = SvIV (valuesv); } else if (kl==11 && strEQ(key, "ora_objects")) { ora_objects = SvIV (valuesv); } else if (kl==11 && (strEQ(key, "ora_verbose") || strEQ(key, "dbd_verbose"))) { dbd_verbose = SvIV (valuesv); } else if (kl==10 && strEQ(key, "AutoCommit")) { DBIc_set(imp_dbh,DBIcf_AutoCommit, on); } else if (kl==12 && strEQ(key, "RowCacheSize")) { imp_dbh->RowCacheSize = SvIV(valuesv); } else if (kl==22 && strEQ(key, "ora_max_nested_cursors")) { imp_dbh->max_nested_cursors = SvIV(valuesv); } else if (kl==20 && strEQ(key, "ora_array_chunk_size")) { imp_dbh->array_chunk_size = SvIV(valuesv); } else if (kl==11 && strEQ(key, "ora_ph_type")) { if (SvIV(valuesv)!=1 && SvIV(valuesv)!=5 && SvIV(valuesv)!=96 && SvIV(valuesv)!=97) warn("ora_ph_type must be 1 (VARCHAR2), 5 (STRING), 96 (CHAR), or 97 (CHARZ)"); else imp_dbh->ph_type = SvIV(valuesv); } else if (kl==13 && strEQ(key, "ora_ph_csform")) { if (SvIV(valuesv)!=SQLCS_IMPLICIT && SvIV(valuesv)!=SQLCS_NCHAR) warn("ora_ph_csform must be 1 (SQLCS_IMPLICIT) or 2 (SQLCS_NCHAR)"); else imp_dbh->ph_csform = (ub1)SvIV(valuesv); } else { return FALSE; } if (cacheit) /* cache value for later DBI 'quick' fetch? */ (void)hv_store((HV*)SvRV(dbh), key, kl, newSVsv(valuesv), 0); return TRUE; } SV * dbd_db_FETCH_attrib(SV *dbh, imp_dbh_t *imp_dbh, SV *keysv) { dTHX; STRLEN kl; char *key = SvPV(keysv,kl); SV *retsv = Nullsv; /* Default to caching results for DBI dispatch quick_FETCH */ int cacheit = FALSE; /* AutoCommit FETCH via DBI */ if (kl==18 && strEQ(key, "ora_ncs_buff_mtpl") ) { retsv = newSViv (ora_ncs_buff_mtpl); } #ifdef ORA_OCI_112 else if (kl==15 && strEQ(key, "ora_driver_name") ) { retsv = newSVpv((char *)imp_dbh->driver_name,0); } else if (kl==8 && strEQ(key, "ora_drcp") ) { retsv = newSViv(imp_dbh->using_drcp); } else if (kl==14 && strEQ(key, "ora_drcp_class") ) { retsv = newSVpv((char *)imp_dbh->pool_class, 0); } else if (kl==12 && strEQ(key, "ora_drcp_min") ) { retsv = newSViv(imp_dbh->pool_min); } else if (kl==12 && strEQ(key, "ora_drcp_max") ) { retsv = newSViv(imp_dbh->pool_max); } else if (kl==13 && strEQ(key, "ora_drcp_incr") ) { retsv = newSViv(imp_dbh->pool_incr); } #endif else if (kl==16 && strEQ(key, "ora_taf_function") ) { if (imp_dbh->taf_function) { retsv = newSVsv(imp_dbh->taf_function); } } #ifdef OCI_ATTR_ACTION else if (kl==10 && strEQ(key, "ora_action")) { retsv = newSVpv((char *)imp_dbh->action,0); } #endif else if (kl==21 && strEQ(key, "ora_client_identifier")) { retsv = newSVpv((char *)imp_dbh->client_identifier,0); } else if (kl==15 && strEQ(key, "ora_client_info")) { retsv = newSVpv((char *)imp_dbh->client_info,0); } else if (kl==15 && strEQ(key, "ora_module_name")) { retsv = newSVpv((char *)imp_dbh->module_name,0); } else if (kl==20 && strEQ(key, "ora_oci_success_warn")) { retsv = newSViv (oci_warn); } else if (kl==11 && strEQ(key, "ora_objects")) { retsv = newSViv (ora_objects); } else if (kl==11 && (strEQ(key, "ora_verbose") || strEQ(key, "dbd_verbose"))) { retsv = newSViv (dbd_verbose); } else if (kl==10 && strEQ(key, "AutoCommit")) { retsv = boolSV(DBIc_has(imp_dbh,DBIcf_AutoCommit)); } else if (kl==12 && strEQ(key, "RowCacheSize")) { retsv = newSViv(imp_dbh->RowCacheSize); } else if (kl==11 && strEQ(key, "RowsInCache")) { retsv = newSViv(imp_dbh->RowsInCache); } else if (kl==22 && strEQ(key, "ora_max_nested_cursors")) { retsv = newSViv(imp_dbh->max_nested_cursors); } else if (kl==11 && strEQ(key, "ora_ph_type")) { retsv = newSViv(imp_dbh->ph_type); } else if (kl==13 && strEQ(key, "ora_ph_csform")) { retsv = newSViv(imp_dbh->ph_csform); } else if (kl==22 && strEQ(key, "ora_parse_error_offset")) { retsv = newSViv(imp_dbh->parse_error_offset); } if (!retsv) return Nullsv; if (cacheit) { /* cache for next time (via DBI quick_FETCH) */ SV **svp = hv_fetch((HV*)SvRV(dbh), key, kl, 1); sv_free(*svp); *svp = retsv; (void)SvREFCNT_inc(retsv); /* so sv_2mortal won't free it */ } if (retsv == &PL_sv_yes || retsv == &PL_sv_no) return retsv; /* no need to mortalize yes or no */ return sv_2mortal(retsv); } /* ================================================================== */ #define MAX_OCISTRING_LEN 32766 SV * createxmlfromstring(SV *sth, imp_sth_t *imp_sth, SV *source){ dTHX; dTHR; OCIXMLType *xml = NULL; STRLEN len; ub4 buflen; sword status; ub1 src_type; dvoid* src_ptr = NULL; D_imp_dbh_from_sth; SV* sv_dest; dvoid *bufp; ub1 csform; ub2 csid; csid = 0; csform = SQLCS_IMPLICIT; len = SvLEN(source); bufp = SvPV(source, len); if (DBIc_DBISTATE(imp_sth)->debug >=3 || dbd_verbose >= 3 ) PerlIO_printf(DBIc_LOGPIO(imp_sth), " creating xml from string that is %lu long\n",(unsigned long)len); if(len > MAX_OCISTRING_LEN) { src_type = OCI_XMLTYPE_CREATE_CLOB; if (DBIc_DBISTATE(imp_sth)->debug >=5 || dbd_verbose >= 5 ) PerlIO_printf(DBIc_LOGPIO(imp_sth), " use a temp lob locator for large xml \n"); OCIDescriptorAlloc_ok(imp_dbh, imp_dbh->envhp, &src_ptr, OCI_DTYPE_LOB); OCILobCreateTemporary_log_stat(imp_dbh, imp_dbh->svchp, imp_sth->errhp, (OCILobLocator *) src_ptr, (ub2) OCI_DEFAULT, (ub1) OCI_DEFAULT, OCI_TEMP_CLOB, FALSE, OCI_DURATION_SESSION, status); if (status != OCI_SUCCESS) { oci_error(sth, imp_sth->errhp, status, "OCILobCreateTemporary"); } csid = (SvUTF8(source) && !CS_IS_UTF8(csid)) ? utf8_csid : CSFORM_IMPLIED_CSID(csform); buflen = len; OCILobWriteAppend_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, src_ptr, &buflen, bufp, (ub4)len, OCI_ONE_PIECE, NULL, NULL, csid, csform, status); if (status != OCI_SUCCESS) { oci_error(sth, imp_sth->errhp, status, "OCILobWriteAppend"); } } else { src_type = OCI_XMLTYPE_CREATE_OCISTRING; if (DBIc_DBISTATE(imp_sth)->debug >=5 || dbd_verbose >= 5 ) PerlIO_printf(DBIc_LOGPIO(imp_sth), " use a OCIStringAssignText for small xml \n"); OCIStringAssignText(imp_dbh->envhp, imp_dbh->errhp, bufp, (ub2) (ub4)len, (OCIString **) &src_ptr); } OCIXMLTypeCreateFromSrc_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, (OCIDuration)OCI_DURATION_CALLOUT, (ub1)src_type, (dvoid *)src_ptr, (sb4)OCI_IND_NOTNULL, &xml, status); if (status != OCI_SUCCESS) { oci_error(sth, imp_sth->errhp, status, "OCIXMLTypeCreateFromSrc"); } /* free temporary resources */ if ( src_type == OCI_XMLTYPE_CREATE_CLOB ) { OCILobFreeTemporary(imp_dbh->svchp, imp_dbh->errhp, (OCILobLocator*) src_ptr); OCIDescriptorFree_log(imp_dbh, (dvoid *) src_ptr, (ub4) OCI_DTYPE_LOB); } sv_dest = newSViv(0); sv_setref_pv(sv_dest, "OCIXMLTypePtr", xml); return sv_dest; } void dbd_preparse(imp_sth_t *imp_sth, char *statement) { dTHX; D_imp_dbh_from_sth; char in_literal = '\0'; char in_comment = '\0'; char *src, *start, *dest; phs_t phs_tpl; SV *phs_sv; int idx=0; char *style="", *laststyle=Nullch; STRLEN namelen; phs_t *phs; /* allocate room for copy of statement with spare capacity */ /* for editing '?' or ':1' into ':p1' so we can use obndrv. */ /* XXX should use SV and append to it */ Newz(0,imp_sth->statement,strlen(statement) * 10,char); /* initialise phs ready to be cloned per placeholder */ memset(&phs_tpl, 0, sizeof(phs_tpl)); phs_tpl.imp_sth = imp_sth; phs_tpl.ftype = imp_dbh->ph_type; phs_tpl.csform = imp_dbh->ph_csform; phs_tpl.sv = &PL_sv_undef; src = statement; dest = imp_sth->statement; while(*src) { if (in_comment) { /* 981028-jdl on mocha. Adding all code which deals with */ /* in_comment variable (its declaration plus 2 code blocks). */ /* Text appearing within comments should be scanned for neither */ /* placeholders nor for single quotes (which toggle the in_literal */ /* boolean). Comments like "3:00" demonstrate the former problem, */ /* and contractions like "don't" demonstrate the latter problem. */ /* The comment style is stored in in_comment; each style is */ /* terminated in a different way. */ if (in_comment == '-' && *src == '\n') { in_comment = '\0'; } else if (in_comment == '/' && *src == '*' && *(src+1) == '/') { *dest++ = *src++; /* avoids asterisk-slash-asterisk issues */ in_comment = '\0'; } *dest++ = *src++; continue; } if (in_literal) { if (*src == in_literal) in_literal = '\0'; *dest++ = *src++; continue; } /* Look for comments: '-- oracle-style' or C-style */ if ((*src == '-' && *(src+1) == '-') || (*src == '/' && *(src+1) == '*')) { in_comment = *src; /* We know *src & the next char are to be copied, so do */ /* it. In the case of C-style comments, it happens to */ /* help us avoid slash-asterisk-slash oddities. */ *dest++ = *src++; *dest++ = *src++; continue; } if (*src != ':' && *src != '?') { if (*src == '\'' || *src == '"') in_literal = *src; *dest++ = *src++; continue; } /* only here for : or ? outside of a comment or literal */ start = dest; /* save name inc colon */ *dest++ = *src++; if (*start == '?') { /* X/Open standard */ sprintf(start,":p%d", ++idx); /* '?' -> ':p1' (etc) */ dest = start+strlen(start); style = "?"; } else if (isDIGIT(*src)) { /* ':1' */ idx = atoi(src); *dest++ = 'p'; /* ':1'->':p1' */ if (idx <= 0) croak("Placeholder :%d invalid, placeholders must be >= 1", idx); while(isDIGIT(*src)) *dest++ = *src++; style = ":1"; } else if (isALNUM(*src)) { /* ':foo' */ while(isALNUM(*src)) /* includes '_' */ *dest++ = toLOWER(*src), src++; style = ":foo"; } else { /* perhaps ':=' PL/SQL construct */ /* if (src == ':') *dest++ = *src++; XXX? move past '::'? */ continue; } *dest = '\0'; /* handy for debugging */ namelen = (dest-start); if (laststyle && style != laststyle) croak("Can't mix placeholder styles (%s/%s)",style,laststyle); laststyle = style; if (imp_sth->all_params_hv == NULL) imp_sth->all_params_hv = newHV(); phs_sv = newSVpv((char*)&phs_tpl, sizeof(phs_tpl)+namelen+1); phs = (phs_t*)(void*)SvPVX(phs_sv); (void)hv_store(imp_sth->all_params_hv, start, namelen, phs_sv, 0); phs->idx = idx-1; /* Will be 0 for :1, -1 for :foo. */ strcpy(phs->name, start); } *dest = '\0'; if (imp_sth->all_params_hv) { DBIc_NUM_PARAMS(imp_sth) = (int)HvKEYS(imp_sth->all_params_hv); if (DBIc_DBISTATE(imp_sth)->debug >= 2 || dbd_verbose >= 3 ) PerlIO_printf(DBIc_LOGPIO(imp_sth), " dbd_preparse scanned %d distinct placeholders\n", (int)DBIc_NUM_PARAMS(imp_sth)); } } static int ora_sql_type(imp_sth_t *imp_sth, char *name, int sql_type) { /* XXX should detect DBI reserved standard type range here */ switch (sql_type) { case SQL_NUMERIC: case SQL_DECIMAL: case SQL_INTEGER: case SQL_BIGINT: case SQL_TINYINT: case SQL_SMALLINT: case SQL_FLOAT: case SQL_REAL: case SQL_DOUBLE: case SQL_VARCHAR: return 1; /* Oracle VARCHAR2 */ case SQL_CHAR: return 96; /* Oracle CHAR */ case SQL_BINARY: case SQL_VARBINARY: return 23; /* Oracle RAW */ case SQL_LONGVARBINARY: return 24; /* Oracle LONG RAW */ case SQL_LONGVARCHAR: return 8; /* Oracle LONG */ case SQL_UDT: return 108; /* Oracle NTY */ case SQL_CLOB: return 112; /* Oracle CLOB */ case SQL_BLOB: return 113; /* Oracle BLOB */ case SQL_DATE: case SQL_TIME: case SQL_TIMESTAMP: default: if (imp_sth && DBIc_WARN(imp_sth) && name) warn("SQL type %d for '%s' is not fully supported, bound as SQL_VARCHAR instead", sql_type, name); return ora_sql_type(imp_sth, name, SQL_VARCHAR); } } /* ############### Array bind ######################################### */ /* Added by Alexander V Alekseev. alex@alemate.ru */ /* * * Realloc temporary array buffer to match required number of entries * and buffer size. * * Return value: croaks on error. false (=0 ) on success. * */ int ora_realloc_phs_array(phs_t *phs,int newentries, int newbufsize){ dTHX; dTHR; int i; /* Loop variable */ unsigned short *newal; if( newbufsize < 0 ){ newbufsize=0; } if( newentries > phs->array_numallocated ){ OCIInd *newind=(OCIInd *)realloc(phs->array_indicators,newentries*sizeof(OCIInd) ); if( newind ){ phs->array_indicators=newind; /* Init all indicators to NULL values. */ for( i=phs->array_numallocated; i < newentries ; i++ ){ newind[i]=1; } }else{ croak("Not enough memory to allocate %d OCI indicators.",newentries); } newal=(unsigned short *)realloc(phs->array_lengths, newentries*sizeof(unsigned short)); if( newal ){ phs->array_lengths=newal; /* Init all new lengths to zero */ if( newentries > phs->array_numallocated ){ memset( &(newal[phs->array_numallocated]), 0, (newentries-(phs->array_numallocated))*sizeof(unsigned short) ); } }else{ croak("Not enough memory to allocate %d entries in OCI array of lengths.",newentries); } phs->array_numallocated=newentries; } if( phs->array_buflen < newbufsize ){ char * newbuf=(char *)realloc( phs->array_buf, (unsigned) newbufsize ); if( newbuf ){ phs->array_buf=newbuf; }else{ croak("Not enough memory to allocate OCI array buffer of %d bytes.",newbufsize); } phs->array_buflen=newbufsize; } return 0; } /* bind of SYS.DBMS_SQL.VARCHAR2_TABLE */ int dbd_rebind_ph_varchar2_table(SV *sth, imp_sth_t *imp_sth, phs_t *phs) { dTHX; /*D_imp_dbh_from_sth ;*/ sword status; int trace_level = DBIc_DBISTATE(imp_sth)->debug; AV *arr; ub1 csform; ub2 csid; int flag_data_is_utf8=0; int need_allocate_rows; int buflen; int numarrayentries; if( ( ! SvROK(phs->sv) ) || (SvTYPE(SvRV(phs->sv))!=SVt_PVAV) ) { /* Allow only array binds */ croak("dbd_rebind_ph_varchar2_table(): bad bind variable. ARRAY reference required, but got %s for '%s'.", neatsvpv(phs->sv,0), phs->name); } arr=(AV*)(SvRV(phs->sv)); if (trace_level >= 2 || dbd_verbose >= 3 ){ PerlIO_printf(DBIc_LOGPIO(imp_sth), "dbd_rebind_ph_varchar2_table(): array_numstruct=%d\n", phs->array_numstruct); } /* If no number of entries to bind specified, * set phs->array_numstruct to the scalar(@array) bound. */ /* av_len() returns last array index, or -1 is array is empty */ numarrayentries=av_len( arr ); if( numarrayentries >= 0 ){ phs->array_numstruct = numarrayentries+1; if (trace_level >= 2 || dbd_verbose >= 3 ){ PerlIO_printf( DBIc_LOGPIO(imp_sth), "dbd_rebind_ph_varchar2_table(): array_numstruct=%d (calculated) \n", phs->array_numstruct); } } /* Fix charset */ csform = phs->csform; if (trace_level >= 2 || dbd_verbose >= 3 ){ PerlIO_printf(DBIc_LOGPIO(imp_sth), "dbd_rebind_ph_varchar2_table(): original csform=%d\n", (int)csform); } /* Calculate each bound structure maxlen. * If maxlen<=0, let maxlen=MAX ( length($$_) each @array ); * * Charset calculation is done inside this loop either. */ { unsigned int maxlen=0; int i; for(i=0;imaxlen <=0 ){ /* Analyze maxlength only if not forced */ STRLEN length=0; if (!SvPOK(item)) { /* normalizations for special cases */ if (SvOK(item)) { /* ie a number, convert to string ASAP */ if (!(SvROK(item) && phs->is_inout)){ sv_2pv(item, &length); } } else { /* ensure we're at least an SVt_PV (so SvPVX etc work) */ (void)SvUPGRADE(item, SVt_PV); } } if( length == 0 ){ length=SvCUR(item); } if( length+1 > maxlen ){ maxlen=length+1; } if (trace_level >= 3 || dbd_verbose >= 3 ){ PerlIO_printf( DBIc_LOGPIO(imp_sth), "dbd_rebind_ph_varchar2_table(): length(array[%d])=%d\n", i,(int)length); } } if(SvUTF8(item) ){ flag_data_is_utf8=1; if (trace_level >= 3 || dbd_verbose >= 3 ){ PerlIO_printf( DBIc_LOGPIO(imp_sth), "dbd_rebind_ph_varchar2_table(): is_utf8(array[%d])=true\n", i); } if (csform != SQLCS_NCHAR) { /* try to default csform to avoid translation through non-unicode */ if (CSFORM_IMPLIES_UTF8(SQLCS_NCHAR)) /* prefer NCHAR */ csform = SQLCS_NCHAR; else if (CSFORM_IMPLIES_UTF8(SQLCS_IMPLICIT)) csform = SQLCS_IMPLICIT; /* else leave csform == 0 */ if (trace_level || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), "dbd_rebind_ph_varchar2_table(): rebinding %s with UTF8 value %s", phs->name, (csform == SQLCS_NCHAR) ? "so setting csform=SQLCS_IMPLICIT" : (csform == SQLCS_IMPLICIT) ? "so setting csform=SQLCS_NCHAR" : "but neither CHAR nor NCHAR are unicode\n"); } }else{ if (trace_level >= 3 || dbd_verbose >= 3 ){ PerlIO_printf( DBIc_LOGPIO(imp_sth), "dbd_rebind_ph_varchar2_table(): is_utf8(array[%d])=false\n", i); } } } } if( phs->maxlen <=0 ){ phs->maxlen=maxlen; if (trace_level >= 2 || dbd_verbose >= 3 ){ PerlIO_printf( DBIc_LOGPIO(imp_sth), "dbd_rebind_ph_varchar2_table(): phs->maxlen calculated =%ld\n", (long)maxlen); } } else{ if (trace_level >= 2 || dbd_verbose >= 3 ){ PerlIO_printf( DBIc_LOGPIO(imp_sth), "dbd_rebind_ph_varchar2_table(): phs->maxlen forsed =%ld\n", (long)maxlen); } } } /* Do not allow string bind longer than max VARCHAR2=4000+1 */ if( phs->maxlen > 4001 ){ phs->maxlen=4001; } if( phs->array_numstruct == 0 ){ /* Oracle doesn't allow NULL buffers even for empty tables. Don't know why. */ phs->array_numstruct=1; } if( phs->ora_maxarray_numentries== 0 ){ /* Zero means "use current array length". */ phs->ora_maxarray_numentries=phs->array_numstruct; } need_allocate_rows=phs->ora_maxarray_numentries; if( need_allocate_rows< phs->array_numstruct ){ need_allocate_rows=phs->array_numstruct; } buflen=need_allocate_rows* phs->maxlen; /* We need buffer for at least ora_maxarray_numentries entries */ /* Upgrade array buffer to new length */ if( ora_realloc_phs_array(phs,need_allocate_rows,buflen) ){ croak("Unable to bind %s - %d structures by %d bytes requires too much memory.", phs->name, need_allocate_rows, buflen ); }else{ if (trace_level >= 2 || dbd_verbose >= 3 ){ PerlIO_printf( DBIc_LOGPIO(imp_sth), "dbd_rebind_ph_varchar2_table(): ora_realloc_phs_array(," "need_allocate_rows=%d,buflen=%d) succeeded.\n", need_allocate_rows,buflen); } } /* If maximum allowed bind numentries is less than allowed, * do not bind full array */ if( phs->array_numstruct > phs->ora_maxarray_numentries ){ phs->array_numstruct = phs->ora_maxarray_numentries; } /* Fill array buffer with string data */ { int i; /* Not to require C99 mode */ for(i=0;i0) ){ /* Limit string length to maxlen. FIXME: This may corrupt UTF-8 data. */ if( itemlen > (unsigned int) phs->maxlen-1 ){ itemlen=phs->maxlen-1; } memcpy( phs->array_buf+phs->maxlen*i, str, itemlen); /* Set last byte to zero */ phs->array_buf[ phs->maxlen*i + itemlen ]=0; phs->array_indicators[i]=0; phs->array_lengths[i]=itemlen+1; /* Zero byte */ if (trace_level >= 3 || dbd_verbose >= 3 ){ PerlIO_printf( DBIc_LOGPIO(imp_sth), "dbd_rebind_ph_varchar2_table(): " "Copying length=%lu array[%d]='%s'.\n", (unsigned long)itemlen,i,str); } }else{ /* Mark NULL */ phs->array_indicators[i]=1; if (trace_level >= 3 || dbd_verbose >= 3 ){ PerlIO_printf( DBIc_LOGPIO(imp_sth), "dbd_rebind_ph_varchar2_table(): " "Copying length=%lu array[%d]=NULL (length==0 or ! str) .\n", (unsigned long)itemlen,i); } } }else{ /* Mark NULL */ phs->array_indicators[i]=1; if (trace_level >= 3 || dbd_verbose >= 3 ) { PerlIO_printf( DBIc_LOGPIO(imp_sth), "dbd_rebind_ph_varchar2_table(): " "Copying length=? array[%d]=NULL av_fetch failed.\n", i); } } } } /* Do actual bind */ OCIBindByName_log_stat(imp_sth, imp_sth->stmhp, &phs->bndhp, imp_sth->errhp, (text*)phs->name, (sb4)strlen(phs->name), phs->array_buf, phs->maxlen, (ub2)SQLT_STR, phs->array_indicators, phs->array_lengths, /* ub2 *alen_ptr not needed with OCIBindDynamic */ (ub2)0, (ub4)phs->ora_maxarray_numentries, /* max elements that can fit in allocated array */ (ub4 *)&(phs->array_numstruct), /* (ptr to) current number of elements in array */ OCI_DEFAULT, /* OCI_DATA_AT_EXEC (bind with callbacks) or OCI_DEFAULT */ status ); if (status != OCI_SUCCESS) { oci_error(sth, imp_sth->errhp, status, "OCIBindByName"); return 0; } OCIBindArrayOfStruct_log_stat(imp_sth, phs->bndhp, imp_sth->errhp, (unsigned)phs->maxlen, /* Skip parameter for the next data value */ (unsigned)sizeof (OCIInd), /* Skip parameter for the next indicator value */ (unsigned)sizeof(unsigned short), /* Skip parameter for the next actual length value */ 0, /* Skip parameter for the next column-level error code */ status); if (status != OCI_SUCCESS) { oci_error(sth, imp_sth->errhp, status, "OCIBindArrayOfStruct"); return 0; } /* Fixup charset */ if (csform) { /* set OCI_ATTR_CHARSET_FORM before we get the default OCI_ATTR_CHARSET_ID */ OCIAttrSet_log_stat(imp_sth, phs->bndhp, (ub4) OCI_HTYPE_BIND, &csform, (ub4) 0, (ub4) OCI_ATTR_CHARSET_FORM, imp_sth->errhp, status); if ( status != OCI_SUCCESS ) { oci_error(sth, imp_sth->errhp, status, ora_sql_error(imp_sth,"OCIAttrSet (OCI_ATTR_CHARSET_FORM)")); return 0; } } if (!phs->csid_orig) { /* get the default csid Oracle would use */ OCIAttrGet_log_stat(imp_sth, phs->bndhp, OCI_HTYPE_BIND, &phs->csid_orig, (ub4)0 , OCI_ATTR_CHARSET_ID, imp_sth->errhp, status); } /* if app has specified a csid then use that, else use default */ csid = (phs->csid) ? phs->csid : phs->csid_orig; /* if data is utf8 but charset isn't then switch to utf8 csid */ if ( flag_data_is_utf8 && !CS_IS_UTF8(csid)) csid = utf8_csid; /* not al32utf8_csid here on purpose */ if (trace_level >= 3 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), "dbd_rebind_ph_varchar2_table(): bind %s <== %s " "(%s, %s, csid %d->%d->%d, ftype %d, csform %d (%s)->%d (%s), maxlen %lu, maxdata_size %lu)\n", phs->name, neatsvpv(phs->sv,0), (phs->is_inout) ? "inout" : "in", flag_data_is_utf8 ? "is-utf8" : "not-utf8", phs->csid_orig, phs->csid, csid, phs->ftype, phs->csform,oci_csform_name(phs->csform), csform,oci_csform_name(csform), (unsigned long)phs->maxlen, (unsigned long)phs->maxdata_size); if (csid) { OCIAttrSet_log_stat(imp_sth, phs->bndhp, (ub4) OCI_HTYPE_BIND, &csid, (ub4) 0, (ub4) OCI_ATTR_CHARSET_ID, imp_sth->errhp, status); if ( status != OCI_SUCCESS ) { oci_error(sth, imp_sth->errhp, status, ora_sql_error(imp_sth,"OCIAttrSet (OCI_ATTR_CHARSET_ID)")); return 0; } } if (phs->maxdata_size) { OCIAttrSet_log_stat(imp_sth, phs->bndhp, (ub4)OCI_HTYPE_BIND, phs->array_buf, (ub4)phs->array_buflen, (ub4)OCI_ATTR_MAXDATA_SIZE, imp_sth->errhp, status); if ( status != OCI_SUCCESS ) { oci_error(sth, imp_sth->errhp, status, ora_sql_error(imp_sth,"OCIAttrSet (OCI_ATTR_MAXDATA_SIZE)")); return 0; } } return 2; } /* Copy array data from array buffer into perl array */ /* Returns false on error, true on success */ int dbd_phs_varchar_table_posy_exe(imp_sth_t *imp_sth, phs_t *phs){ dTHX; int trace_level = DBIc_DBISTATE(imp_sth)->debug; AV *arr; if( ( ! SvROK(phs->sv) ) || (SvTYPE(SvRV(phs->sv))!=SVt_PVAV) ) { /* Allow only array binds */ croak("dbd_phs_varchar_table_posy_exe(): bad bind variable. ARRAY reference required, but got %s for '%s'.", neatsvpv(phs->sv,0), phs->name); } if (trace_level >= 1 || dbd_verbose >= 3 ){ PerlIO_printf(DBIc_LOGPIO(imp_sth), "dbd_phs_varchar_table_posy_exe(): Called for '%s' : array_numstruct=%d, maxlen=%ld \n", phs->name, phs->array_numstruct, (long)phs->maxlen ); } arr=(AV*)(SvRV(phs->sv)); /* If no data is returned, just clear the array. */ if( phs->array_numstruct <= 0 ){ av_clear(arr); return 1; } /* Delete extra data from array, if any */ while( av_len(arr) >= phs->array_numstruct ){ av_delete(arr,av_len(arr),G_DISCARD); }; /* Extend array, if needed. */ if( av_len(arr)+1 < phs->array_numstruct ){ av_extend(arr,phs->array_numstruct-1); } /* Fill array with buffer data */ { /* phs_t */ int i; /* Not to require C99 mode */ for(i=0;iarray_numstruct;i++){ SV *item,**pitem; pitem=av_fetch(arr,i,0); if( pitem ){ item=*pitem; } else{ item=NULL; } if( phs->array_indicators[i] == -1 ){ /* NULL */ if( item ){ SvSetMagicSV(item,&PL_sv_undef); if (trace_level >= 3 || dbd_verbose >= 3 ){ PerlIO_printf(DBIc_LOGPIO(imp_sth), "dbd_phs_varchar_table_posy_exe(): arr[%d] = undef; SvSetMagicSV(item,&PL_sv_undef);\n",i); } } else{ av_store(arr,i,&PL_sv_undef); if (trace_level >= 3 || dbd_verbose >= 3 ){ PerlIO_printf(DBIc_LOGPIO(imp_sth), "dbd_phs_varchar_table_posy_exe(): arr[%d] = undef; av_store(arr,i,&PL_sv_undef);\n",i); } } } else{ if( (phs->array_indicators[i] == -2) || (phs->array_indicators[i] > 0) ){ /* Truncation occurred */ if (trace_level >= 2 || dbd_verbose >= 3 ){ PerlIO_printf(DBIc_LOGPIO(imp_sth), "dbd_phs_varchar_table_posy_exe(): Placeholder '%s': data truncated at %d row.\n", phs->name,i); } } else{ /* All OK. Just copy value.*/ } if( item ){ sv_setpvn_mg(item,phs->array_buf+phs->maxlen*i,phs->array_lengths[i]); SvPOK_only_UTF8(item); if (trace_level >= 3 || dbd_verbose >= 3 ){ PerlIO_printf(DBIc_LOGPIO(imp_sth), "dbd_phs_varchar_table_posy_exe(): arr[%d] = '%s'; " "sv_setpvn_mg(item,phs->array_buf+phs->maxlen*i,phs->array_lengths[i]); \n", i, phs->array_buf+phs->maxlen*i ); } } else{ av_store(arr,i,newSVpvn(phs->array_buf+phs->maxlen*i,phs->array_lengths[i])); if (trace_level >= 3 || dbd_verbose >= 3 ){ PerlIO_printf(DBIc_LOGPIO(imp_sth), "dbd_phs_varchar_table_posy_exe(): arr[%d] = '%s'; " "av_store(arr,i,newSVpvn(phs->array_buf+phs->maxlen*i,phs->array_lengths[i])); \n", i, phs->array_buf+phs->maxlen*i ); } } } } } if (trace_level >= 2 || dbd_verbose >= 3 ){ PerlIO_printf(DBIc_LOGPIO(imp_sth), "dbd_phs_varchar_table_posy_exe(): scalar(@arr)=%ld.\n", (long)av_len(arr)+1); } return 1; } /* bind of SYS.DBMS_SQL.NUMBER_TABLE */ int dbd_rebind_ph_number_table(SV *sth, imp_sth_t *imp_sth, phs_t *phs) { dTHX; /*D_imp_dbh_from_sth ;*/ sword status; int trace_level = DBIc_DBISTATE(imp_sth)->debug; AV *arr; int need_allocate_rows; int buflen; int numarrayentries; /*int flag_data_is_utf8=0;*/ if( ( ! SvROK(phs->sv) ) || (SvTYPE(SvRV(phs->sv))!=SVt_PVAV) ) { /* Allow only array binds */ croak("dbd_rebind_ph_number_table(): bad bind variable. ARRAY reference required, but got %s for '%s'.", neatsvpv(phs->sv,0), phs->name); } /* Default bind type for number table is double. */ if( ! phs->ora_internal_type ){ phs->ora_internal_type=SQLT_FLT; }else{ if( (phs->ora_internal_type != SQLT_FLT) && (phs->ora_internal_type != SQLT_INT) ){ croak("dbd_rebind_ph_number_table(): Specified internal bind type %d unsupported. " "SYS.DBMS_SQL.NUMBER_TABLE can be bound only to SQLT_FLT or SQLT_INT datatypes.", phs->ora_internal_type); } } arr=(AV*)(SvRV(phs->sv)); if (trace_level >= 2 || dbd_verbose >= 3 ){ PerlIO_printf( DBIc_LOGPIO(imp_sth), "dbd_rebind_ph_number_table(): array_numstruct=%d\n", phs->array_numstruct); } /* If no number of entries to bind specified,*/ /* set phs->array_numstruct to the scalar(@array) bound.*/ /* av_len() returns last array index, or -1 is array is empty */ numarrayentries=av_len( arr ); if( numarrayentries >= 0 ){ phs->array_numstruct = numarrayentries+1; if (trace_level >= 2 || dbd_verbose >= 3 ){ PerlIO_printf( DBIc_LOGPIO(imp_sth), "dbd_rebind_ph_number_table(): array_numstruct=%d (calculated) \n", phs->array_numstruct); } } /* Calculate each bound structure maxlen. * maxlen(int) = sizeof(int); * maxlen(double) = sizeof(double); */ switch( phs->ora_internal_type ){ case SQLT_INT: phs->maxlen=sizeof(int); break; case SQLT_FLT: default: phs->maxlen=sizeof(double); } if (trace_level >= 2 || dbd_verbose >= 3 ){ PerlIO_printf( DBIc_LOGPIO(imp_sth), "dbd_rebind_ph_number_table(): phs->maxlen calculated =%ld\n", (long)phs->maxlen); } if( phs->array_numstruct == 0 ){ /* Oracle doesn't allow NULL buffers even for empty tables. Don't know why. */ phs->array_numstruct=1; } if( phs->ora_maxarray_numentries== 0 ){ /* Zero means "use current array length". */ phs->ora_maxarray_numentries=phs->array_numstruct; if (trace_level >= 2 || dbd_verbose >= 3 ){ PerlIO_printf( DBIc_LOGPIO(imp_sth), "dbd_rebind_ph_number_table(): ora_maxarray_numentries " "assumed=phs->array_numstruct=%d\n", phs->array_numstruct); } }else{ if (trace_level >= 2 || dbd_verbose >= 3 ){ PerlIO_printf( DBIc_LOGPIO(imp_sth), "dbd_rebind_ph_number_table(): ora_maxarray_numentries=%d\n", phs->ora_maxarray_numentries); } } need_allocate_rows=phs->ora_maxarray_numentries; if( need_allocate_rows< phs->array_numstruct ){ need_allocate_rows=phs->array_numstruct; } buflen=need_allocate_rows* phs->maxlen; /* We need buffer for at least ora_maxarray_numentries entries */ /* Upgrade array buffer to new length */ if( ora_realloc_phs_array(phs,need_allocate_rows,buflen) ){ croak("Unable to bind %s - %d structures by %d bytes requires too much memory.", phs->name, need_allocate_rows, buflen ); }else{ if (trace_level >= 2 || dbd_verbose >= 3 ){ PerlIO_printf( DBIc_LOGPIO(imp_sth), "dbd_rebind_ph_number_table(): ora_realloc_phs_array(," "need_allocate_rows=%d,buflen=%d) succeeded.\n", need_allocate_rows,buflen); } } /* If maximum allowed bind numentries is less than allowed, * do not bind full array */ if( phs->array_numstruct > phs->ora_maxarray_numentries ){ phs->array_numstruct = phs->ora_maxarray_numentries; } /* Fill array buffer with data */ { int i; /* Not to require C99 mode */ for(i=0;iora_internal_type ){ case SQLT_INT: { int ival =0; int val_found=0; /* Double values are converted as int(val) */ if( SvOK( item ) && ! SvIOK( item ) ){ double val=SvNVx( item ); if( SvNOK( item ) ){ ival=(int) val; val_found=1; } } /* Convert item, if possible. */ if( (!val_found) && SvOK( item ) && ! SvIOK( item ) ){ SvIVx( item ); } if( SvIOK( item ) || val_found ){ if( ! val_found ){ ival=SvIV( item ); } /* as phs->array_buf=malloc(), proper alignment is guaranteed */ *(int*)(phs->array_buf+phs->maxlen*i)=ival; phs->array_indicators[i]=0; }else{ if( SvOK( item ) ){ /* Defined NaN assumed =0 */ *(int*)(phs->array_buf+phs->maxlen*i)=0; phs->array_indicators[i]=0; }else{ /* NULL */ phs->array_indicators[i]=1; } } phs->array_lengths[i]=sizeof(int); if (trace_level >= 3 || dbd_verbose >= 3 ){ PerlIO_printf( DBIc_LOGPIO(imp_sth), "dbd_rebind_ph_number_table(): " "(integer) array[%d]=%d%s\n", i, *(int*)(phs->array_buf+phs->maxlen*i), phs->array_indicators[i] ? " (NULL)" : "" ); } } break; case SQLT_FLT: default: { phs->ora_internal_type=SQLT_FLT; /* Just in case */ /* Convert item, if possible. */ if( SvOK( item ) && ! SvNOK( item ) ){ SvNVx( item ); } if( SvNOK( item ) ){ double val=SvNVx( item ); /* as phs->array_buf=malloc(), proper alignment is guaranteed */ *(double*)(phs->array_buf+phs->maxlen*i)=val; phs->array_indicators[i]=0; if (trace_level >= 3 || dbd_verbose >= 3 ){ PerlIO_printf( DBIc_LOGPIO(imp_sth), "dbd_rebind_ph_number_table(): " "let (double) array[%d]=%f - NOT NULL\n", i, val); } }else{ if( SvOK( item ) ){ /* Defined NaN assumed =0 */ *(double*)(phs->array_buf+phs->maxlen*i)=0; phs->array_indicators[i]=0; if (trace_level >= 2 || dbd_verbose >= 3 ){ STRLEN l; char *p=SvPV(item,l); PerlIO_printf( DBIc_LOGPIO(imp_sth), "dbd_rebind_ph_number_table(): " "let (double) array[%d]=\"%s\" =NaN. Set =0 - NOT NULL\n", i, p ? p : "" ); } }else{ /* NULL */ phs->array_indicators[i]=1; if (trace_level >= 3 || dbd_verbose >= 3 ){ PerlIO_printf( DBIc_LOGPIO(imp_sth), "dbd_rebind_ph_number_table(): " "let (double) array[%d] NULL\n", i); } } } phs->array_lengths[i]=sizeof(double); if (trace_level >= 3 || dbd_verbose >= 3 ){ PerlIO_printf( DBIc_LOGPIO(imp_sth), "dbd_rebind_ph_number_table(): " "(double) array[%d]=%f%s\n", i, *(double*)(phs->array_buf+phs->maxlen*i), phs->array_indicators[i] ? " (NULL)" : "" ); } } break; } }else{ /* item not defined, mark NULL */ phs->array_indicators[i]=1; if (trace_level >= 3 || dbd_verbose >= 3 ){ PerlIO_printf( DBIc_LOGPIO(imp_sth), "dbd_rebind_ph_number_table(): " "Copying length=? array[%d]=NULL av_fetch failed.\n", i); } } } } /* Do actual bind */ OCIBindByName_log_stat(imp_sth, imp_sth->stmhp, &phs->bndhp, imp_sth->errhp, (text*)phs->name, (sb4)strlen(phs->name), phs->array_buf, phs->maxlen, (ub2)phs->ora_internal_type, phs->array_indicators, phs->array_lengths, (ub2)0, (ub4)phs->ora_maxarray_numentries, /* max elements that can fit in allocated array */ (ub4 *)&(phs->array_numstruct), /* (ptr to) current number of elements in array */ OCI_DEFAULT, /* OCI_DATA_AT_EXEC (bind with callbacks) or OCI_DEFAULT */ status ); if (status != OCI_SUCCESS) { oci_error(sth, imp_sth->errhp, status, "OCIBindByName"); return 0; } OCIBindArrayOfStruct_log_stat(imp_sth, phs->bndhp, imp_sth->errhp, (unsigned)phs->maxlen, /* Skip parameter for the next data value */ (unsigned)sizeof(OCIInd), /* Skip parameter for the next indicator value */ (unsigned)sizeof(unsigned short), /* Skip parameter for the next actual length value */ 0, /* Skip parameter for the next column-level error code */ status); if (status != OCI_SUCCESS) { oci_error(sth, imp_sth->errhp, status, "OCIBindArrayOfStruct"); return 0; } if (phs->maxdata_size) { OCIAttrSet_log_stat(imp_sth, phs->bndhp, (ub4)OCI_HTYPE_BIND, phs->array_buf, (ub4)phs->array_buflen, (ub4)OCI_ATTR_MAXDATA_SIZE, imp_sth->errhp, status); if ( status != OCI_SUCCESS ) { oci_error(sth, imp_sth->errhp, status, ora_sql_error(imp_sth,"OCIAttrSet (OCI_ATTR_MAXDATA_SIZE)")); return 0; } } return 2; } /* Copy array data from array buffer into perl array */ /* Returns false on error, true on success */ int dbd_phs_number_table_post_exe(imp_sth_t *imp_sth, phs_t *phs){ dTHX; int trace_level = DBIc_DBISTATE(imp_sth)->debug; AV *arr; if( ( ! SvROK(phs->sv) ) || (SvTYPE(SvRV(phs->sv))!=SVt_PVAV) ) { /* Allow only array binds */ croak("dbd_phs_number_table_post_exe(): bad bind variable. ARRAY reference required, but got %s for '%s'.", neatsvpv(phs->sv,0), phs->name); } if (trace_level >= 1 || dbd_verbose >= 3 ){ PerlIO_printf(DBIc_LOGPIO(imp_sth), "dbd_phs_number_table_post_exe(): Called for '%s' : array_numstruct=%d, maxlen=%ld \n", phs->name, phs->array_numstruct, (long)phs->maxlen ); } /* At this point, ora_internal_type can't be default. It must be set at bind time. */ if( (phs->ora_internal_type != SQLT_FLT) && (phs->ora_internal_type != SQLT_INT) ){ croak("dbd_rebind_ph_number_table(): Specified internal bind type %d unsupported. " "SYS.DBMS_SQL.NUMBER_TABLE can be bound only to SQLT_FLT, SQLT_INT datatypes.", phs->ora_internal_type); } arr=(AV*)(SvRV(phs->sv)); /* If no data is returned, just clear the array. */ if( phs->array_numstruct <= 0 ){ av_clear(arr); return 1; } /* Delete extra data from array, if any */ while( av_len(arr) >= phs->array_numstruct ){ av_delete(arr,av_len(arr),G_DISCARD); }; /* Extend array, if needed. */ if( av_len(arr)+1 < phs->array_numstruct ){ av_extend(arr,phs->array_numstruct-1); } /* Fill array with buffer data */ { /* phs_t */ int i; /* Not to require C99 mode */ for(i=0;iarray_numstruct;i++){ SV *item,**pitem; pitem=av_fetch(arr,i,0); if( pitem ){ item=*pitem; }else{ item=NULL; } if( phs->array_indicators[i] == -1 ){ /* NULL */ if( item ){ SvSetMagicSV(item,&PL_sv_undef); if (trace_level >= 3 || dbd_verbose >= 3 ){ PerlIO_printf(DBIc_LOGPIO(imp_sth), "dbd_phs_number_table_post_exe(): arr[%d] = undef; SvSetMagicSV(item,&PL_sv_undef);\n", i ); } }else{ av_store(arr,i,&PL_sv_undef); if (trace_level >= 3 || dbd_verbose >= 3 ){ PerlIO_printf(DBIc_LOGPIO(imp_sth), "dbd_phs_number_table_post_exe(): arr[%d] = undef; av_store(arr,i,&PL_sv_undef);\n", i ); } } }else{ if( (phs->array_indicators[i] == -2) || (phs->array_indicators[i] > 0) ){ /* Truncation occurred */ if (trace_level >= 2 || dbd_verbose >= 3 ){ PerlIO_printf(DBIc_LOGPIO(imp_sth), "dbd_phs_number_table_post_exe(): Placeholder '%s': data truncated at %d row.\n", phs->name,i); } }else{ /* All OK. Just copy value.*/ } if( item ){ switch(phs->ora_internal_type){ case SQLT_INT: if (trace_level >= 4 || dbd_verbose >= 4 ){ PerlIO_printf(DBIc_LOGPIO(imp_sth), "dbd_phs_number_table_post_exe(): (int) set arr[%d] = %d \n", i, *(int*)(phs->array_buf+phs->maxlen*i) ); } sv_setiv_mg(item,*(int*)(phs->array_buf+phs->maxlen*i)); break; case SQLT_FLT: if (trace_level >= 4 || dbd_verbose >= 4 ){ PerlIO_printf(DBIc_LOGPIO(imp_sth), "dbd_phs_number_table_post_exe(): (double) set arr[%d] = %f \n", i, *(double*)(phs->array_buf+phs->maxlen*i) ); } sv_setnv_mg(item,*(double*)(phs->array_buf+phs->maxlen*i)); } if (trace_level >= 3 || dbd_verbose >= 3 ){ STRLEN l; char *str= SvPOK(item) ? SvPV(item,l) : "" ; PerlIO_printf(DBIc_LOGPIO(imp_sth), "dbd_phs_number_table_post_exe(): arr[%d] = '%s'\n", i, str ? str : "" ); } }else{ switch(phs->ora_internal_type){ case SQLT_INT: if (trace_level >= 4 || dbd_verbose >= 4 ){ PerlIO_printf(DBIc_LOGPIO(imp_sth), "dbd_phs_number_table_post_exe(): (int) store new arr[%d] = %d \n", i, *(int*)(phs->array_buf+phs->maxlen*i) ); } av_store(arr,i,newSViv( *(int*)(phs->array_buf+phs->maxlen*i) )); break; case SQLT_FLT: if (trace_level >= 4 || dbd_verbose >= 4 ){ PerlIO_printf(DBIc_LOGPIO(imp_sth), "dbd_phs_number_table_post_exe(): (double) store new arr[%d] = %f \n", i, *(double*)(phs->array_buf+phs->maxlen*i) ); } av_store(arr,i,newSVnv( *(double*)(phs->array_buf+phs->maxlen*i) )); } if (trace_level >= 3 || dbd_verbose >= 3 ){ STRLEN l; char *str; SV**pitem=av_fetch(arr,i,0); if( pitem ){ item=*pitem; } str= item ? ( SvPOK(item) ? SvPV(item,l) : "" ) : ""; PerlIO_printf(DBIc_LOGPIO(imp_sth), "dbd_phs_number_table_post_exe(): arr[%d] = '%s'\n", i, str ? str : "" ); } } } } } if (trace_level >= 2 || dbd_verbose >= 3 ){ PerlIO_printf(DBIc_LOGPIO(imp_sth), "dbd_phs_number_table_post_exe(): scalar(@arr)=%ld.\n", (long)av_len(arr)+1); } return 1; } static int dbd_rebind_ph_char(imp_sth_t *imp_sth, phs_t *phs) { dTHX; STRLEN value_len; int at_exec = 0; at_exec = (phs->desc_h == NULL); if (!SvPOK(phs->sv)) { /* normalizations for special cases */ if (SvOK(phs->sv)) { /* ie a number, convert to string ASAP */ if (!(SvROK(phs->sv) && phs->is_inout)) sv_2pv(phs->sv, &PL_na); } else /* ensure we're at least an SVt_PV (so SvPVX etc work) */ (void) SvUPGRADE(phs->sv, SVt_PV); } if (DBIc_DBISTATE(imp_sth)->debug >= 2 || dbd_verbose >= 3 ) { char *val = neatsvpv(phs->sv,10); PerlIO_printf( DBIc_LOGPIO(imp_sth), "dbd_rebind_ph_char() (1): bind %s <== %.1000s (", phs->name, val); if (!SvOK(phs->sv)) PerlIO_printf(DBIc_LOGPIO(imp_sth), "NULL, "); PerlIO_printf( DBIc_LOGPIO(imp_sth), "size %ld/%ld/%ld, ", (long)SvCUR(phs->sv),(long)SvLEN(phs->sv),(long)phs->maxlen); PerlIO_printf( DBIc_LOGPIO(imp_sth), "ptype %d(%s), otype %d %s)\n", (int)SvTYPE(phs->sv), sql_typecode_name(phs->ftype), phs->ftype,(phs->is_inout) ? ", inout" : ""); } /* At the moment we always do sv_setsv() and rebind. */ /* Later we may optimise this so that more often we can */ /* just copy the value & length over and not rebind. */ if (phs->is_inout) { /* XXX */ if (SvREADONLY(phs->sv)) croak("Modification of a read-only value attempted"); if (imp_sth->ora_pad_empty) croak("Can't use ora_pad_empty with bind_param_inout"); if (SvTYPE(phs->sv)!=SVt_RV || !at_exec) { if (phs->ftype == 96){ SvGROW(phs->sv,(STRLEN) (unsigned int)phs->maxlen-1); if (DBIc_DBISTATE(imp_sth)->debug >= 6 || dbd_verbose >= 6) { PerlIO_printf(DBIc_LOGPIO(imp_sth), "Growing 96 phs sv to %ld resulted in buffer %ld\n", phs->maxlen - 1, SvLEN(phs->sv)); } } else { STRLEN min_len = 28; (void)SvUPGRADE(phs->sv, SVt_PVNV); /* ensure room for result, 28 is magic number (see sv_2pv) */ /* don't apply 28 char min to CHAR types - probably shouldn't */ /* apply it anywhere really, trying to be too helpful. */ /* phs->sv _is_ the real live variable, it may 'mutate' later */ /* pre-upgrade to high'ish type to reduce risk of SvPVX realloc/move */ /* NOTE SvGROW resets SvOOK_offset and we want to do this */ SvGROW(phs->sv, (STRLEN)(((unsigned int) phs->maxlen <= min_len) ? min_len : (unsigned int) phs->maxlen)); if (DBIc_DBISTATE(imp_sth)->debug >= 6 || dbd_verbose >= 6) { PerlIO_printf(DBIc_LOGPIO(imp_sth), "Growing phs sv to %ld resulted in buffer %ld\n", phs->maxlen +1, SvLEN(phs->sv)); } } } } /* At this point phs->sv must be at least a PV with a valid buffer, */ /* even if it's undef (null) */ /* Here we set phs->progv, phs->indp, and value_len. */ if (SvOK(phs->sv)) { phs->progv = SvPV(phs->sv, value_len); phs->indp = 0; } else { /* it's null but point to buffer incase it's an out var */ phs->progv = (phs->is_inout) ? SvPVX(phs->sv) : NULL; phs->indp = -1; value_len = 0; } if (imp_sth->ora_pad_empty && value_len==0) { sv_setpv(phs->sv, " "); phs->progv = SvPV(phs->sv, value_len); } phs->sv_type = SvTYPE(phs->sv); /* part of mutation check */ if (SvTYPE(phs->sv) == SVt_RV && SvTYPE(SvRV(phs->sv)) == SVt_PVAV) { /* it is returning an array of scalars not a single scalar*/ phs->maxlen = 4000; /* Just make is a varchar max should be ok for most things*/ } else { if (DBIc_DBISTATE(imp_sth)->debug >= 6|| dbd_verbose >= 6 ) { PerlIO_printf(DBIc_LOGPIO(imp_sth), "Changing maxlen to %ld\n", SvLEN(phs->sv)); } phs->maxlen = ((IV)SvLEN(phs->sv)); /* avail buffer space (64bit safe) Logicaly maxlen should never change but it does why I know not - MJE because SvGROW can allocate more than you ask for - anyway - I fixed that and it doesn't grow anymore */ } if (phs->maxlen < 0) /* can happen with nulls */ phs->maxlen = 0; phs->alen = value_len + phs->alen_incnull; if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) { /*UV neatsvpvlen = (UV)DBIc_DBISTATE(imp_sth)->neatsvpvlen;*/ char *val = neatsvpv(phs->sv,10); PerlIO_printf( DBIc_LOGPIO(imp_sth), "dbd_rebind_ph_char() (2): bind %s <== %.1000s (size %ld/%ld, " "otype %d(%s), indp %d, at_exec %d)\n", phs->name, (phs->progv) ? val: "", (long)phs->alen, (long)phs->maxlen, phs->ftype,sql_typecode_name(phs->ftype), phs->indp, at_exec); } return 1; } /* * Rebind an "in" cursor ref to its real statement handle * This allows passing cursor refs as "in" to pl/sql (but only if you got the * cursor from pl/sql to begin with) */ int pp_rebind_ph_rset_in(SV *sth, imp_sth_t *imp_sth, phs_t *phs) { dTHX; dTHR; SV * sth_csr = phs->sv; D_impdata(imp_sth_csr, imp_sth_t, sth_csr); sword status; if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " pp_rebind_ph_rset_in: BEGIN\n calling OCIBindByName(stmhp=%p, " "bndhp=%p, errhp=%p, name=%s, csrstmhp=%p, ftype=%d)\n", imp_sth->stmhp, phs->bndhp, imp_sth->errhp, phs->name, imp_sth_csr->stmhp, phs->ftype); OCIBindByName_log_stat(imp_sth, imp_sth->stmhp, &phs->bndhp, imp_sth->errhp, (text*)phs->name, (sb4)strlen(phs->name), &imp_sth_csr->stmhp, 0, (ub2)phs->ftype, 0, NULL, 0, 0, NULL, (ub4)OCI_DEFAULT, status ); if (status != OCI_SUCCESS) { oci_error(sth, imp_sth->errhp, status, "OCIBindByName SQLT_RSET"); return 0; } if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) PerlIO_printf(DBIc_LOGPIO(imp_sth), " pp_rebind_ph_rset_in: END\n"); return 2; } int pp_exec_rset(SV *sth, imp_sth_t *imp_sth, phs_t *phs, int pre_exec) { dTHX; if (pre_exec) { /* pre-execute - throw away previous descriptor and rebind */ sword status; if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " pp_exec_rset bind %s - allocating new sth...\n", phs->name); /* extproc deallocates everything for us */ if (is_extproc) return 1; if (!phs->desc_h || 1) { /* XXX phs->desc_t != OCI_HTYPE_STMT) */ if (phs->desc_h) { OCIHandleFree_log_stat(imp_sth, phs->desc_h, phs->desc_t, status); phs->desc_h = NULL; } phs->desc_t = OCI_HTYPE_STMT; OCIHandleAlloc_ok(imp_sth, imp_sth->envhp, &phs->desc_h, phs->desc_t, status); } phs->progv = (char*)&phs->desc_h; phs->maxlen = 0; OCIBindByName_log_stat(imp_sth, imp_sth->stmhp, &phs->bndhp, imp_sth->errhp, (text*)phs->name, (sb4)strlen(phs->name), phs->progv, 0, (ub2)phs->ftype, /* I, MJE have no evidence that passing an indicator to this func causes ORA-01001 (invalid cursor) errors. Also, without it you cannot test the indicator to check we have a valid output parameter. However, it would seem when you do specify an indicator it always comes back as 0 so it is useless. */ NULL, /* using &phs->indp triggers ORA-01001 errors! */ NULL, 0, 0, NULL, OCI_DEFAULT, status); if (status != OCI_SUCCESS) { oci_error(sth, imp_sth->errhp, status, "OCIBindByName SQLT_RSET"); return 0; } /* NOTE: The code used to magic a DBI stmt handle into existence here before even knowing if the output parameter was going to be a valid open cursor. The code to do this moved to post execute below. See RT 82663 - Errors if a returned SYS_REFCURSOR is not opened */ } else { /* post-execute - setup the statement handle */ dTHR; dSP; D_imp_dbh_from_sth; HV *init_attr = newHV(); int count; ub4 stmt_state = 99; sword status; SV * sth_csr; /* Before we go to the bother of attempting to allocate a new sth for this cursor make sure the Oracle sth is executed i.e., the returned cursor may never have been opened */ OCIAttrGet_stmhp_stat2(imp_sth, (OCIStmt*)phs->desc_h, &stmt_state, 0, OCI_ATTR_STMT_STATE, status); if (status != OCI_SUCCESS) { oci_error(sth, imp_sth->errhp, status, "OCIAttrGet OCI_ATTR_STMT_STATE"); return 0; } if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) { /* initialized=1, executed=2, end of fetch=3 */ PerlIO_printf( DBIc_LOGPIO(imp_sth), " returned cursor/statement state: %u\n", stmt_state); } /* We seem to get an indp of 0 even for a cursor which was never opened and set to NULL. If this is the case we check the stmt state and find the cursor is initialized but not executed - there is no point in going any further if it is not executed - just return undef. See RT 82663 */ if (stmt_state == OCI_STMT_STATE_INITIALIZED) { OCIHandleFree_log_stat(imp_sth, (OCIStmt *)phs->desc_h, OCI_HTYPE_STMT, status); if (status != OCI_SUCCESS) { oci_error(sth, imp_sth->errhp, status, "OCIHandleFree"); return 0; } phs->desc_h = NULL; phs->sv = newSV(0); /* undef */ return 1; } /* Now we know we have an executed cursor create a new sth */ ENTER; SAVETMPS; PUSHMARK(SP); XPUSHs(sv_2mortal(newRV((SV*)DBIc_MY_H(imp_dbh)))); XPUSHs(sv_2mortal(newRV((SV*)init_attr))); PUTBACK; count = perl_call_pv("DBI::_new_sth", G_ARRAY); SPAGAIN; if (count != 2) croak("panic: DBI::_new_sth returned %d values instead of 2", count); (void)POPs; /* discard inner handle */ sv_setsv(phs->sv, POPs); /* save outer handle */ SvREFCNT_dec(init_attr); PUTBACK; FREETMPS; LEAVE; if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " pp_exec_rset bind %s - allocated %s...\n", phs->name, neatsvpv(phs->sv, 0)); sth_csr = phs->sv; if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " bind %s - initialising new %s for cursor 0x%lx...\n", phs->name, neatsvpv(sth_csr,0), (unsigned long)phs->progv); { D_impdata(imp_sth_csr, imp_sth_t, sth_csr); /* TO_DO */ /* copy appropriate handles and atributes from parent statement */ imp_sth_csr->envhp = imp_sth->envhp; imp_sth_csr->errhp = imp_sth->errhp; imp_sth_csr->srvhp = imp_sth->srvhp; imp_sth_csr->svchp = imp_sth->svchp; imp_sth_csr->auto_lob = imp_sth->auto_lob; imp_sth_csr->pers_lob = imp_sth->pers_lob; imp_sth_csr->clbk_lob = imp_sth->clbk_lob; imp_sth_csr->piece_size = imp_sth->piece_size; imp_sth_csr->piece_lob = imp_sth->piece_lob; imp_sth_csr->is_child = 1; /*no prefetching on a cursor or sp*/ /* assign statement handle from placeholder descriptor */ imp_sth_csr->stmhp = (OCIStmt*)phs->desc_h; phs->desc_h = NULL; /* tell phs that we own it now */ /* force stmt_type since OCIAttrGet(OCI_ATTR_STMT_TYPE) doesn't work! */ imp_sth_csr->stmt_type = OCI_STMT_SELECT; DBIc_IMPSET_on(imp_sth_csr); /* set ACTIVE so dbd_describe doesn't do explicit OCI describe */ DBIc_ACTIVE_on(imp_sth_csr); if (!dbd_describe(sth_csr, imp_sth_csr)) { return 0; } } } return 1; } static int dbd_rebind_ph_xml( SV* sth, imp_sth_t *imp_sth, phs_t *phs) { dTHX; dTHR; OCIType *tdo = NULL; sword status; SV* ptr; if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) PerlIO_printf(DBIc_LOGPIO(imp_sth), " in dbd_rebind_ph_xml\n"); /*go and create the XML dom from the passed in value*/ phs->sv=createxmlfromstring(sth, imp_sth, phs->sv ); if (phs->is_inout) croak("OUT binding for NTY is currently unsupported"); /* ensure that the value is a support named object type */ /* (currently only OCIXMLType*) */ if ( sv_isa(phs->sv, "OCIXMLTypePtr") ) { /* TO_DO not logging: */ OCITypeByName_log( imp_sth, imp_sth->envhp, imp_sth->errhp, imp_sth->svchp, (CONST text*)"SYS", 3, /* schema_name, schema_length */ (CONST text*)"XMLTYPE", 7, /* type_name, type_length */ (CONST text*)0, 0, /* version_name, version_length */ OCI_DURATION_CALLOUT, /* pin_duration */ OCI_TYPEGET_HEADER, /* get_option */ &tdo, /* tdo */ status); ptr = SvRV(phs->sv); phs->progv = (void*) SvIV(ptr); phs->maxlen = sizeof(OCIXMLType*); } else croak("Unsupported named object type for bind parameter"); /* bind by name */ OCIBindByName_log_stat(imp_sth, imp_sth->stmhp, &phs->bndhp, imp_sth->errhp, (text*)phs->name, (sb4)strlen(phs->name), (dvoid *) NULL, /* value supplied in BindObject later */ 0, (ub2)phs->ftype, 0, NULL, 0, 0, NULL, (ub4)OCI_DEFAULT, status ); if (status != OCI_SUCCESS) { oci_error(sth, imp_sth->errhp, status, "OCIBindByName SQLT_NTY"); return 0; } if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) PerlIO_printf(DBIc_LOGPIO(imp_sth), " pp_rebind_ph_nty: END\n"); /* bind the object */ OCIBindObject(phs->bndhp, imp_sth->errhp, (CONST OCIType*)tdo, (dvoid **)&phs->progv, (ub4*)NULL, (dvoid **)NULL, (ub4*)NULL); return 2; } static int dbd_rebind_ph(SV *sth, imp_sth_t *imp_sth, phs_t *phs) { dTHX; /*ub2 *alen_ptr = NULL;*/ sword status; int done = 0; int at_exec; int trace_level = DBIc_DBISTATE(imp_sth)->debug; ub1 csform; ub2 csid; if (trace_level >= 5 || dbd_verbose >= 5 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), "dbd_rebind_ph() (1): rebinding %s as %s (%s, ftype %d (%s), " "csid %d, csform %d(%s), inout %d)\n", phs->name, (SvPOK(phs->sv) ? neatsvpv(phs->sv,10) : "NULL"), (SvUTF8(phs->sv) ? "is-utf8" : "not-utf8"), phs->ftype,sql_typecode_name(phs->ftype), phs->csid, phs->csform, oci_csform_name(phs->csform), phs->is_inout); switch (phs->ftype) { case ORA_VARCHAR2_TABLE: done = dbd_rebind_ph_varchar2_table(sth, imp_sth, phs); break; case ORA_NUMBER_TABLE: done = dbd_rebind_ph_number_table(sth, imp_sth, phs); break; case SQLT_CLOB: case SQLT_BLOB: done = dbd_rebind_ph_lob(sth, imp_sth, phs); break; case SQLT_RSET: done = dbd_rebind_ph_rset(sth, imp_sth, phs); break; case ORA_XMLTYPE: done = dbd_rebind_ph_xml(sth, imp_sth, phs); break; default: done = dbd_rebind_ph_char(imp_sth, phs); } if (done == 2) { /* the dbd_rebind_* did the OCI bind call itself successfully */ if (trace_level >= 3 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " rebind %s done with ftype %d (%s)\n", phs->name, phs->ftype,sql_typecode_name(phs->ftype)); return 1; } if (trace_level >= 3 || dbd_verbose >= 3 ) PerlIO_printf(DBIc_LOGPIO(imp_sth), " bind %s as ftype %d (%s)\n", phs->name, phs->ftype,sql_typecode_name(phs->ftype)); if (done != 1) { return 0; /* the rebind failed */ } at_exec = (phs->desc_h == NULL); OCIBindByName_log_stat(imp_sth, imp_sth->stmhp, &phs->bndhp, imp_sth->errhp, (text*)phs->name, (sb4)strlen(phs->name), phs->progv, phs->maxlen ? (sb4)phs->maxlen : 1, /* else bind "" fails */ (ub2)phs->ftype, &phs->indp, NULL, /* ub2 *alen_ptr not needed with OCIBindDynamic */ &phs->arcode, 0, /* max elements that can fit in allocated array */ NULL, /* (ptr to) current number of elements in array */ (ub4)(at_exec ? OCI_DATA_AT_EXEC : OCI_DEFAULT), status ); if (status != OCI_SUCCESS) { oci_error(sth, imp_sth->errhp, status, "OCIBindByName"); return 0; } if (at_exec) { OCIBindDynamic_log(imp_sth, phs->bndhp, imp_sth->errhp, (dvoid *)phs, dbd_phs_in, (dvoid *)phs, dbd_phs_out, status); if (status != OCI_SUCCESS) { oci_error(sth, imp_sth->errhp, status, "OCIBindDynamic"); return 0; } } /* some/all of the following should perhaps move into dbd_phs_in() */ csform = phs->csform; if (!csform && SvUTF8(phs->sv)) { /* try to default csform to avoid translation through non-unicode */ if (CSFORM_IMPLIES_UTF8(SQLCS_IMPLICIT)) /* prefer IMPLICIT */ csform = SQLCS_IMPLICIT; else if (CSFORM_IMPLIES_UTF8(SQLCS_NCHAR)) csform = SQLCS_NCHAR; /* else leave csform == 0 */ if (trace_level || dbd_verbose >= 3) PerlIO_printf( DBIc_LOGPIO(imp_sth), "dbd_rebind_ph() (2): rebinding %s with UTF8 value %s", phs->name, (csform == SQLCS_IMPLICIT) ? "so setting csform=SQLCS_IMPLICIT" : (csform == SQLCS_NCHAR) ? "so setting csform=SQLCS_NCHAR" : "but neither CHAR nor NCHAR are unicode\n"); } if (csform) { /* set OCI_ATTR_CHARSET_FORM before we get the default OCI_ATTR_CHARSET_ID */ OCIAttrSet_log_stat(imp_sth, phs->bndhp, (ub4) OCI_HTYPE_BIND, &csform, (ub4) 0, (ub4) OCI_ATTR_CHARSET_FORM, imp_sth->errhp, status); if ( status != OCI_SUCCESS ) { oci_error(sth, imp_sth->errhp, status, ora_sql_error(imp_sth,"OCIAttrSet (OCI_ATTR_CHARSET_FORM)")); return 0; } } if (!phs->csid_orig) { /* get the default csid Oracle would use */ OCIAttrGet_log_stat(imp_sth, phs->bndhp, OCI_HTYPE_BIND, &phs->csid_orig, (ub4)0 , OCI_ATTR_CHARSET_ID, imp_sth->errhp, status); } /* if app has specified a csid then use that, else use default */ csid = (phs->csid) ? phs->csid : phs->csid_orig; /* if data is utf8 but charset isn't then switch to utf8 csid */ if (SvUTF8(phs->sv) && !CS_IS_UTF8(csid)) csid = utf8_csid; /* not al32utf8_csid here on purpose */ if (trace_level >= 3 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), "dbd_rebind_ph(): bind %s <== %s " "(%s, %s, csid %d->%d->%d, ftype %d (%s), csform %d(%s)->%d(%s), " "maxlen %lu, maxdata_size %lu)\n", phs->name, neatsvpv(phs->sv,10), (phs->is_inout) ? "inout" : "in", (SvUTF8(phs->sv) ? "is-utf8" : "not-utf8"), phs->csid_orig, phs->csid, csid, phs->ftype, sql_typecode_name(phs->ftype), phs->csform, oci_csform_name(phs->csform), csform, oci_csform_name(csform), (unsigned long)phs->maxlen, (unsigned long)phs->maxdata_size); if (csid) { OCIAttrSet_log_stat(imp_sth, phs->bndhp, (ub4) OCI_HTYPE_BIND, &csid, (ub4) 0, (ub4) OCI_ATTR_CHARSET_ID, imp_sth->errhp, status); if ( status != OCI_SUCCESS ) { oci_error(sth, imp_sth->errhp, status, ora_sql_error(imp_sth,"OCIAttrSet (OCI_ATTR_CHARSET_ID)")); return 0; } } if (phs->maxdata_size) { OCIAttrSet_log_stat(imp_sth, phs->bndhp, (ub4)OCI_HTYPE_BIND, neatsvpv(phs->sv,0), (ub4)phs->maxdata_size, (ub4)OCI_ATTR_MAXDATA_SIZE, imp_sth->errhp, status); if ( status != OCI_SUCCESS ) { oci_error(sth, imp_sth->errhp, status, ora_sql_error(imp_sth,"OCIAttrSet (OCI_ATTR_MAXDATA_SIZE)")); return 0; } } return 1; } int dbd_bind_ph(SV *sth, imp_sth_t *imp_sth, SV *ph_namesv, SV *newvalue, IV sql_type, SV *attribs, int is_inout, IV maxlen) { dTHX; SV **phs_svp; STRLEN name_len; char *name = Nullch; char namebuf[32]; phs_t *phs; /* check if placeholder was passed as a number */ if (SvGMAGICAL(ph_namesv)) /* eg tainted or overloaded */ mg_get(ph_namesv); if (!SvNIOKp(ph_namesv)) { STRLEN i; name = SvPV(ph_namesv, name_len); if (name_len > sizeof(namebuf)-1) croak("Placeholder name %s too long", neatsvpv(ph_namesv,0)); for (i=0; i SVt_PVAV) /* Array binding supported */ croak("Can't bind a non-scalar, non-array value (%s)", neatsvpv(newvalue,0)); if (SvTYPE(newvalue) == SVt_PVLV && is_inout) /* may allow later */ croak("Can't bind ``lvalue'' mode scalar as inout parameter (currently)"); if (DBIc_DBISTATE(imp_sth)->debug >= 2 || dbd_verbose >= 3 ) { PerlIO_printf( DBIc_LOGPIO(imp_sth), "dbd_bind_ph(1): bind %s <== %s (type %ld (%s)", name, neatsvpv(newvalue,0), (long)sql_type,sql_typecode_name(sql_type)); if (is_inout) PerlIO_printf(DBIc_LOGPIO(imp_sth), ", inout 0x%lx, maxlen %ld", (long)newvalue, (long)maxlen); if (attribs) PerlIO_printf(DBIc_LOGPIO(imp_sth), ", attribs: %s", neatsvpv(attribs,0)); PerlIO_printf(DBIc_LOGPIO(imp_sth), ")\n"); } phs_svp = hv_fetch(imp_sth->all_params_hv, name, name_len, 0); if (phs_svp == NULL) croak("Can't bind unknown placeholder '%s' (%s)", name, neatsvpv(ph_namesv,0)); /* This value is not a string, but a binary structure phs_st instead. */ phs = (phs_t*)(void*)SvPVX(*phs_svp); /* placeholder struct */ if (phs->sv == &PL_sv_undef) { /* first bind for this placeholder */ phs->is_inout = is_inout; if (is_inout) { /* phs->sv assigned in the code below */ ++imp_sth->has_inout_params; /* build array of phs's so we can deal with out vars fast */ if (!imp_sth->out_params_av) imp_sth->out_params_av = newAV(); av_push(imp_sth->out_params_av, SvREFCNT_inc(*phs_svp)); } /* * Init number of bound array entries to zero. * If "ora_maxarray_numentries" bind parameter specified, * it would be set below. * * If no ora_maxarray_numentries specified, let it be * the same as scalar(@array) bound (see dbd_rebind_ph_varchar2_table() ). */ phs->array_numstruct=0; if (attribs) { /* only look for ora_type on first bind of var */ SV **svp; /* Setup / Clear attributes as defined by attribs. */ /* XXX If attribs is EMPTY then reset attribs to default? */ if ( (svp=hv_fetch((HV*)SvRV(attribs), "ora_type",8, 0)) != NULL) { int ora_type = SvIV(*svp); if (!oratype_bind_ok(ora_type)) croak("Can't bind %s, ora_type %d not supported by DBD::Oracle", phs->name, ora_type); if (sql_type) croak("Can't specify both TYPE (%"IVdf") and ora_type (%d) for %s", sql_type, ora_type, phs->name); phs->ftype = ora_type; } if ( (svp=hv_fetch((HV*)SvRV(attribs), "ora_field",9, 0)) != NULL) { phs->ora_field = SvREFCNT_inc(*svp); } if ( (svp=hv_fetch((HV*)SvRV(attribs), "ora_csform", 10, 0)) != NULL) { if (SvIV(*svp) == SQLCS_IMPLICIT || SvIV(*svp) == SQLCS_NCHAR) phs->csform = (ub1)SvIV(*svp); else warn("ora_csform must be 1 (SQLCS_IMPLICIT) or 2 (SQLCS_NCHAR), not %"IVdf"", SvIV(*svp)); } if ( (svp=hv_fetch((HV*)SvRV(attribs), "ora_maxdata_size", 16, 0)) != NULL) { phs->maxdata_size = SvUV(*svp); } if ( (svp=hv_fetch((HV*)SvRV(attribs), "ora_maxarray_numentries", 23, 0)) != NULL) { phs->ora_maxarray_numentries=SvUV(*svp); } if ( (svp=hv_fetch((HV*)SvRV(attribs), "ora_internal_type", 17, 0)) != NULL) { phs->ora_internal_type=SvUV(*svp); } } if (sql_type) phs->ftype = ora_sql_type(imp_sth, phs->name, (int)sql_type); /* treat Oracle7 SQLT_CUR as SQLT_RSET for Oracle8 */ if (phs->ftype==102) phs->ftype = ORA_RSET; /* some types require the trailing null included in the length. */ /* SQLT_STR=5=STRING, SQLT_AVC=97=VARCHAR */ phs->alen_incnull = (phs->ftype==SQLT_STR || phs->ftype==SQLT_AVC); } /* was first bind for this placeholder */ /* check later rebinds for any changes */ else if (is_inout != phs->is_inout) { croak("Can't rebind or change param %s in/out mode after first bind (%d => %d)", phs->name, phs->is_inout , is_inout); } else if (sql_type && phs->ftype != ora_sql_type(imp_sth, phs->name, (int)sql_type)) { croak("Can't change TYPE of param %s to %"IVdf" after initial bind", phs->name, sql_type); } /* Array binding is supported for a limited number of data types. */ if( SvROK(newvalue) ){ if( SvTYPE(SvRV(newvalue))==SVt_PVAV ){ if( (phs->ftype == ORA_VARCHAR2_TABLE) || (phs->ftype == ORA_NUMBER_TABLE) || (phs->ftype == 1)) /*ORA_VARCHAR2*/ { /* Supported */ /* Reload array-size-related attributes */ if (attribs) { SV **svp; if ( (svp=hv_fetch((HV*)SvRV(attribs), "ora_maxdata_size", 16, 0)) != NULL) { phs->maxdata_size = SvUV(*svp); } if ( (svp=hv_fetch((HV*)SvRV(attribs), "ora_maxarray_numentries", 23, 0)) != NULL) { phs->ora_maxarray_numentries=SvUV(*svp); } if ( (svp=hv_fetch((HV*)SvRV(attribs), "ora_internal_type", 17, 0)) != NULL) { phs->ora_internal_type=SvUV(*svp); } } } else{ /* All the other types are not supported */ croak("Array bind is supported only for ORA_%%_TABLE types. Unable to bind '%s'.",phs->name); } } } /* Add checks for other reference types here ? */ phs->maxlen = maxlen; /* 0 if not inout */ if (!is_inout) { /* normal bind so take a (new) copy of current value */ if (phs->sv == &PL_sv_undef) /* (first time bind) */ phs->sv = newSV(0); sv_setsv(phs->sv, newvalue); if (SvAMAGIC(phs->sv)) /* overloaded. XXX hack, logic ought to be pushed deeper */ sv_pvn_force(phs->sv, &PL_na); } else { if (newvalue != phs->sv) { if (phs->sv) SvREFCNT_dec(phs->sv); phs->sv = SvREFCNT_inc(newvalue); /* point to live var */ } /* Add space for NUL - do it now rather than in rebind as it cause problems in rebind where maxlen continually grows. */ phs->maxlen = phs->maxlen + 1; } return dbd_rebind_ph(sth, imp_sth, phs); } /* --- functions to 'complete' the fetch of a value --- */ void dbd_phs_sv_complete(imp_sth_t *imp_sth, phs_t *phs, SV *sv, I32 debug) { dTHX; char *note = ""; /* XXX doesn't check arcode for error, caller is expected to */ if (phs->indp == 0) { /* is okay */ if (phs->is_inout && phs->alen == SvLEN(sv)) { /* if the placeholder has not been assigned to then phs->alen */ /* is left untouched: still set to SvLEN(sv). If we use that */ /* then we'll get garbage bytes beyond the original contents. */ phs->alen = SvCUR(sv); note = " UNTOUCHED?"; } if (SvPVX(sv)) { SvCUR_set(sv, phs->alen); *SvEND(sv) = '\0'; SvPOK_only_UTF8(sv); if (CSFORM_IMPLIES_UTF8(SQLCS_IMPLICIT)) { #ifdef sv_utf8_decode sv_utf8_decode(sv); #else SvUTF8_on(sv); #endif } } else { /* shouldn't happen */ debug = 2; dbd_verbose =3; note = " [placeholder has no data buffer]"; } if (debug >= 2 || dbd_verbose >= 3 ) PerlIO_printf(DBILOGFP, " out %s = %s (arcode %d, ind %d, len %d)%s\n", phs->name, neatsvpv(sv,0), phs->arcode, phs->indp, phs->alen, note); } else { if (phs->indp > 0 || phs->indp == -2) { /* truncated */ if (SvPVX(sv)) { SvCUR_set(sv, phs->alen); *SvEND(sv) = '\0'; SvPOK_only_UTF8(sv); if (CSFORM_IMPLIES_UTF8(SQLCS_IMPLICIT)) { #ifdef sv_utf8_decode sv_utf8_decode(sv); #else SvUTF8_on(sv); #endif } } else { /* shouldn't happen */ debug = 2; dbd_verbose =3; note = " [placeholder has no data buffer]"; } if (debug >= 2 || dbd_verbose >= 3 ) PerlIO_printf(DBILOGFP, " out %s = %s\t(TRUNCATED from %d to %ld, arcode %d)%s\n", phs->name, neatsvpv(sv,0), phs->indp, (long)phs->alen, phs->arcode, note); } else { if (phs->indp == -1) { /* is NULL */ (void)SvOK_off(phs->sv); if (debug >= 2 || dbd_verbose >= 3 ) PerlIO_printf(DBILOGFP, " out %s = undef (NULL, arcode %d)\n", phs->name, phs->arcode); } else { croak("panic dbd_phs_sv_complete: %s bad indp %d, arcode %d", phs->name, phs->indp, phs->arcode); } } } } void dbd_phs_avsv_complete(imp_sth_t *imp_sth, phs_t *phs, I32 index, I32 debug) { dTHX; AV *av = (AV*)SvRV(phs->sv); SV *sv = *av_fetch(av, index, 1); dbd_phs_sv_complete(imp_sth, phs, sv, 0); if (debug >= 2 || dbd_verbose >= 3 ) PerlIO_printf(DBIc_LOGPIO(imp_sth), " dbd_phs_avsv_complete out '%s'[%ld] = %s (arcode %d, ind %d, len %d)\n", phs->name, (long)index, neatsvpv(sv,0), phs->arcode, phs->indp, phs->alen); } /* --- */ int dbd_st_execute(SV *sth, imp_sth_t *imp_sth) /* <= -2:error, >=0:ok row count, (-1=unknown count) */ { dTHR; dTHX; ub4 row_count = 0; int debug = DBIc_DBISTATE(imp_sth)->debug; int outparams = (imp_sth->out_params_av) ? AvFILL(imp_sth->out_params_av)+1 : 0; D_imp_dbh_from_sth; sword status; int is_select = (imp_sth->stmt_type == OCI_STMT_SELECT); if (debug >= 2 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " dbd_st_execute %s (out%d, lob%d)...\n", oci_stmt_type_name(imp_sth->stmt_type), outparams, imp_sth->has_lobs); /* Don't attempt execute for nested cursor. It would be meaningless, and Oracle code has been seen to core dump */ if (imp_sth->nested_cursor) { oci_error(sth, NULL, OCI_ERROR, "explicit execute forbidden for nested cursor"); return -2; } if (outparams) { /* check validity of bind_param_inout SV's */ int i = outparams; while(--i >= 0) { phs_t *phs = (phs_t*)(void*)SvPVX(AvARRAY(imp_sth->out_params_av)[i]); SV *sv = phs->sv; /* Make sure we have the value in string format. Typically a number */ /* will be converted back into a string using the same bound buffer */ /* so the progv test below will not trip. */ /* is the value a null? */ phs->indp = (SvOK(sv)) ? 0 : -1; if (phs->out_prepost_exec) { if (!phs->out_prepost_exec(sth, imp_sth, phs, 1)) return -2; /* out_prepost_exec already called ora_error() */ } else if (SvTYPE(sv) == SVt_RV && SvTYPE(SvRV(sv)) == SVt_PVAV) { if (debug >= 2 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " with %s = [] (len %ld/%ld, indp %d, otype %d, ptype %d)\n", phs->name, (long)phs->alen, (long)phs->maxlen, phs->indp, phs->ftype, (int)SvTYPE(sv)); av_clear((AV*)SvRV(sv)); } else /* Some checks for mutated storage since we pointed oracle at it. */ if (SvTYPE(sv) != phs->sv_type || (SvOK(sv) && !SvPOK(sv)) /* SvROK==!SvPOK so cursor (SQLT_CUR) handle will call dbd_rebind_ph */ /* that suits us for now */ || SvPVX(sv) != phs->progv || (SvPOK(sv) && SvCUR(sv) > UB2MAXVAL) ) { if (!dbd_rebind_ph(sth, imp_sth, phs)) croak("Can't rebind placeholder %s", phs->name); } else { /* String may have grown or shrunk since it was bound */ /* so tell Oracle about it's current length */ ub2 prev_alen = phs->alen; phs->alen = (SvOK(sv)) ? SvCUR(sv) + phs->alen_incnull : 0+phs->alen_incnull; if (debug >= 2 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " with %s = '%.*s' (len %ld(%ld)/%ld, indp %d, " "otype %d, ptype %d)\n", phs->name, (int)phs->alen, (phs->indp == -1) ? "" : SvPVX(sv), (long)phs->alen, (long)prev_alen, (long)phs->maxlen, phs->indp, phs->ftype, (int)SvTYPE(sv)); } } } if (DBIc_has(imp_dbh,DBIcf_AutoCommit) && !is_select) { imp_sth->exe_mode=OCI_COMMIT_ON_SUCCESS; /* we don't AutoCommit on select so LOB locators work */ } else if(imp_sth->exe_mode!=OCI_STMT_SCROLLABLE_READONLY){ imp_sth->exe_mode=OCI_DEFAULT; } if (debug >= 2 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), "Statement Execute Mode is %d (%s)\n", imp_sth->exe_mode,oci_exe_mode(imp_sth->exe_mode)); OCIStmtExecute_log_stat(imp_sth, imp_sth->svchp, imp_sth->stmhp, imp_sth->errhp, (ub4)(is_select ? 0: 1), 0, 0, 0,(ub4)imp_sth->exe_mode,status); if (status != OCI_SUCCESS) { /* may be OCI_ERROR or OCI_SUCCESS_WITH_INFO etc */ /* we record the error even for OCI_SUCCESS_WITH_INFO */ oci_error(sth, imp_sth->errhp, status, ora_sql_error(imp_sth,"OCIStmtExecute")); /* but only bail out here if not OCI_SUCCESS_WITH_INFO */ if (status != OCI_SUCCESS_WITH_INFO) return -2; } if (is_select) { DBIc_ACTIVE_on(imp_sth); DBIc_ROW_COUNT(imp_sth) = 0; /* reset (possibly re-exec'ing) */ row_count = 0; /*reinit the rs_array as well as we may have more thatn one exe on a prepare*/ rs_array_init(imp_sth); } else { OCIAttrGet_stmhp_stat(imp_sth, &row_count, 0, OCI_ATTR_ROW_COUNT, status); } if (debug >= 2 || dbd_verbose >= 3 ) { ub2 sqlfncode; OCIAttrGet_stmhp_stat(imp_sth, &sqlfncode, 0, OCI_ATTR_SQLFNCODE, status); PerlIO_printf( DBIc_LOGPIO(imp_sth), " dbd_st_execute %s returned (%s, rpc%ld, fn%d, out%d)\n", oci_stmt_type_name(imp_sth->stmt_type), oci_status_name(status), (long)row_count, sqlfncode, imp_sth->has_inout_params); } if (is_select && !imp_sth->done_desc) { /* describe and allocate storage for results (if any needed) */ if (!dbd_describe(sth, imp_sth)) return -2; /* dbd_describe already called oci_error() */ } if (imp_sth->has_lobs && imp_sth->stmt_type != OCI_STMT_SELECT) { if (!post_execute_lobs(sth, imp_sth, row_count)) return -2; /* post_insert_lobs already called oci_error() */ } if (outparams) { /* check validity of bound output SV's */ int i = outparams; while(--i >= 0) { /* phs->alen has been updated by Oracle to hold the length of the result */ phs_t *phs = (phs_t*)(void*)SvPVX(AvARRAY(imp_sth->out_params_av)[i]); SV *sv = phs->sv; if (debug >= 2 || dbd_verbose >= 3 ) { PerlIO_printf( DBIc_LOGPIO(imp_sth), "dbd_st_execute(): Analyzing inout a parameter '%s" " of type=%d name=%s'\n", phs->name,phs->ftype,sql_typecode_name(phs->ftype)); } if( phs->ftype == ORA_VARCHAR2_TABLE ){ dbd_phs_varchar_table_posy_exe(imp_sth, phs); continue; } if( phs->ftype == ORA_NUMBER_TABLE ){ dbd_phs_number_table_post_exe(imp_sth, phs); continue; } if (phs->out_prepost_exec) { if (!phs->out_prepost_exec(sth, imp_sth, phs, 0)) return -2; /* out_prepost_exec already called ora_error() */ } else { if (SvTYPE(sv) == SVt_RV && SvTYPE(SvRV(sv)) == SVt_PVAV) { AV *av = (AV*)SvRV(sv); I32 avlen = AvFILL(av); if (avlen >= 0) dbd_phs_avsv_complete(imp_sth, phs, avlen, debug); } else { dbd_phs_sv_complete(imp_sth, phs, sv, debug); } } } } return row_count; /* row count (0 will be returned as "0E0") */ } static int do_bind_array_exec(sth, imp_sth, phs,utf8,parma_index,tuples_utf8_av,tuples_status_av) SV *sth; imp_sth_t *imp_sth; phs_t *phs; int utf8; AV *tuples_utf8_av,*tuples_status_av; int parma_index; { dTHX; sword status; ub1 csform; ub2 csid; int trace_level = DBIc_DBISTATE(imp_sth)->debug; int i; OCIBindByName_log_stat(imp_sth, imp_sth->stmhp, &phs->bndhp, imp_sth->errhp, (text*)phs->name, (sb4)strlen(phs->name), 0, phs->maxlen ? (sb4)phs->maxlen : 1, /* else bind "" fails */ (ub2)phs->ftype, 0, NULL, /* ub2 *alen_ptr not needed with OCIBindDynamic */ 0, 0, /* max elements that can fit in allocated array */ NULL, /* (ptr to) current number of elements in array */ (ub4)OCI_DATA_AT_EXEC, status); if (status != OCI_SUCCESS) { oci_error(sth, imp_sth->errhp, status, "OCIBindByName"); return 0; } OCIBindDynamic_log(imp_sth, phs->bndhp, imp_sth->errhp, (dvoid *)phs, dbd_phs_in, (dvoid *)phs, dbd_phs_out, status); if (status != OCI_SUCCESS) { oci_error(sth, imp_sth->errhp, status, "OCIBindDynamic"); return 0; } /* copied and adapted from dbd_rebind_ph */ csform = phs->csform; if (!csform && (utf8 & ARRAY_BIND_UTF8)) { /* try to default csform to avoid translation through non-unicode */ if (CSFORM_IMPLIES_UTF8(SQLCS_IMPLICIT)) /* prefer IMPLICIT */ csform = SQLCS_IMPLICIT; else if (CSFORM_IMPLIES_UTF8(SQLCS_NCHAR)) csform = SQLCS_NCHAR; /* else leave csform == 0 */ if (trace_level || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), "do_bind_array_exec() (2): rebinding %s with UTF8 value %s", phs->name, (csform == SQLCS_IMPLICIT) ? "so setting csform=SQLCS_IMPLICIT" : (csform == SQLCS_NCHAR) ? "so setting csform=SQLCS_NCHAR" : "but neither CHAR nor NCHAR are unicode\n"); } if (csform) { /* set OCI_ATTR_CHARSET_FORM before we get the default OCI_ATTR_CHARSET_ID */ OCIAttrSet_log_stat(imp_sth, phs->bndhp, (ub4) OCI_HTYPE_BIND, &csform, (ub4) 0, (ub4) OCI_ATTR_CHARSET_FORM, imp_sth->errhp, status); if ( status != OCI_SUCCESS ) { oci_error(sth, imp_sth->errhp, status, ora_sql_error(imp_sth,"OCIAttrSet (OCI_ATTR_CHARSET_FORM)")); return 0; } } if (!phs->csid_orig) { /* get the default csid Oracle would use */ OCIAttrGet_log_stat(imp_sth, phs->bndhp, OCI_HTYPE_BIND, &phs->csid_orig, (ub4)0 , OCI_ATTR_CHARSET_ID, imp_sth->errhp, status); } /* if app has specified a csid then use that, else use default */ csid = (phs->csid) ? phs->csid : phs->csid_orig; /* if data is utf8 but charset isn't then switch to utf8 csid if possible */ if ((utf8 & ARRAY_BIND_UTF8) && !CS_IS_UTF8(csid)) { /* if the specified or default csid is not utf8 _compatible_ AND we have * mixed utf8 and native (non-utf8) data, then it's a fatal problem * utf8 _compatible_ means, can be upgraded to utf8, ie. utf8 or ascii */ if ((utf8 & ARRAY_BIND_NATIVE) && CS_IS_NOT_UTF8_COMPATIBLE(csid)) { oratext charsetname[OCI_NLS_MAXBUFSZ]; OCINlsCharSetIdToName(imp_sth->envhp,charsetname, sizeof(charsetname),csid ); for(i=0;i= 3 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), "do_bind_array_exec(): bind %s <== [array of values] " "(%s, %s, csid %d->%d->%d, ftype %d (%s), csform %d (%s)->%d (%s)" ", maxlen %lu, maxdata_size %lu)\n", phs->name, (phs->is_inout) ? "inout" : "in", (utf8 ? "is-utf8" : "not-utf8"), phs->csid_orig, phs->csid, csid, phs->ftype, sql_typecode_name(phs->ftype), phs->csform,oci_csform_name(phs->csform), csform,oci_csform_name(csform), (unsigned long)phs->maxlen, (unsigned long)phs->maxdata_size); if (csid) { OCIAttrSet_log_stat(imp_sth, phs->bndhp, (ub4) OCI_HTYPE_BIND, &csid, (ub4) 0, (ub4) OCI_ATTR_CHARSET_ID, imp_sth->errhp, status); if ( status != OCI_SUCCESS ) { oci_error(sth, imp_sth->errhp, status, ora_sql_error(imp_sth,"OCIAttrSet (OCI_ATTR_CHARSET_ID)")); return 0; } } return 1; } static void init_bind_for_array_exec(phs) phs_t *phs; { dTHX; if (phs->sv == &PL_sv_undef) { /* first bind for this placeholder */ phs->is_inout = 0; phs->maxlen = 1; /* treat Oracle7 SQLT_CUR as SQLT_RSET for Oracle8 */ if (phs->ftype==102) phs->ftype = ORA_RSET; /* some types require the trailing null included in the length. */ /* SQLT_STR=5=STRING, SQLT_AVC=97=VARCHAR */ phs->alen_incnull = (phs->ftype==SQLT_STR || phs->ftype==SQLT_AVC); } } int ora_st_execute_array(sth, imp_sth, tuples, tuples_status, columns, exe_count, err_count) SV *sth; imp_sth_t *imp_sth; SV *tuples; SV *tuples_status; SV *columns; ub4 exe_count; SV *err_count; { dTHX; dTHR; ub4 row_count = 0; int debug = DBIc_DBISTATE(imp_sth)->debug; D_imp_dbh_from_sth; sword status, exe_status; int is_select = (imp_sth->stmt_type == OCI_STMT_SELECT); AV *tuples_av, *tuples_status_av, *columns_av,*tuples_utf8_av; ub4 oci_mode; ub4 num_errs; int i,j; int autocommit = DBIc_has(imp_dbh,DBIcf_AutoCommit); SV **sv_p; phs_t **phs; SV *sv; AV *av; int param_count; char namebuf[30]; STRLEN len; int outparams = (imp_sth->out_params_av) ? AvFILL(imp_sth->out_params_av)+1 : 0; int *utf8_flgs; tuples_utf8_av = newAV(); sv_2mortal((SV*)tuples_utf8_av); if (debug >= 2 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " ora_st_execute_array %s count=%d (%s %s %s)...\n", oci_stmt_type_name(imp_sth->stmt_type), exe_count, neatsvpv(tuples,0), neatsvpv(tuples_status,0), neatsvpv(columns, 0)); if (is_select) { croak("ora_st_execute_array(): SELECT statement not supported " "for array operation."); } if (imp_sth->has_lobs) { croak("ora_st_execute_array(): LOBs not " "supported for array operation."); } /* Check that the `tuples' parameter is an array ref, find the length, and store it in the statement handle for the OCI callback. */ if(!SvROK(tuples) || SvTYPE(SvRV(tuples)) != SVt_PVAV) { croak("ora_st_execute_array(): Not an array reference."); } tuples_av = (AV*)SvRV(tuples); /* Check the `columns' parameter. */ if(SvTRUE(columns)) { if(!SvROK(columns) || SvTYPE(SvRV(columns)) != SVt_PVAV) { croak("ora_st_execute_array(): columns not an array peference."); } columns_av = (AV*)SvRV(columns); } else { columns_av = NULL; } /* Check the `tuples_status' parameter. */ if(SvTRUE(tuples_status)) { if(!SvROK(tuples_status) || SvTYPE(SvRV(tuples_status)) != SVt_PVAV) { croak("ora_st_execute_array(): tuples_status not an array reference."); } tuples_status_av = (AV*)SvRV(tuples_status); av_fill(tuples_status_av, exe_count - 1); } else { tuples_status_av = NULL; } /* Nothing to do if no tuples. */ if(exe_count <= 0) return 0; /* Ensure proper OCIBindByName() calls for all placeholders. if(!ora_st_bind_for_array_exec(sth, imp_sth, tuples_av, exe_count, DBIc_NUM_PARAMS(imp_sth), columns_av)) return -2; fix for Perl undefined warning. Moved out of function back out to main code Still ensures proper OCIBindByName*/ param_count=DBIc_NUM_PARAMS(imp_sth); Newz(0,phs,param_count*sizeof(*phs),phs_t *); Newz(0,utf8_flgs,param_count*sizeof(int),int); for(j = 0; (unsigned int) j < exe_count; j++) { /* Fill in 'unknown' exe count in every element (know not how to get individual execute row counts from OCI). Moved it here as there is no need to iterate twice over it this should speed it up somewhat for large binds*/ if (SvTRUE(tuples_status)){ av_store(tuples_status_av, j, newSViv((IV)-1)); } sv_p = av_fetch(tuples_av, j, 0); if(sv_p == NULL) { Safefree(phs); Safefree(utf8_flgs); croak("Cannot fetch tuple %d", j); } sv = *sv_p; if(!SvROK(sv) || SvTYPE(SvRV(sv)) != SVt_PVAV) { Safefree(phs); Safefree(utf8_flgs); croak("Not an array ref in element %d", j); } av = (AV*)SvRV(sv); for(i = 0; i < param_count; i++) { if(!phs[i]) { SV **phs_svp; sprintf(namebuf, ":p%d", i+1); phs_svp = hv_fetch(imp_sth->all_params_hv, namebuf, strlen(namebuf), 0); if (phs_svp == NULL) { Safefree(utf8_flgs); Safefree(phs); croak("Can't execute for non-existent placeholder :%d", i); } phs[i] = (phs_t*)(void*)SvPVX(*phs_svp); /* placeholder struct */ if(phs[i]->idx < 0) { Safefree(phs); croak("Placeholder %d not of ?/:1 type", i); } init_bind_for_array_exec(phs[i]); } sv_p = av_fetch(av, phs[i]->idx, 0); if(sv_p == NULL) { Safefree(utf8_flgs); Safefree(phs); croak("Cannot fetch value for param %d in entry %d", i, j); } sv = *sv_p; /*check to see if value sv is a null (undef) if it is upgrade it*/ if (!SvOK(sv)) { (void)SvUPGRADE(sv, SVt_PV); } else { SvPV(sv, len); } /* Find the value length, and increase maxlen if needed. */ if(SvROK(sv)) { Safefree(phs); Safefree(utf8_flgs); croak("Can't bind a reference (%s) for param %d, entry %d", neatsvpv(sv,0), i, j); } if(len > (unsigned int) phs[i]->maxlen) phs[i]->maxlen = len; /* update the utf8_flgs for this value */ if (SvUTF8(sv)) { utf8_flgs[i] |= ARRAY_BIND_UTF8; if (SvTRUE(tuples_status)){ av_push(tuples_utf8_av,newSViv(j)); } } else { utf8_flgs[i] |= ARRAY_BIND_NATIVE; } /* Do OCI bind calls on last iteration. */ if( ((unsigned int) j ) == exe_count - 1 ) { do_bind_array_exec(sth, imp_sth, phs[i], utf8_flgs[i],i,tuples_utf8_av,tuples_status_av); } } } /* Store array of bind typles, for use in OCIBindDynamic() callback. */ imp_sth->bind_tuples = tuples_av; imp_sth->rowwise = (columns_av == NULL); oci_mode = OCI_BATCH_ERRORS; if(autocommit) oci_mode |= OCI_COMMIT_ON_SUCCESS; OCIStmtExecute_log_stat(imp_sth, imp_sth->svchp, imp_sth->stmhp, imp_sth->errhp, exe_count, 0, 0, 0, oci_mode, exe_status); OCIAttrGet_stmhp_stat(imp_sth, &row_count, 0, OCI_ATTR_ROW_COUNT, status); imp_sth->bind_tuples = NULL; if (exe_status != OCI_SUCCESS) { oci_error(sth, imp_sth->errhp, exe_status, ora_sql_error(imp_sth,"OCIStmtExecute")); if(exe_status != OCI_SUCCESS_WITH_INFO) return -2; } if (outparams){ i=outparams; while(--i >= 0) { phs_t *phs = (phs_t*)(void*)SvPVX(AvARRAY(imp_sth->out_params_av)[i]); SV *sv = phs->sv; if (SvTYPE(sv) == SVt_RV && SvTYPE(SvRV(sv)) == SVt_PVAV) { AV *av = (AV*)SvRV(sv); I32 avlen = AvFILL(av); for (j=0;j<=avlen;j++){ dbd_phs_avsv_complete(imp_sth, phs, j, debug); } } } } OCIAttrGet_stmhp_stat(imp_sth, &num_errs, 0, OCI_ATTR_NUM_DML_ERRORS, status); if (debug >= 6 || dbd_verbose >= 6 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " ora_st_execute_array %d errors in batch.\n", num_errs); if (num_errs) { sv_setiv(err_count,num_errs); } if(num_errs && tuples_status_av) { OCIError *row_errhp, *tmp_errhp; ub4 row_off; SV *err_svs[3]; /*AV *err_av;*/ sb4 err_code; err_svs[0] = newSViv((IV)0); err_svs[1] = newSVpvn("", 0); err_svs[2] = newSVpvn("S1000",5); OCIHandleAlloc_ok(imp_sth, imp_sth->envhp, &row_errhp, OCI_HTYPE_ERROR, status); OCIHandleAlloc_ok(imp_sth, imp_sth->envhp, &tmp_errhp, OCI_HTYPE_ERROR, status); for(i = 0; (unsigned int) i < num_errs; i++) { OCIParamGet_log_stat(imp_sth, imp_sth->errhp, OCI_HTYPE_ERROR, tmp_errhp, (dvoid *)&row_errhp, (ub4)i, status); OCIAttrGet_log_stat(imp_sth, row_errhp, OCI_HTYPE_ERROR, &row_off, 0, OCI_ATTR_DML_ROW_OFFSET, imp_sth->errhp, status); if (debug >= 6 || dbd_verbose >= 6 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " ora_st_execute_array error in row %d.\n", row_off); sv_setpv(err_svs[1], ""); err_code = oci_error_get((imp_xxh_t *)imp_sth, row_errhp, exe_status, NULL, err_svs[1], debug); sv_setiv(err_svs[0], (IV)err_code); av_store(tuples_status_av, row_off, newRV_noinc((SV *)(av_make(3, err_svs)))); } OCIHandleFree_log_stat(imp_sth, tmp_errhp, OCI_HTYPE_ERROR, status); OCIHandleFree_log_stat(imp_sth, row_errhp, OCI_HTYPE_ERROR, status); /* Do a commit here if autocommit is set, since Oracle doesn't do that for us when some rows are in error. */ if(autocommit) { OCITransCommit_log_stat(imp_sth, imp_sth->svchp, imp_sth->errhp, OCI_DEFAULT, status); if (status != OCI_SUCCESS) { oci_error(sth, imp_sth->errhp, status, "OCITransCommit"); return -2; } } } if(num_errs) { return -2; } else { return row_count; } } int dbd_st_blob_read(SV *sth, imp_sth_t *imp_sth, int field, long offset, long len, SV *destrv, long destoffset) { dTHX; ub4 retl = 0; SV *bufsv; imp_fbh_t *fbh = &imp_sth->fbh[field]; int ftype = fbh->ftype; bufsv = SvRV(destrv); sv_setpvn(bufsv,"",0); /* ensure it's writable string */ #ifdef UTF8_SUPPORT if (ftype == 112 && CS_IS_UTF8(ncharsetid) ) { return ora_blob_read_mb_piece(sth, imp_sth, fbh, bufsv, offset, len, destoffset); } #endif /* UTF8_SUPPORT */ SvGROW(bufsv, (STRLEN)destoffset+len+1); /* SvGROW doesn't do +1 */ retl = ora_blob_read_piece(sth, imp_sth, fbh, bufsv, offset, len, destoffset); if (!SvOK(bufsv)) { /* ora_blob_read_piece recorded error */ ora_free_templob(sth, imp_sth, (OCILobLocator*)fbh->desc_h); return 0; } ftype = ftype; /* no unused */ if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) PerlIO_printf( DBIc_LOGPIO(imp_sth), " blob_read field %d+1, ftype %d, offset %ld, len %ld, " "destoffset %ld, retlen %ld\n", field, imp_sth->fbh[field].ftype, offset, len, destoffset, (long)retl); SvCUR_set(bufsv, destoffset+retl); *SvEND(bufsv) = '\0'; /* consistent with perl sv_setpvn etc */ return 1; } int dbd_st_rows(SV *sth, imp_sth_t *imp_sth) { dTHX; ub4 row_count = 0; sword status; OCIAttrGet_stmhp_stat(imp_sth, &row_count, 0, OCI_ATTR_ROW_COUNT, status); if (status != OCI_SUCCESS) { oci_error(sth, imp_sth->errhp, status, "OCIAttrGet OCI_ATTR_ROW_COUNT"); return -1; } return row_count; } int dbd_st_finish(SV *sth, imp_sth_t *imp_sth) { dTHR; dTHX; D_imp_dbh_from_sth; sword status; int num_fields = DBIc_NUM_FIELDS(imp_sth); int i; if (DBIc_DBISTATE(imp_sth)->debug >= 6 || dbd_verbose >= 6 ) PerlIO_printf(DBIc_LOGPIO(imp_sth), " dbd_st_finish\n"); if (!DBIc_ACTIVE(imp_sth)) return 1; /* Cancel further fetches from this cursor. */ /* We don't close the cursor till DESTROY (dbd_st_destroy). */ /* The application may re execute(...) it. */ /* Turn off ACTIVE here regardless of errors below. */ DBIc_ACTIVE_off(imp_sth); for(i=0; i < num_fields; ++i) { imp_fbh_t *fbh = &imp_sth->fbh[i]; if (fbh->fetch_cleanup) fbh->fetch_cleanup(sth, fbh); } if (PL_dirty) /* don't walk on the wild side */ return 1; if (!DBIc_ACTIVE(imp_dbh)) /* no longer connected */ return 1; /*fetching on a cursor with row =0 will explicitly free any server side resources this is what the next statment does, not sure if we need this for non scrolling cursors they should die on a OER(1403) no records)*/ OCIStmtFetch_log_stat(imp_sth, imp_sth->stmhp, imp_sth->errhp, 0, OCI_FETCH_NEXT,0, status); if (status != OCI_SUCCESS && status != OCI_SUCCESS_WITH_INFO) { oci_error(sth, imp_sth->errhp, status, "Finish OCIStmtFetch"); return 0; } return 1; } void ora_free_fbh_contents(SV *sth, imp_fbh_t *fbh) { dTHX; D_imp_sth(sth); D_imp_dbh_from_sth; if (fbh->fb_ary) fb_ary_free(fbh->fb_ary); sv_free(fbh->name_sv); /* see rt 75163 */ if (fbh->desc_h) { boolean is_open; sword status; OCILobFileIsOpen_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, fbh->desc_h, &is_open, status); if (status == OCI_SUCCESS && is_open) { OCILobFileClose_log_stat(imp_sth, imp_sth->svchp, imp_sth->errhp, fbh->desc_h, status); } OCIDescriptorFree_log(imp_sth, fbh->desc_h, fbh->desc_t); } if (fbh->obj) { if (fbh->obj->obj_value) OCIObjectFree(fbh->imp_sth->envhp, fbh->imp_sth->errhp, fbh->obj->obj_value, (ub2)0); Safefree(fbh->obj); } } void ora_free_phs_contents(imp_sth_t *imp_sth, phs_t *phs) { dTHX; if (phs->desc_h) OCIDescriptorFree_log(imp_sth, phs->desc_h, phs->desc_t); if( phs->array_buf ){ free(phs->array_buf); phs->array_buf=NULL; } if( phs->array_indicators ){ free(phs->array_indicators); phs->array_indicators=NULL; } if( phs->array_lengths ){ free(phs->array_lengths); phs->array_lengths=NULL; } phs->array_buflen=0; phs->array_numallocated=0; sv_free(phs->ora_field); sv_free(phs->sv); } void ora_free_templob(SV *sth, imp_sth_t *imp_sth, OCILobLocator *lobloc) { dTHX; #if defined(OCI_HTYPE_DIRPATH_FN_CTX) /* >= 9.0 */ boolean is_temporary = 0; sword status; OCILobIsTemporary_log_stat(imp_sth, imp_sth->envhp, imp_sth->errhp, lobloc, &is_temporary, status); if (status != OCI_SUCCESS) { oci_error(sth, imp_sth->errhp, status, "OCILobIsTemporary"); return; } if (is_temporary) { if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) { PerlIO_printf( DBIc_LOGPIO(imp_sth), " OCILobFreeTemporary %s\n", oci_status_name(status)); } OCILobFreeTemporary_log_stat(imp_sth, imp_sth->svchp, imp_sth->errhp, lobloc, status); if (status != OCI_SUCCESS) { oci_error(sth, imp_sth->errhp, status, "OCILobFreeTemporary"); return; } } #endif } void dbd_st_destroy(SV *sth, imp_sth_t *imp_sth) { int fields; int i; sword status; dTHX ; /* Don't free the OCI statement handle for a nested cursor. It will be reused by Oracle on the next fetch. Indeed, we never free these handles. Experiment shows that Oracle frees them when they are no longer needed. */ /* get rid of describe handle if used*/ /* if we are using a scrolling cursor we should get rid of the cursor by fetching row 0 */ if (imp_sth->exe_mode==OCI_STMT_SCROLLABLE_READONLY){ OCIStmtFetch_log_stat(imp_sth, imp_sth->stmhp, imp_sth->errhp, 0,OCI_FETCH_NEXT,0, status); } if (imp_sth->dschp){ OCIHandleFree_log_stat(imp_sth, imp_sth->dschp, OCI_HTYPE_DESCRIBE, status); } if (DBIc_DBISTATE(imp_sth)->debug >= 6 || dbd_verbose >= 6 ) PerlIO_printf(DBIc_LOGPIO(imp_sth), " dbd_st_destroy %s\n", (PL_dirty) ? "(OCIHandleFree skipped during global destruction)" : (imp_sth->nested_cursor) ?"(OCIHandleFree skipped for nested cursor)" : ""); if (!PL_dirty) { /* XXX not ideal, leak may be a problem in some cases */ if (!imp_sth->nested_cursor) { OCIHandleFree_log_stat(imp_sth, imp_sth->stmhp, OCI_HTYPE_STMT, status); if (status != OCI_SUCCESS) oci_error(sth, imp_sth->errhp, status, "OCIHandleFree"); } } /* Free off contents of imp_sth */ if (imp_sth->lob_refetch) ora_free_lob_refetch(sth, imp_sth); fields = DBIc_NUM_FIELDS(imp_sth); imp_sth->in_cache = 0; imp_sth->eod_errno = 1403; for(i=0; i < fields; ++i) { imp_fbh_t *fbh = &imp_sth->fbh[i]; ora_free_fbh_contents(sth, fbh); } Safefree(imp_sth->fbh); if (imp_sth->fbh_cbuf) Safefree(imp_sth->fbh_cbuf); Safefree(imp_sth->statement); if (imp_sth->out_params_av) sv_free((SV*)imp_sth->out_params_av); if (imp_sth->all_params_hv) { HV *hv = imp_sth->all_params_hv; SV *sv; char *key; I32 retlen; hv_iterinit(hv); while( (sv = hv_iternextsv(hv, &key, &retlen)) != NULL ) { if (sv != &PL_sv_undef) { phs_t *phs = (phs_t*)(void*)SvPVX(sv); if (phs->desc_h && phs->desc_t == OCI_DTYPE_LOB) ora_free_templob(sth, imp_sth, (OCILobLocator*)phs->desc_h); ora_free_phs_contents(imp_sth, phs); } } sv_free((SV*)imp_sth->all_params_hv); } DBIc_IMPSET_off(imp_sth); /* let DBI know we've done it */ } int dbd_st_STORE_attrib(SV *sth, imp_sth_t *imp_sth, SV *keysv, SV *valuesv) { dTHX; STRLEN kl; SV *cachesv = NULL; char *key = SvPV(keysv,kl); if( imp_sth ) { /* For GCC not to warn on unused argument */} /* int on = SvTRUE(valuesv); int oraperl = DBIc_COMPAT(imp_sth); */ if (strEQ(key, "ora_fetchtest")) { ora_fetchtest = SvIV(valuesv); } else return FALSE; if (cachesv) /* cache value for later DBI 'quick' fetch? */ (void)hv_store((HV*)SvRV(sth), key, kl, cachesv, 0); return TRUE; } SV * dbd_st_FETCH_attrib(SV *sth, imp_sth_t *imp_sth, SV *keysv) { dTHX; STRLEN kl; char *key = SvPV(keysv,kl); int i; SV *retsv = NULL; /* Default to caching results for DBI dispatch quick_FETCH */ int cacheit = TRUE; /* int oraperl = DBIc_COMPAT(imp_sth); */ if (kl==13 && strEQ(key, "NUM_OF_PARAMS")) /* handled by DBI */ return Nullsv; if (!imp_sth->done_desc && !dbd_describe(sth, imp_sth)) { STRLEN lna; /* dbd_describe has already called ora_error() */ /* we can't return Nullsv here because the xs code will */ /* then just pass the attribute name to DBI for FETCH. */ croak("Describe failed during %s->FETCH(%s): %ld: %s", SvPV(sth,PL_na), key, (long)SvIV(DBIc_ERR(imp_sth)), SvPV(DBIc_ERRSTR(imp_sth),lna) ); } i = DBIc_NUM_FIELDS(imp_sth); if (kl==4 && strEQ(key, "NAME")) { AV *av = newAV(); SV *x; D_imp_dbh_from_sth; retsv = newRV(sv_2mortal((SV*)av)); while(--i >= 0) { x = newSVpv((char*)imp_sth->fbh[i].name,0); if (CSFORM_IMPLIES_UTF8(SQLCS_IMPLICIT)) { #ifdef sv_utf8_decode sv_utf8_decode(x); #else SvUTF8_on(x); #endif } av_store(av, i, x); } } else if (kl==11 && strEQ(key, "ParamValues")) { HV *pvhv = newHV(); if (imp_sth->all_params_hv) { SV *sv; char *key; I32 keylen; hv_iterinit(imp_sth->all_params_hv); while ( (sv = hv_iternextsv(imp_sth->all_params_hv, &key, &keylen)) ) { phs_t *phs = (phs_t*)(void*)SvPVX(sv); /* placeholder struct */ (void)hv_store(pvhv, key, keylen, newSVsv(phs->sv), 0); } } retsv = newRV_noinc((SV*)pvhv); cacheit = FALSE; } else if (kl==11 && strEQ(key, "ora_lengths")) { AV *av = newAV(); retsv = newRV(sv_2mortal((SV*)av)); while(--i >= 0) av_store(av, i, newSViv((IV)imp_sth->fbh[i].disize)); } else if (kl==9 && strEQ(key, "ora_types")) { AV *av = newAV(); retsv = newRV(sv_2mortal((SV*)av)); while(--i >= 0) av_store(av, i, newSViv(imp_sth->fbh[i].dbtype)); } else if (kl==4 && strEQ(key, "TYPE")) { AV *av = newAV(); retsv = newRV(sv_2mortal((SV*)av)); while(--i >= 0) av_store(av, i, newSViv(ora2sql_type(imp_sth->fbh+i).dbtype)); } else if (kl==5 && strEQ(key, "SCALE")) { AV *av = newAV(); retsv = newRV(sv_2mortal((SV*)av)); while(--i >= 0) av_store(av, i, newSViv(ora2sql_type(imp_sth->fbh+i).scale)); } else if (kl==9 && strEQ(key, "PRECISION")) { AV *av = newAV(); retsv = newRV(sv_2mortal((SV*)av)); while(--i >= 0) av_store(av, i, newSViv(ora2sql_type(imp_sth->fbh+i).prec)); #ifdef XXX } else if (kl==9 && strEQ(key, "ora_rowid")) { /* return current _binary_ ROWID (oratype 11) uncached */ /* Use { ora_type => 11 } when binding to a placeholder */ retsv = newSVpv((char*)&imp_sth->cda->rid, sizeof(imp_sth->cda->rid)); cacheit = FALSE; #endif } else if (kl==17 && strEQ(key, "ora_est_row_width")) { retsv = newSViv(imp_sth->est_width); cacheit = TRUE; } else if (kl==11 && strEQ(key, "RowsInCache")) { retsv = newSViv(imp_sth->RowsInCache); cacheit = FALSE; }else if (kl==12 && strEQ(key, "RowCacheSize")) { retsv = newSViv(imp_sth->RowCacheSize); cacheit = FALSE; } else if (kl==8 && strEQ(key, "NULLABLE")) { AV *av = newAV(); retsv = newRV(sv_2mortal((SV*)av)); while(--i >= 0) av_store(av, i, boolSV(imp_sth->fbh[i].nullok)); } else if (kl==13 && strEQ(key, "len_char_size")) { AV *av = newAV(); retsv = newRV(sv_2mortal((SV*)av)); while(--i >= 0) av_store(av, i, newSViv(imp_sth->fbh[i].len_char_size)); } else { return Nullsv; } if (cacheit) { /* cache for next time (via DBI quick_FETCH) */ SV **svp = hv_fetch((HV*)SvRV(sth), key, kl, 1); sv_free(*svp); *svp = retsv; (void)SvREFCNT_inc(retsv); /* so sv_2mortal won't free it */ } return sv_2mortal(retsv); } /* --------------------------------------- */ static sql_fbh_t ora2sql_type(imp_fbh_t* fbh) { sql_fbh_t sql_fbh; sql_fbh.dbtype = fbh->dbtype; sql_fbh.prec = fbh->prec; sql_fbh.scale = fbh->scale; switch(fbh->dbtype) { /* oracle Internal (not external) types */ case SQLT_NUM: if (fbh->scale == -127) { /* FLOAT, REAL, DOUBLE_PRECISION */ sql_fbh.dbtype = SQL_DOUBLE; sql_fbh.scale = 0; /* better: undef */ if (fbh->prec == 0) { /* NUMBER; s. Oracle Bug# 2755842, 2235818 */ sql_fbh.prec = 126; } } else if (fbh->scale == 0) { if (fbh->prec == 0) { /* NUMBER */ sql_fbh.dbtype = SQL_DOUBLE; sql_fbh.prec = 126; } else { /* INTEGER, NUMBER(p,0) */ sql_fbh.dbtype = SQL_DECIMAL; /* better: SQL_INTEGER */ } } else { /* NUMBER(p,s) */ sql_fbh.dbtype = SQL_DECIMAL; /* better: SQL_NUMERIC */ } break; #ifdef SQLT_IBDOUBLE case SQLT_BDOUBLE: case SQLT_BFLOAT: case SQLT_IBDOUBLE: case SQLT_IBFLOAT: sql_fbh.dbtype = SQL_DOUBLE; sql_fbh.prec = 126; break; #endif case SQLT_CHR: sql_fbh.dbtype = SQL_VARCHAR; break; case SQLT_LNG: sql_fbh.dbtype = SQL_LONGVARCHAR; break; /* long */ case SQLT_DAT: sql_fbh.dbtype = SQL_TYPE_TIMESTAMP;break; case SQLT_BIN: sql_fbh.dbtype = SQL_BINARY; break; /* raw */ case SQLT_LBI: sql_fbh.dbtype = SQL_LONGVARBINARY; break; /* long raw */ case SQLT_AFC: sql_fbh.dbtype = SQL_CHAR; break; /* Ansi fixed char */ case SQLT_CLOB: sql_fbh.dbtype = SQL_CLOB; break; case SQLT_BLOB: sql_fbh.dbtype = SQL_BLOB; break; #ifdef SQLT_TIMESTAMP_TZ case SQLT_DATE: sql_fbh.dbtype = SQL_DATE; break; case SQLT_TIME: sql_fbh.dbtype = SQL_TIME; break; case SQLT_TIME_TZ: sql_fbh.dbtype = SQL_TYPE_TIME_WITH_TIMEZONE; break; case SQLT_TIMESTAMP: sql_fbh.dbtype = SQL_TYPE_TIMESTAMP; break; case SQLT_TIMESTAMP_TZ: sql_fbh.dbtype = SQL_TYPE_TIMESTAMP_WITH_TIMEZONE; break; case SQLT_TIMESTAMP_LTZ: sql_fbh.dbtype = SQL_TYPE_TIMESTAMP_WITH_TIMEZONE; break; case SQLT_INTERVAL_YM: sql_fbh.dbtype = SQL_INTERVAL_YEAR_TO_MONTH; break; case SQLT_INTERVAL_DS: sql_fbh.dbtype = SQL_INTERVAL_DAY_TO_SECOND; break; #endif default: sql_fbh.dbtype = -9000 - fbh->dbtype; /* else map type into DBI reserved standard range */ } return sql_fbh; } static void dump_env_to_trace(imp_dbh_t *imp_dbh) { dTHX; int i = 0; char *p; #if defined (__APPLE__) #include #define environ (*_NSGetEnviron()) #elif defined (__BORLANDC__) extern char **environ; #endif PerlIO_printf(DBIc_LOGPIO(imp_dbh), "Environment variables:\n"); do { p = (char*)environ[i++]; PerlIO_printf(DBIc_LOGPIO(imp_dbh),"\t%s\n",p); } while ((char*)environ[i] != '\0'); } static void disable_taf( imp_dbh_t *imp_dbh) { sword status; OCIFocbkStruct tafailover; tafailover.fo_ctx = NULL; tafailover.callback_function = NULL; OCIAttrSet_log_stat(imp_dbh, imp_dbh->srvhp, (ub4) OCI_HTYPE_SERVER, (dvoid *) &tafailover, (ub4) 0, (ub4) OCI_ATTR_FOCBK, imp_dbh->errhp, status); return; } static int enable_taf( SV *dbh, imp_dbh_t *imp_dbh) { bool can_taf = 0; sword status; #ifdef OCI_ATTR_TAF_ENABLED OCIAttrGet_log_stat(imp_dbh, imp_dbh->srvhp, OCI_HTYPE_SERVER, &can_taf, NULL, OCI_ATTR_TAF_ENABLED, imp_dbh->errhp, status); #endif if (!can_taf){ croak("You are attempting to enable TAF on a server that is not TAF Enabled \n"); } status = reg_taf_callback(dbh, imp_dbh); if (status != OCI_SUCCESS) { oci_error(dbh, NULL, status, "Setting TAF Callback Failed! "); return 0; } return 1; } DBD-Oracle-1.74/README0000644000175000017500000053374212326332111013447 0ustar yanickyanickNAME DBD::Oracle - Oracle database driver for the DBI module VERSION version 1.74 SYNOPSIS use DBI; $dbh = DBI->connect("dbi:Oracle:$dbname", $user, $passwd); $dbh = DBI->connect("dbi:Oracle:host=$host;sid=$sid", $user, $passwd); # See the DBI module documentation for full details # for some advanced uses you may need Oracle type values: use DBD::Oracle qw(:ora_types); DESCRIPTION DBD::Oracle is a Perl module which works with the DBI module to provide access to Oracle databases. This documentation describes driver specific behaviour and restrictions. It is not supposed to be used as the only reference for the user. In any case consult the DBI documentation first! CONSTANTS :ora_session_modes ORA_SYSDBA ORA_SYSOPER ORA_SYSASM ORA_SYSBACKUP ORA_SYSDG ORA_SYSKM :ora_types ORA_VARCHAR2 ORA_STRING ORA_NUMBER ORA_LONG ORA_ROWID ORA_DATE ORA_RAW ORA_LONGRAW ORA_CHAR ORA_CHARZ ORA_MLSLABEL ORA_XMLTYPE ORA_CLOB ORA_BLOB ORA_RSET ORA_VARCHAR2_TABLE ORA_NUMBER_TABLE SQLT_INT SQLT_FLT ORA_OCI SQLT_CHR SQLT_BIN SQLCS_IMPLICIT SQLCS_NCHAR SQLCS_IMPLICIT and SQLCS_NCHAR are *character set form* values. See notes about Unicode elsewhere in this document. SQLT_INT SQLT_FLT These types are used only internally, and may be specified as internal bind type for ORA_NUMBER_TABLE. See notes about ORA_NUMBER_TABLE elsewhere in this document ORA_OCI Oracle doesn't provide a formal API for determining the exact version number of the OCI client library used, so DBD::Oracle has to go digging (and sometimes has to more or less guess). The ORA_OCI constant holds the result of that process. In string context ORA_OCI returns the full "A.B.C.D" version string. In numeric context ORA_OCI returns the major.minor version number (8.1, 9.2, 10.0 etc). But note that version numbers are not actually floating point and so if Oracle ever makes a release that has a two digit minor version, such as 9.10 it will have a lower numeric value than the preceding 9.9 release. So use with care. The contents and format of ORA_OCI are subject to change (it may, for example, become a *version object* in later releases). I recommend that you avoid checking for exact values. :ora_fetch_orient OCI_FETCH_CURRENT OCI_FETCH_NEXT OCI_FETCH_FIRST OCI_FETCH_LAST OCI_FETCH_PRIOR OCI_FETCH_ABSOLUTE OCI_FETCH_RELATIVE These constants are used to set the orientation of a fetch on a scrollable cursor. :ora_exe_modes OCI_STMT_SCROLLABLE_READONLY :ora_fail_over OCI_FO_END OCI_FO_ABORT OCI_FO_REAUTH OCI_FO_BEGIN OCI_FO_ERROR OCI_FO_NONE OCI_FO_SESSION OCI_FO_SELECT OCI_FO_TXNAL OCI_FO_RETRY DBI CLASS METHODS connect This method creates a database handle by connecting to a database, and is the DBI equivalent of the "new" method. To open a connection to an Oracle database you need to specify a database connection string (URL), username and password. The connection string is always of the form: "dbi:Oracle:" There are several ways to identify a database: 1 If the database is local, specifying the SID or service name will be enough. 2 If the database is defined in a TNSNAMES.ORA file, you can use the service name given in the file 3 To connect without TNSNAMES.ORA file, you can use an EZCONNECT url, of the form: //host[:port][/service_name] If port name is not specified, 1521 is the default. If service name is not specified, the hostname will be used as a service name. The following examples show several ways a connection can be created: $dbh = DBI->connect('dbi:Oracle:DB','username','password'); $dbh = DBI->connect('dbi:Oracle:DB','username/password',''); $dbh = DBI->connect('dbi:Oracle:','username@DB','password'); $dbh = DBI->connect('dbi:Oracle:host=foobar;sid=DB;port=1521', 'scott/tiger', ''); $dbh = DBI->connect("dbi:Oracle://myhost:1522/ORCL",'username', 'password'); OS authentication To connect to a local database with a user which has been set up to authenticate via the OS ("ALTER USER username IDENTIFIED EXTERNALLY"): $dbh = DBI->connect('dbi:Oracle:','/',''); Note the lack of a connection name (use the ORACLE_SID environment variable). If an explicit SID is used you will probably get an ORA-01004 error. That only works for local databases. (Authentication to remote Oracle databases using your Unix login name without a password is possible but it is not secure and not recommended so not documented here. Oracle Environment Variables To use DBD::ORACLE to connect to an Oracle database, ORACLE_HOME environment variable should be set correctly. In general, the value used should match the version of Oracle that was used to build DBD::Oracle. If using dynamic linking then ORACLE_HOME should match the version of Oracle that will be used to load in the Oracle client libraries (via LD_LIBRARY_PATH, ldconfig, or similar on Unix). Oracle can use two environment variables to specify default connections: ORACLE_SID and TWO_TASK. To use them, specify either a local SID or service name, or a service name that is specified in the TNSNAMES.ORA file. Note that if you have *both* local and remote databases, and you have ORACLE_SID *and* TWO_TASK set, and you don't specify a fully qualified connect string on the command line, TWO_TASK takes precedence over ORACLE_SID (i.e. you get connected to remote system). It is highly recommended not to rely on environment variables and to always explicitly specify the SID in the connection string. This can prevent serious mistakes such as dropping a schema in the wrong database, and generally makes debugging and troubleshooting easier. Also remember that depending on the operating system you are using the differing "ORACLE" environment variables may be case sensitive, so if you are not connecting as you should double check the case of both the variable and its value. Timezones If the query is run through SQL*Net (mostly queries that are executed on remote servers), Oracle will return the time zone based on the setting of the UNIX environment variable "TZ" for the user who started the listener. If the query is run locally, Oracle will return the time zone based on the "TZ" environment variable setting of the user running the query. With local queries, you can change the time zone for a particular user by simply changing the setting of "TZ". To check the current setting, issue the UNIX "date" command. Oracle DRCP DBD::Oracle supports DRCP (Database Resident Connection Pool) so if you have an 11.2 database and DRCP is enabled you can direct all of your connections to it by adding ':POOLED' to the SID or setting a connection attribute of ora_drcp, or set the SERVER=POOLED when using a TNSENTRY style connection or even by setting an environment variable ORA_DRCP. All of which are demonstrated below; $dbh = DBI->connect('dbi:Oracle:DB:POOLED','username','password') $dbh = DBI->connect('dbi:Oracle:','username@DB:POOLED','password') $dbh = DBI->connect('dbi:Oracle:DB','username','password',{ora_drcp=>1}) $dbh = DBI->connect('dbi:Oracle:DB','username','password',{ora_drcp=>1, ora_drcp_class=>'my_app', ora_drcp_min =>10}) $dbh = DBI->connect('dbi:Oracle:host=foobar;sid=ORCL;port=1521;SERVER=POOLED', 'scott/tiger', '') $dbh = DBI->connect('dbi:Oracle:', q{scott/tiger@(DESCRIPTION= (ADDRESS=(PROTOCOL=TCP)(HOST= foobar)(PORT=1521)) (CONNECT_DATA=(SID=ORCL)(SERVER=POOLED)))}, "") if the ORA_DRCP environment variable is set then just this $dbh = DBI->connect('dbi:Oracle:DB','username','password') You can find a white paper on setting up DRCP and its advantages at . Please note that DRCP support in DBD::Oracle is relatively new so the mechanics or its implementation are subject to change. TAF (Transparent Application Failover) Transparent Application Failover (TAF) is the feature in OCI that allows for clients to automatically reconnect to an instance in the event of a failure of the instance. The reconnect happens automatically from within the OCI (Oracle Call Interface) library. DBD::Oracle now supports a callback function that will fire when a TAF event takes place. You may use the callback to inform the user a failover is taking place or to setup the session again once the failover has succeeded. You will have to set up TAF on your instance before you can use this callback. You can test your instance to see if you can use TAF callback with $dbh->ora_can_taf(); If you try to set up a callback without it being enabled DBD::Oracle will croak. NOTE: Currently, you must enable TAF during DBI's connect. However once enabled you can change the TAF settings. It is outside the scope of this document to go through all of the possible TAF situations you might want to set up but here is a simple example: The TNS entry for the instance has had the following added to the CONNECT_DATA section (FAILOVER_MODE= (TYPE=select) (METHOD=basic) (RETRIES=10) (DELAY=10)) You will also have to create your own perl function that will be called from the client. You can name it anything you want and it will always be passed two parameters, the failover event value and the failover type. You can also set a sleep value in case of failover error and the OCI client will sleep for the specified seconds before it attempts another event. use DBD::Oracle(qw(:ora_fail_over)); #import the ora fail over constants #set up TAF on the connection # NOTE since DBD::Oracle uses call_pv you may need to pass a full # name space as the function e.g., 'main::handle_taf' # NOTE from 1.49_00 ora_taf_function can accept a code ref as well # as a sub name as it now uses call_sv my $dbh = DBI->connect('dbi:Oracle:XE', 'hr', 'hr', {ora_taf_function => 'main::handle_taf'}); #create the perl TAF event function sub handle_taf { # NOTE from 1.49_00 the $dbh handle was passed to your callback my ($fo_event,$fo_type, $dbh) = @_; if ($fo_event == OCI_FO_BEGIN){ print " Instance Unavailable Please stand by!! \n"; printf(" Your TAF type is %s \n", (($fo_type==OCI_FO_NONE) ? "NONE" :($fo_type==OCI_FO_SESSION) ? "SESSION" :($fo_type==OCI_FO_SELECT) ? "SELECT" : "UNKNOWN!")); } elsif ($fo_event == OCI_FO_ABORT){ print " Failover aborted. Failover will not take place.\n"; } elsif ($fo_event == OCI_FO_END){ printf(" Failover ended ...Resuming your %s\n",(($fo_type==OCI_FO_NONE) ? "NONE" :($fo_type==OCI_FO_SESSION) ? "SESSION" :($fo_type==OCI_FO_SELECT) ? "SELECT" : "UNKNOWN!")); } elsif ($fo_event == OCI_FO_REAUTH){ print " Failed over user. Resuming services\n"; } elsif ($fo_event == OCI_FO_ERROR){ print " Failover error ...\n"; sleep 5; # sleep before having another go return OCI_FO_RETRY; } else { printf(" Bad Failover Event: %d.\n", $fo_event); } return 0; } The TAF types are as follows OCI_FO_SESSION indicates the user has requested only session failover. OCI_FO_SELECT indicates the user has requested select failover. OCI_FO_NONE indicates the user has not requested a failover type. OCI_FO_TXNAL indicates the user has requested a transaction failover. The TAF events are as follows OCI_FO_BEGIN indicates that failover has detected a lost connection and failover is starting. OCI_FO_END indicates successful completion of failover. OCI_FO_ABORT indicates that failover was unsuccessful, and there is no option of retrying. OCI_FO_ERROR also indicates that failover was unsuccessful, but it gives the application the opportunity to handle the error and retry failover. OCI_FO_REAUTH indicates that you have multiple authentication handles and failover has occurred after the original authentication. It indicates that a user handle has been re-authenticated. To find out which, the application checks the OCI_ATTR_SESSION attribute of the service context handle (which is the first parameter). Connect Attributes ora_ncs_buff_mtpl You can customize the size of the buffer when selecting LOBs with the built-in AUTO Lob. The default value is 4 which is probably excessive for most situations but is needed for backward compatibility. If you not converting between a NCS on the DB and the Client then you might want to set this to 1 to reduce memory usage. This value can also be specified with the "ORA_DBD_NCS_BUFFER" environment variable in which case it sets the value at the connect stage. ora_drcp For Oracle 11.2 or greater. Set to *1* to enable DRCP. Can also be set via the "ORA_DRCP" environment variable. ora_drcp_class If you are using DRCP, you can set a CONNECTION_CLASS for your pools as well. As sessions from a DRCP cannot be shared by users, you can use this setting to identify the same user across different applications. OCI will ensure that sessions belonging to a 'class' are not shared outside the class'. The values for ora_drcp_class cannot contain a '*' and must be less than 1024 characters. This value can be also be specified with the "ORA_DRCP_CLASS" environment variable. ora_drcp_min This optional value specifies the minimum number of sessions that are initially opened. New sessions are only opened after this value has been reached. The default value is 4 and any value above 0 is valid. Generally, it should be set to the number of concurrent statements the application is planning or expecting to run. This value can also be specified with the "ORA_DRCP_MIN" environment variable. ora_drcp_max This optional value specifies the maximum number of sessions that can be open at one time. Once reached no more sessions can be opened until one becomes free. The default value is 40 and any value above 1 is valid. You should not set this value lower than ora_drcp_min as that will just waste resources. This value can also be specified with the "ORA_DRCP_MAX" environment variable. ora_drcp_incr This optional value specifies the next increment for sessions to be started if the current number of sessions are less than ora_drcp_max. The default value is 2 and any value above 0 is valid as long as the value of ora_drcp_min + ora_drcp_incr is not greater than ora_drcp_max. This value can also be specified with the "ORA_DRCP_INCR" environment variable. ora_taf This attribute was removed in 1.49_00 as it was redundant. To enable TAF simply set "ora_taf_function". ora_taf_function If your Oracle instance has been configured to use TAF events you can enable the TAF callback by setting this option. The name of the Perl subroutine (or a code ref from 1.49_00) that will be called from OCI when a TAF event occurs. You must supply a perl function to use the callback and it will always receive at least two parameters; the failover event value and the failover type. From 1.49_00 the dbh is passed as the third argument. Below is an example of a TAF function sub taf_event{ # NOTE from 1.49_00 the $dbh handle is passed to the callback my ($event, $type, $dbh) = @_; print "My TAF event=$event\n"; print "My TAF type=$type\n"; return; } Note if passing a sub name you will probably have to use the full name space when setting the TAF function e.g., 'main::my_taf_function' and not just 'my_taf_function'. ora_taf_sleep This attribute was removed in 1.49_00 as it was redundant. If you want to sleep between retries simple add a sleep to your callback sub. ora_session_mode The ora_session_mode attribute can be used to connect with SYSDBA, SYSOPER, ORA_SYSASM, ORA_SYSBACKUP, ORA_SYSKM and ORA_SYSDG authorization. The ORA_SYSDBA, ORA_SYSOPER, ORA_SYSASM, ORA_SYSBACKUP, ORA_SYSKM and ORA_SYSDG constants can be imported using use DBD::Oracle qw(:ora_session_modes); This is one case where setting ORACLE_SID may be useful since connecting as SYSDBA or SYSOPER via SQL*Net is frequently disabled for security reasons. Example: $dsn = "dbi:Oracle:"; # no dbname here $ENV{ORACLE_SID} = "orcl"; # set ORACLE_SID as needed delete $ENV{TWO_TASK}; # make sure TWO_TASK isn't set $dbh = DBI->connect($dsn, "", "", { ora_session_mode => ORA_SYSDBA }); It has been reported that this only works if $dsn does not contain a SID so that Oracle then uses the value of ORACLE_SID (not TWO_TASK) environment variable to connect to a local instance. Also the username and password should be empty, and the user executing the script needs to be part of the dba group or osdba group. ora_oratab_orahome Passing a true value for the ora_oratab_orahome attribute will make DBD::Oracle change $ENV{ORACLE_HOME} to make the Oracle home directory that specified in the "/etc/oratab" file *if* the database to connect to is specified as a SID that exists in the oratab file, and DBD::Oracle was built to use the Oracle 7 OCI API (not Oracle 8+). ora_module_name After connecting to the database the value of this attribute is passed to the SET_MODULE() function in the "DBMS_APPLICATION_INFO" PL/SQL package. This can be used to identify the application to the DBA for monitoring and performance tuning purposes. For example: my $dbh = DBI->connect($dsn, $user, $passwd, { ora_module_name => $0 }); $dbh->{ora_module_name} = $y; The maximum size is 48 bytes. NOTE: You will need an Oracle client 10.1 or later to use this. ora_driver_name For 11g and later you can now set the name of the driver layer using OCI. Perl, Perl5, ApachePerl so on. Names starting with "ORA" are reserved. You can enter up to 8 characters. If none is enter then this will default to DBDOxxxx where xxxx is the current version number. This value can be retrieved on the server side using V$SESSION_CONNECT_INFO or GV$SESSION_CONNECT_INFO my $dbh = DBI->connect($dsn, $user, $passwd, { ora_driver_name => 'ModPerl_1' }); $dbh->{ora_driver_name} = $q; ora_client_info Allows you to add any value (up to 64 bytes) to your session and it can be retrieved on the server side from the "V$SESSION"a view. my $dbh = DBI->connect($dsn, $user, $passwd, { ora_client_info => 'Remote2' }); $dbh->{ora_client_info} = "Remote2"; NOTE: You will need an Oracle client 10.1 or later to use this. ora_client_identifier Allows you to specify the user identifier in the session handle. Most useful for web applications as it can pass in the session user name which might be different to the connection user name. Can be up to 64 bytes long but do not to include the password for security reasons and the first character of the identifier should not be ':'. This value can be retrieved on the server side using "V$SESSION" view. my $dbh = DBI->connect($dsn, $user, $passwd, { ora_client_identifier => $some_web_user }); $dbh->{ora_client_identifier} = $local_user; ora_action Allows you to specify any string up to 32 bytes which may be retrieved on the server side using "V$SESSION" view. my $dbh = DBI->connect($dsn, $user, $passwd, { ora_action => "Login"}); $dbh->{ora_action} = "New Long Query 22"; NOTE: You will need an Oracle client 10.1 or later to use this. ora_dbh_share Requires at least Perl 5.8.0 compiled with ithreads. Allows you to share database connections between threads. The first connect will make the connection, all following calls to connect with the same ora_dbh_share attribute will use the same database connection. The value must be a reference to a already shared scalar which is initialized to an empty string. our $orashr : shared = '' ; $dbh = DBI->connect ($dsn, $user, $passwd, {ora_dbh_share => \$orashr}) ; ora_envhp The first time a connection is made a new OCI 'environment' is created by DBD::Oracle and stored in the driver handle. Subsequent connects reuse (share) that same OCI environment by default. The ora_envhp attribute can be used to disable the reuse of the OCI environment from a previous connect. If the value is 0 then a new OCI environment is allocated and used for this connection. The OCI environment holds information about the client side context, such as the local NLS environment. By altering %ENV and setting ora_envhp to 0 you can create connections with different NLS settings. This is most useful for testing. ora_charset, ora_ncharset For oracle versions >= 9.2 you can specify the client charset and ncharset with the ora_charset and ora_ncharset attributes. You still need to pass "ora_envhp = 0" for all but the first connect. These attributes override the settings from environment variables. $dbh = DBI->connect ($dsn, $user, $passwd, {ora_charset => 'AL32UTF8'}); ora_verbose Use this value to enable DBD::Oracle only tracing. Simply either set the ora_verbose attribute on the connect() method to the trace level you desire like this my $dbh = DBI->connect($dsn, "", "", {ora_verbose=>6}); or set it directly on the DB handle like this; $dbh->{ora_verbose} =6; In both cases the DBD::Oracle trace level is set to 6, which is the highest level tracing most of the calls to OCI. NOTE: In future versions of DBD::Oracle ora_verbose will be changed so that it is simply a switch to turn DBI's DBD tracing on or off. A true value will turn it on and a false value will turn it off. DBI's "DBD" tracing was not available when ora_verbose was created and ora_verbose adds an additional test to every trace test. ora_oci_success_warn Use this value to print otherwise silent OCI warnings that may happen when an execute or fetch returns "Success With Info" or when you want to tune RowCaching and LOB Reads $dbh->{ora_oci_success_warn} = 1; ora_objects Use this value to enable extended embedded oracle objects mode. In extended: 1 Embedded objects are returned as instance (including type-name etc.) instead of simple ARRAY. 2 Determine object type for each instance. All object attributes are returned (not only super-type's attributes). $dbh->{ora_objects} = 1; ora_ph_type The default placeholder datatype for the database session. The "TYPE" or "ora_type" attributes to "bind_param" in DBI and "bind_param_inout" in DBI override the datatype for individual placeholders. The most frequent reason for using this attribute is to permit trailing spaces in values passed by placeholders. Constants for the values allowed for this attribute can be imported using use DBD::Oracle qw(:ora_types); Only the following values are permitted for this attribute. ORA_VARCHAR2 Oracle clients using OCI 8 will strip trailing spaces and allow embedded \0 bytes. Oracle clients using OCI 9.2 do not strip trailing spaces and allow embedded \0 bytes. This is the normal default placeholder type. ORA_STRING Do not strip trailing spaces and end the string at the first \0. ORA_CHAR Do not strip trailing spaces and allow embedded \0. Force 'blank-padded comparison semantics'. For example: use DBD::Oracle qw(:ora_types); $SQL="select username from all_users where username = ?"; #username is a char(8) $sth=$dbh->prepare($SQL)"; $sth->bind_param(1,'bloggs',{ ora_type => ORA_CHAR}); Will pad bloggs out to 8 characters and return the username. ora_parse_error_offset If the previous error was from a failed "prepare" due to a syntax error, this attribute gives the offset into the "Statement" attribute where the error was found. ora_array_chunk_size Due to OCI limitations, DBD::Oracle needs to buffer up rows of bind values in its "execute_for_fetch" implementation. This attribute sets the number of rows to buffer at a time (default value is 1000). The "execute_for_fetch" function will collect (at most) this many rows in an array, send them off to the DB for execution, then go back to collect the next chunk of rows and so on. This attribute can be used to limit or extend the number of rows processed at a time. Note that this attribute also applies to "execute_array", since that method is implemented using "execute_for_fetch". ora_connect_with_default_signals Sometimes the Oracle client seems to change some of the signal handlers of the process during the connect phase. For instance, some users have observed Perl's default $SIG{INT} handler being ignored after connecting to an Oracle database. If this causes problems in your application, set this attribute to an array reference of signals you would like to be localized during the connect process. Once the connect is complete, the signal handlers should be returned to their previous state. For example: $dbh = DBI->connect ($dsn, $user, $passwd, {ora_connect_with_default_signals => [ 'INT' ] }); NOTE disabling the signal handlers the OCI library sets up may affect functionality in the OCI library. NOTE If you are using connect_cached then the above example will lead to DBI thinking each connection is different as an anonymous array reference is being used. To avoid this when using connect_cached you are advised to use: my @ora_default_signals = (...); $dbh = DBI->connect($dsn, $user, $passwd, {ora_connect_with_default_signals => \@ora_default_signals}); In more recent Perl versions you could possibly make use of new state variables. connect_cached Implemented by DBI, no driver-specific impact. Please note that connect_cached as not been tested with DRCP. data_sources @data_sources = DBI->data_sources('Oracle'); @data_sources = $dbh->data_sources(); Returns a list of available databases. You will have to set either the 'ORACLE_HOME' or 'TNS_ADMIN' environment value to retrieve this list. It will read these values from TNSNAMES.ORA file entries. METHODS COMMON TO ALL HANDLES For all of the methods below, $h can be either a database handle ($dbh) or a statement handle ($sth). Note that *$dbh* and *$sth* can be replaced with any variable name you choose: these are just the names most often used. Another common variable used in this documentation is $*rv*, which stands for "return value". err $rv = $h->err; Returns the error code from the last method called. errstr $str = $h->errstr; Returns the last error that was reported by Oracle. Starting with "ORA-00000" code followed by the error message. state $str = $h->state; Oracle hasn't supported SQLSTATE since the early versions OCI. It will return empty when the command succeeds and 'S1000' (General Error) for all other errors. While this method can be called as either "$sth->state" or "$dbh->state", it is usually clearer to always use "$dbh->state". trace Implemented by DBI, no driver-specific impact. trace_msg Implemented by DBI, no driver-specific impact. parse_trace_flag and parse_trace_flags Implemented by DBI, no driver-specific impact. func DBD::Oracle uses the "func" method to support a variety of functions. Private database handle functions Some of these functions are called through the method func() which is described in the DBI documentation. Any function that begins with ora_ can be called directly. plsql_errstr This function returns a string which describes the errors from the most recent PL/SQL function, procedure, package, or package body compile in a format similar to the output of the SQL*Plus command 'show errors'. The function returns undef if the error string could not be retrieved due to a database error. Look in $dbh->errstr for the cause of the failure. If there are no compile errors, an empty string is returned. Example: # Show the errors if CREATE PROCEDURE fails $dbh->{RaiseError} = 0; if ( $dbh->do( q{ CREATE OR REPLACE PROCEDURE perl_dbd_oracle_test as BEGIN PROCEDURE filltab( stuff OUT TAB ); asdf END; } ) ) {} # Statement succeeded } elsif ( 6550 != $dbh->err ) { die $dbh->errstr; } # Utter failure else { my $msg = $dbh->func( 'plsql_errstr' ); die $dbh->errstr if ! defined $msg; die $msg if $msg; } dbms_output_enable / dbms_output_put / dbms_output_get These functions use the PL/SQL DBMS_OUTPUT package to store and retrieve text using the DBMS_OUTPUT buffer. Text stored in this buffer by dbms_output_put or any PL/SQL block can be retrieved by dbms_output_get or any PL/SQL block connected to the same database session. Stored text is not available until after dbms_output_put or the PL/SQL block that saved it completes its execution. This means you CAN NOT use these functions to monitor long running PL/SQL procedures. Example 1: # Enable DBMS_OUTPUT and set the buffer size $dbh->{RaiseError} = 1; $dbh->func( 1000000, 'dbms_output_enable' ); # Put text in the buffer . . . $dbh->func( @text, 'dbms_output_put' ); # . . . and retrieve it later @text = $dbh->func( 'dbms_output_get' ); Example 2: $dbh->{RaiseError} = 1; $sth = $dbh->prepare(q{ DECLARE tmp VARCHAR2(50); BEGIN SELECT SYSDATE INTO tmp FROM DUAL; dbms_output.put_line('The date is '||tmp); END; }); $sth->execute; # retrieve the string $date_string = $dbh->func( 'dbms_output_get' ); dbms_output_enable ( [ buffer_size ] ) This function calls DBMS_OUTPUT.ENABLE to enable calls to package DBMS_OUTPUT procedures GET, GET_LINE, PUT, and PUT_LINE. Calls to these procedures are ignored unless DBMS_OUTPUT.ENABLE is called first. The buffer_size is the maximum amount of text that can be saved in the buffer and must be between 2000 and 1,000,000. If buffer_size is not given, the default is 20,000 bytes. dbms_output_put ( [ @lines ] ) This function calls DBMS_OUTPUT.PUT_LINE to add lines to the buffer. If all lines were saved successfully the function returns 1. Depending on the context, an empty list or undef is returned for failure. If any line causes buffer_size to be exceeded, a buffer overflow error is raised and the function call fails. Some of the text might be in the buffer. dbms_output_get This function calls DBMS_OUTPUT.GET_LINE to retrieve lines of text from the buffer. In an array context, all complete lines are removed from the buffer and returned as a list. If there are no complete lines, an empty list is returned. In a scalar context, the first complete line is removed from the buffer and returned. If there are no complete lines, undef is returned. Any text in the buffer after a call to DBMS_OUTPUT.GET_LINE or DBMS_OUTPUT.GET is discarded by the next call to DBMS_OUTPUT.PUT_LINE, DBMS_OUTPUT.PUT, or DBMS_OUTPUT.NEW_LINE. reauthenticate ( $username, $password ) Starts a new session against the current database using the credentials supplied. private_attribute_info $hashref = $dbh->private_attribute_info(); $hashref = $sth->private_attribute_info(); Returns a hash of all private attributes used by DBD::Oracle, for either a database or a statement handle. Currently, all the hash values are undef. ATTRIBUTES COMMON TO ALL HANDLES InactiveDestroy (boolean) Implemented by DBI, no driver-specific impact. RaiseError (boolean, inherited) Forces errors to always raise an exception. Although it defaults to off, it is recommended that this be turned on, as the alternative is to check the return value of every method (prepare, execute, fetch, etc.) manually, which is easy to forget to do. PrintError (boolean, inherited) Forces database errors to also generate warnings, which can then be filtered with methods such as locally redefining *$SIG{__WARN__}* or using modules such as "CGI::Carp". This attribute is on by default. ShowErrorStatement (boolean, inherited) Appends information about the current statement to error messages. If placeholder information is available, adds that as well. Defaults to true. Warn (boolean, inherited) Enables warnings. This is on by default, and should only be turned off in a local block for a short a time only when absolutely needed. Executed (boolean, read-only) Indicates if a handle has been executed. For database handles, this value is true after the "do" method has been called, or when one of the child statement handles has issued an "execute". Issuing a "commit" or "rollback" always resets the attribute to false for database handles. For statement handles, any call to "execute" or its variants will flip the value to true for the lifetime of the statement handle. TraceLevel (integer, inherited) Sets the trace level, similar to the "trace" method. See the sections on "trace" and "parse_trace_flag" for more details. Active (boolean, read-only) Indicates if a handle is active or not. For database handles, this indicates if the database has been disconnected or not. For statement handles, it indicates if all the data has been fetched yet or not. Use of this attribute is not encouraged. Kids (integer, read-only) Returns the number of child processes created for each handle type. For a driver handle, indicates the number of database handles created. For a database handle, indicates the number of statement handles created. For statement handles, it always returns zero, because statement handles do not create kids. ActiveKids (integer, read-only) Same as "Kids", but only returns those that are active. CachedKids (hash ref) Returns a hashref of handles. If called on a database handle, returns all statement handles created by use of the "prepare_cached" method. If called on a driver handle, returns all database handles created by the "connect_cached" method. ChildHandles (array ref) Implemented by DBI, no driver-specific impact. PrintWarn (boolean, inherited) Implemented by DBI, no driver-specific impact. HandleError (boolean, inherited) Implemented by DBI, no driver-specific impact. HandleSetErr (code ref, inherited) Implemented by DBI, no driver-specific impact. ErrCount (unsigned integer) Implemented by DBI, no driver-specific impact. FetchHashKeyName (string, inherited) Implemented by DBI, no driver-specific impact. ChopBlanks (boolean, inherited) Implemented by DBI, no driver-specific impact. Taint (boolean, inherited) Implemented by DBI, no driver-specific impact. TaintIn (boolean, inherited) Implemented by DBI, no driver-specific impact. TaintOut (boolean, inherited) Implemented by DBI, no driver-specific impact. Profile (inherited) Implemented by DBI, no driver-specific impact. Type (scalar) Returns "dr" for a driver handle, "db" for a database handle, and "st" for a statement handle. Should be rarely needed. LongReadLen The maximum size of long or longraw columns to retrieve. If one of these columns is longer than LongReadLen then either a data truncation error will be raised (LongTrunkOk is false) or the column will be silently truncated (LongTruncOk is true). DBI currently defaults this to 80. LongTruncOk Implemented by DBI, no driver-specific impact. CompatMode Type: boolean, inherited The CompatMode attribute is used by emulation layers (such as Oraperl) to enable compatible behaviour in the underlying driver (e.g., DBD::Oracle) for this handle. Not normally set by application code. It also has the effect of disabling the 'quick FETCH' of attribute values from the handles attribute cache. So all attribute values are handled by the drivers own FETCH method. This makes them slightly slower but is useful for special-purpose drivers like DBD::Multiplex. ORACLE-SPECIFIC DATABASE HANDLE METHODS ora_can_unicode ( [ $refresh ] ) Returns a number indicating whether either of the database character sets is a Unicode encoding. Calls ora_nls_parameters() and passes the optional $refresh parameter to it. 0 = Neither character set is a Unicode encoding. 1 = National character set is a Unicode encoding. 2 = Database character set is a Unicode encoding. 3 = Both character sets are Unicode encodings. ora_can_taf Returns true if the current connection supports TAF events. False if otherwise. ora_nls_parameters ( [ $refresh ] ) Returns a hash reference containing the current NLS parameters, as given by the v$nls_parameters view. The values fetched are cached between calls. To cause the latest values to be fetched, pass a true value to the function. ORACLE-SPECIFIC DATABASE FUNCTIONS ora_server_version $versions = $dbh->func('ora_server_version'); Returns an array reference of server version strings e.g., [11,2,0,2,0] DATABASE HANDLE METHODS selectall_arrayref $ary_ref = $dbh->selectall_arrayref($sql); $ary_ref = $dbh->selectall_arrayref($sql, \%attr); $ary_ref = $dbh->selectall_arrayref($sql, \%attr, @bind_values); Returns a reference to an array containing the rows returned by preparing and executing the SQL string. See the DBI documentation for full details. selectall_hashref $hash_ref = $dbh->selectall_hashref($sql, $key_field); Returns a reference to a hash containing the rows returned by preparing and executing the SQL string. See the DBI documentation for full details. selectcol_arrayref $ary_ref = $dbh->selectcol_arrayref($sql, \%attr, @bind_values); Returns a reference to an array containing the first column from each rows returned by preparing and executing the SQL string. It is possible to specify exactly which columns to return. See the DBI documentation for full details. prepare $sth = $dbh->prepare($statement, \%attr); Prepares a statement for later execution by the database engine and returns a reference to a statement handle object. Prepare Attributes These attributes may be used in the "\%attr" parameter of the "prepare" in DBI database handle method. ora_placeholders Set to false to disable processing of placeholders. Used mainly for loading a PL/SQL package that has been *wrapped* with Oracle's "wrap" utility. ora_auto_lob If true (the default), fetching retrieves the contents of the CLOB or BLOB column in most circumstances. If false, fetching retrieves the Oracle "LOB Locator" of the CLOB or BLOB value. See "LOBS AND LONGS" for more details. See also the LOB tests in 05dbi.t of Oracle::OCI for examples of how to use LOB Locators. ora_pers_lob If true the "Simple Fetch for CLOBs and BLOBs" method for the "Data Interface for Persistent LOBs" will be used for LOBs rather than the default method "Data Interface for LOB Locators". ora_clbk_lob If true the "Piecewise Fetch with Callback" method for the "Data Interface for Persistent LOBs" will be used for LOBs. ora_piece_lob If true the "Piecewise Fetch with Polling" method for the "Data Interface for Persistent LOBs" will be used for LOBs. ora_piece_size This is the max piece size for the "Piecewise Fetch with Callback" and "Piecewise Fetch with Polling" methods, in chars for CLOBS, and bytes for BLOBS. ora_check_sql If 1 (default), force SELECT statements to be described in prepare(). If 0, allow SELECT statements to defer describe until execute(). See "Prepare Postponed Till Execute" for more information. ora_exe_mode This will set the execute mode of the current statement. Presently only one mode is supported; OCI_STMT_SCROLLABLE_READONLY - make result set scrollable See "SCROLLABLE CURSORS" for more details. ora_prefetch_rows Sets the number of rows to be prefetched. If it is not set, then the default value is 1. See "Row Prefetching" for more details. ora_prefetch_memory Sets the memory level for rows to be prefetched. The application then fetches as many rows as will fit into that much memory. See "Row Prefetching" for more details. ora_row_cache_off By default DBD::Oracle will use a row cache when fetching to cut down the number of round trips to the server. If you do not want to use an array fetch set this value to any value other than 0; See "Row Prefetching" for more details. Placeholders There are three types of placeholders that can be used in DBD::Oracle. The first is the "question mark" type, in which each placeholder is represented by a single question mark character. This is the method recommended by the DBI and is the most portable. Each question mark is internally replaced by a "dollar sign number" in the order in which they appear in the query (important when using "bind_param"). The second type of placeholder is "named parameters" in the format ":foo" which is the one Oracle prefers. $dbh->{RaiseError} = 1; # save having to check each method call $sth = $dbh->prepare("SELECT name, age FROM people WHERE name LIKE :name"); $sth->bind_param(':name', "John%"); $sth->execute; DBI::dump_results($sth); Note when calling bind_param with named parameters you must include the leading colon. The advantage of this placeholder type is that you can use the same placeholder more than once in the same SQL statement but you only need to bind it once. The last placeholder type is a variation of the two above where you name each placeholder :N (where N is a number). Like the named placeholders above you can use the same placeholder multiple times in the SQL but when you call bind_param you only need to pass the N (e.g., for :1 you use bind_param(1,...) and not bind_param(':1',...). The different types of placeholders cannot be mixed within a statement, but you may use different ones for each statement handle you have. This is confusing at best, so stick to one style within your program. prepare_cached $sth = $dbh->prepare_cached($statement, \%attr); Implemented by DBI, no driver-specific impact. This method is most useful if the same query is used over and over as it will cut down round trips to the server. do $rv = $dbh->do($statement); $rv = $dbh->do($statement, \%attr); $rv = $dbh->do($statement, \%attr, @bind_values); Prepare and execute a single statement. Returns the number of rows affected if the query was successful, returns undef if an error occurred, and returns -1 if the number of rows is unknown or not available. Note that this method will return 0E0 instead of 0 for 'no rows were affected', in order to always return a true value if no error occurred. last_insert_id Oracle does not implement auto_increment of serial type columns it uses predefined sequences where the id numbers are either selected before insert, at insert time with a trigger, or as part of the query. Below is an example of you to use the latter with the SQL returning clause to get the ID number back on insert with the bind_param_inout method. . $dbh->do('CREATE SEQUENCE lii_seq START 1'); $dbh->do(q{CREATE TABLE lii ( foobar INTEGER NOT NULL UNIQUE, baz VARCHAR)}); $SQL = "INSERT INTO lii (foobar,baz) VALUES (lii_seq.nextval,'XX') returning foobar into :p_new_id";"; $sth = $dbh->prepare($SQL); my $p_new_id='-1'; $sth->bind_param_inout(":p_new_id",\$p_new_id,38); $sth->execute(); $db->commit(); commit $rv = $dbh->commit; Issues a COMMIT to the server, indicating that the current transaction is finished and that all changes made will be visible to other processes. If AutoCommit is enabled, then a warning is given and no COMMIT is issued. Returns true on success, false on error. rollback $rv = $dbh->rollback; Issues a ROLLBACK to the server, which discards any changes made in the current transaction. If AutoCommit is enabled, then a warning is given and no ROLLBACK is issued. Returns true on success, and false on error. begin_work This method turns on transactions until the next call to "commit" or "rollback", if "AutoCommit" is currently enabled. If it is not enabled, calling begin_work will issue an error. Note that the transaction will not actually begin until the first statement after begin_work is called. disconnect $rv = $dbh->disconnect; Disconnects from the Oracle database. Any uncommitted changes will be rolled back upon disconnection. It's good policy to always explicitly call commit or rollback at some point before disconnecting, rather than relying on the default rollback behavior. If the script exits before disconnect is called (or, more precisely, if the database handle is no longer referenced by anything), then the database handle's DESTROY method will call the rollback() and disconnect() methods automatically. It is best to explicitly disconnect rather than rely on this behavior. ping $rv = $dbh->ping; This "ping" method is used to check the validity of a database handle. The value returned is either 0, indicating that the connection is no longer valid, or 1, indicating the connection is valid. This function does 1 round trip to the Oracle Server. get_info() $value = $dbh->get_info($info_type); DBD::Oracle supports "get_info()", but (currently) only a few info types. table_info() DBD::Oracle supports attributes for "table_info()". In Oracle, the concept of *user* and *schema* is (currently) the same. Because database objects are owned by an user, the owner names in the data dictionary views correspond to schema names. Oracle does not support catalogues so TABLE_CAT is ignored as selection criterion. Search patterns are supported for TABLE_SCHEM and TABLE_NAME. TABLE_TYPE may contain a comma-separated list of table types. The following table types are supported: TABLE VIEW SYNONYM SEQUENCE The result set is ordered by TABLE_TYPE, TABLE_SCHEM, TABLE_NAME. The special enumerations of catalogues, schemas and table types are supported. However, TABLE_CAT is always NULL. An identifier is passed *as is*, i.e. as the user provides or Oracle returns it. "table_info()" performs a case-sensitive search. So, a selection criterion should respect upper and lower case. Normally, an identifier is case-insensitive. Oracle stores and returns it in upper case. Sometimes, database objects are created with quoted identifiers (for reserved words, mixed case, special characters, ...). Such an identifier is case-sensitive (if not all upper case). Oracle stores and returns it as given. "table_info()" has no special quote handling, neither adds nor removes quotes. primary_key_info() Oracle does not support catalogues so TABLE_CAT is ignored as selection criterion. The TABLE_CAT field of a fetched row is always NULL (undef). See "table_info()" for more detailed information. If the primary key constraint was created without an identifier, PK_NAME contains a system generated name with the form SYS_Cn. The result set is ordered by TABLE_SCHEM, TABLE_NAME, KEY_SEQ. An identifier is passed *as is*, i.e. as the user provides or Oracle returns it. See "table_info()" for more detailed information. foreign_key_info() This method (currently) supports the extended behaviour of SQL/CLI, i.e. the result set contains foreign keys that refer to primary and alternate keys. The field UNIQUE_OR_PRIMARY distinguishes these keys. Oracle does not support catalogues, so $pk_catalog and $fk_catalog are ignored as selection criteria (in the new style interface). The UK_TABLE_CAT and FK_TABLE_CAT fields of a fetched row are always NULL (undef). See "table_info()" for more detailed information. If the primary or foreign key constraints were created without an identifier, UK_NAME or FK_NAME contains a system generated name with the form SYS_Cn. The UPDATE_RULE field is always 3 ('NO ACTION'), because Oracle (currently) does not support other actions. The DELETE_RULE field may contain wrong values. This is a known Bug (#1271663) in Oracle's data dictionary views. Currently (as of 8.1.7), 'RESTRICT' and 'SET DEFAULT' are not supported, 'CASCADE' is mapped correctly and all other actions (incl. 'SET NULL') appear as 'NO ACTION'. The DEFERABILITY field is always NULL, because this columns is not present in the ALL_CONSTRAINTS view of older Oracle releases. The result set is ordered by UK_TABLE_SCHEM, UK_TABLE_NAME, FK_TABLE_SCHEM, FK_TABLE_NAME, ORDINAL_POSITION. An identifier is passed *as is*, i.e. as the user provides or Oracle returns it. See "table_info()" for more detailed information. column_info() Oracle does not support catalogues so TABLE_CAT is ignored as selection criterion. The TABLE_CAT field of a fetched row is always NULL (undef). See "table_info()" for more detailed information. The CHAR_OCTET_LENGTH field is (currently) always NULL (undef). Don't rely on the values of the BUFFER_LENGTH field! Especially the length of FLOATs may be wrong. Datatype codes for non-standard types are subject to change. Attention! The DATA_DEFAULT (COLUMN_DEF) column is of type LONG so you may have to set LongReadLen on the connection handle before calling column_info if you have a large default column. After DBD::Oracle 1.40 LongReadLen is set automatically to 1Mb when calling column_info and reset aftwerwards. The result set is ordered by TABLE_SCHEM, TABLE_NAME, ORDINAL_POSITION. An identifier is passed *as is*, i.e. as the user provides or Oracle returns it. See "table_info()" for more detailed information. It is possible with Oracle to make the names of the various DB objects (table,column,index etc) case sensitive. alter table bloggind add ("Bla_BLA" NUMBER) So in the example the exact case "Bla_BLA" must be used to get it info on the column. While this alter table bloggind add (Bla_BLA NUMBER) any case can be used to get info on the column. statistics_info() Oracle does not support catalogues so TABLE_CAT is ignored as selection criterion. The TABLE_CAT field of a fetched row is always NULL (undef). See "table_info()" for more detailed information. The INDEX_QUALIFIER field of a fetched row is always NULL (undef), for the same reason as for TABLE_CAT. If an index was created without an identifier (e.g. in the course of a PK creation), INDEX_NAME contains a system generated name with the form SYS_. COLUMN_NAME may contain a system generated name (e.g. for function-based indexes). For the TYPE column, a simple mapping is used: NORMAL btree CLUSTER clustered ... other The $quick parameter is currently ignored. The method uses the dictionary with the gathered statistics, thus cannot ensure that the values for CARDINALITY and PAGES are current. The result set is ordered by NON_UNIQUE, TYPE, INDEX_QUALIFIER, INDEX_NAME, ORDINAL_POSITION. An identifier is passed *as is*, i.e. as the user provides or Oracle returns it. See "table_info()" for more detailed information. selectrow_array @row_ary = $dbh->selectrow_array($sql); @row_ary = $dbh->selectrow_array($sql, \%attr); @row_ary = $dbh->selectrow_array($sql, \%attr, @bind_values); Returns an array of row information after preparing and executing the provided SQL string. The rows are returned by calling "fetchrow_array". The string can also be a statement handle generated by a previous prepare. Note that only the first row of data is returned. If called in a scalar context, only the first column of the first row is returned. Because this is not portable, it is not recommended that you use this method in that way. selectrow_arrayref $ary_ref = $dbh->selectrow_arrayref($statement); $ary_ref = $dbh->selectrow_arrayref($statement, \%attr); $ary_ref = $dbh->selectrow_arrayref($statement, \%attr, @bind_values); Exactly the same as "selectrow_array", except that it returns a reference to an array, by internal use of the "fetchrow_arrayref" method. selectrow_hashref $hash_ref = $dbh->selectrow_hashref($sql); $hash_ref = $dbh->selectrow_hashref($sql, \%attr); $hash_ref = $dbh->selectrow_hashref($sql, \%attr, @bind_values); Exactly the same as "selectrow_array", except that it returns a reference to an hash, by internal use of the "fetchrow_hashref" method. clone $other_dbh = $dbh->clone(); Creates a copy of the database handle by connecting with the same parameters as the original handle, then trying to merge the attributes. See the DBI documentation for complete usage. DATABASE HANDLE ATTRIBUTES AutoCommit (boolean) Supported by DBD::Oracle as proposed by DBI.The default of AutoCommit is on, but this may change in the future, so it is highly recommended that you explicitly set it when calling "connect". ReadOnly (boolean) $dbh->{ReadOnly} = 1; Specifies if the current database connection should be in read-only mode or not. Please not that this method is not foolproof: there are still ways to update the database. Consider this a safety net to catch applications that should not be issuing commands such as INSERT, UPDATE, or DELETE. This method method requires DBI version 1.55 or better. Name (string, read-only) Returns the name of the current database. This is the same as the DSN, without the "dbi:Oracle:" part. Username (string, read-only) Returns the name of the user connected to the database. Driver (handle, read-only) Holds the handle of the parent driver. The only recommended use for this is to find the name of the driver using: $dbh->{Driver}->{Name} RowCacheSize DBD::Oracle supports both Server pre-fetch and Client side row caching. By default both are turned on to give optimum performance. Most of the time one can just let DBD::Oracle figure out the best optimization. Row Caching Row caching occurs on the client side and the object of it is to cut down the number of round trips made to the server when fetching rows. At each fetch a set number of rows will be retrieved from the server and stored locally. Further calls the server are made only when the end of the local buffer(cache) is reached. Rows up to the specified top level row count "RowCacheSize" are fetched if it occupies no more than the specified memory usage limit. The default value is 0, which means that memory size is not included in computing the number of rows to prefetch. If the "RowCacheSize" value is set to a negative number then the positive value of RowCacheSize is used to compute the number of rows to prefetch. By default "RowCacheSize" is automatically set. If you want to totally turn off prefetching set this to 1. For any SQL statement that contains a LOB, Long or Object Type Row Caching will be turned off. However server side caching still works. If you are only selecting a LOB Locator then Row Caching will still work. Row Prefetching Row prefetching occurs on the server side and uses the DBI database handle attribute "RowCacheSize" and or the Prepare Attribute 'ora_prefetch_memory'. Tweaking these values may yield improved performance. $dbh->{RowCacheSize} = 100; $sth=$dbh->prepare($SQL,{ora_exe_mode=>OCI_STMT_SCROLLABLE_READONLY,ora_prefetch_memory=>10000}); In the above example 10 rows will be prefetched up to a maximum of 10000 bytes of data. The Oracle Call Interface Programmer's Guide, suggests a good row cache value for a scrollable cursor is about 20% of expected size of the record set. The prefetch settings tell the DBD::Oracle to grab x rows (or x-bytes) when it needs to get new rows. This happens on the first fetch that sets the current_positon to any value other than 0. In the above example if we do a OCI_FETCH_FIRST the first 10 rows are loaded into the buffer and DBD::Oracle will not have to go back to the server for more rows. When record 11 is fetched DBD::Oracle fetches and returns this row and the next 9 rows are loaded into the buffer. In this case if you fetch backwards from 10 to 1 no server round trips are made. With large record sets it is best not to attempt to go to the last record as this may take some time, A large buffer size might even slow down the fetch. If you must get the number of rows in a large record set you might try using an few large OCI_FETCH_ABSOLUTEs and then an OCI_FETCH_LAST, this might save some time. So if you had a record set of 10000 rows and you set the buffer to 5000 and did a OCI_FETCH_LAST one would fetch the first 5000 rows into the buffer then the next 5000 rows. If one requires only the first few rows there is no need to set a large prefetch value. If the ora_prefetch_memory less than 1 or not present then memory size is not included in computing the number of rows to prefetch otherwise the number of rows will be limited to memory size. Likewise if the RowCacheSize is less than 1 it is not included in the computing of the prefetch rows. ORACLE-SPECIFIC STATEMENT HANDLE METHODS ora_stmt_type Returns the OCI Statement Type number for the SQL of a statement handle. ora_stmt_type_name Returns the OCI Statement Type name for the SQL of a statement handle. DBI STATEMENT HANDLE OBJECT METHODS bind_param $rv = $sth->bind_param($param_num, $bind_value); $rv = $sth->bind_param($param_num, $bind_value, $bind_type); $rv = $sth->bind_param($param_num, $bind_value, \%attr); Allows the user to bind a value and/or a data type to a placeholder. The value of $param_num is a number if using the '?' or if using ":foo" style placeholders, the complete name (e.g. ":foo") must be given. The $bind_value argument is fairly self-explanatory. A value of "undef" will bind a "NULL" to the placeholder. Using "undef" is useful when you want to change just the type and will be overwriting the value later. (Any value is actually usable, but "undef" is easy and efficient). The "\%attr" hash is used to indicate the data type of the placeholder. The default value is "varchar". If you need something else, you must use one of the values provided by DBI or by DBD::Pg. To use a SQL value, modify your "use DBI" statement at the top of your script as follows: use DBI qw(:sql_types); This will import some constants into your script. You can plug those directly into the "bind_param" call. Some common ones that you will encounter are: SQL_INTEGER To use Oracle SQL data types, import the list of values like this: use DBD::Pg qw(:ora_types); You can then set the data types by setting the value of the "ora_type" key in the hash passed to "bind_param". The current list of Oracle data types exported is: ORA_VARCHAR2 ORA_STRING ORA_NUMBER ORA_LONG ORA_ROWID ORA_DATE ORA_RAW ORA_LONGRAW ORA_CHAR ORA_CHARZ ORA_MLSLABEL ORA_XMLTYPE ORA_CLOB ORA_BLOB ORA_RSET ORA_VARCHAR2_TABLE ORA_NUMBER_TABLE SQLT_INT SQLT_FLT ORA_OCI SQLT_CHR SQLT_BIN Data types are "sticky," in that once a data type is set to a certain placeholder, it will remain for that placeholder, unless it is explicitly set to something else afterwards. If the statement has already been prepared, and you switch the data type to something else, DBD::Oracle will re-prepare the statement for you before doing the next execute. Examples: use DBI qw(:sql_types); use DBD::Pg qw(:ora_types); $SQL = "SELECT id FROM ptable WHERE size > ? AND title = ?"; $sth = $dbh->prepare($SQL); ## Both arguments below are bound to placeholders as "varchar" $sth->execute(123, "Merk"); ## Reset the datatype for the first placeholder to an integer $sth->bind_param(1, undef, SQL_INTEGER); ## The "undef" bound above is not used, since we supply params to execute $sth->execute(123, "Merk"); ## Set the first placeholder's value and data type $sth->bind_param(1, 234, { pg_type => ORA_NUMBER }); ## Set the second placeholder's value and data type. ## We don't send a third argument, so the default "varchar" is used $sth->bind_param('$2', "Zool"); ## We realize that the wrong data type was set above, so we change it: $sth->bind_param('$1', 234, { pg_type => SQL_INTEGER }); ## We also got the wrong value, so we change that as well. ## Because the data type is sticky, we don't need to change it $sth->bind_param(1, 567); ## This executes the statement with 567 (integer) and "Zool" (varchar) $sth->execute(); These attributes may be used in the "\%attr" parameter of the "bind_param" in DBI or "bind_param_inout" in DBI statement handle methods. ora_type Specify the placeholder's datatype using an Oracle datatype. A fatal error is raised if "ora_type" and the DBI "TYPE" attribute are used for the same placeholder. Some of these types are not supported by the current version of DBD::Oracle and will cause a fatal error if used. Constants for the Oracle datatypes may be imported using use DBD::Oracle qw(:ora_types); Potentially useful values when DBD::Oracle was built using OCI 7 and later: ORA_VARCHAR2, ORA_STRING, ORA_LONG, ORA_RAW, ORA_LONGRAW, ORA_CHAR, ORA_MLSLABEL, ORA_RSET Additional values when DBD::Oracle was built using OCI 8 and later: ORA_CLOB, ORA_BLOB, ORA_XMLTYPE, ORA_VARCHAR2_TABLE, ORA_NUMBER_TABLE Additional values when DBD::Oracle was built using OCI 9.2 and later: SQLT_CHR, SQLT_BIN See "Binding Cursors" for the correct way to use ORA_RSET. See "LOBS AND LONGS" for how to use ORA_CLOB and ORA_BLOB. See "SYS.DBMS_SQL datatypes" for ORA_VARCHAR2_TABLE, ORA_NUMBER_TABLE. See "Data Interface for Persistent LOBs" for the correct way to use SQLT_CHR and SQLT_BIN. See "OTHER DATA TYPES" for more information. See also "Placeholders and Bind Values" in DBI. ora_csform Specify the OCI_ATTR_CHARSET_FORM for the bind value. Valid values are SQLCS_IMPLICIT (1) and SQLCS_NCHAR (2). Both those constants can be imported from the DBD::Oracle module. Rarely needed. ora_csid Specify the *integer* OCI_ATTR_CHARSET_ID for the bind value. Character set names can't be used currently. ora_maxdata_size Specify the integer OCI_ATTR_MAXDATA_SIZE for the bind value. May be needed if a character set conversion from client to server causes the data to use more space and so fail with a truncation error. ora_maxarray_numentries Specify the maximum number of array entries to allocate. Used with ORA_VARCHAR2_TABLE, ORA_NUMBER_TABLE. Define the maximum number of array entries Oracle can pass back to you in OUT variable of type TABLE OF ... . ora_internal_type Specify internal data representation. Currently is supported only for ORA_NUMBER_TABLE. Optimizing Results Prepare Postponed Till Execute The DBD::Oracle module can avoid an explicit 'describe' operation prior to the execution of the statement unless the application requests information about the results (such as $sth->{NAME}). This reduces communication with the server and increases performance (reducing the number of PARSE_CALLS inside the server). However, it also means that SQL errors are not detected until "execute()" (or $sth->{NAME} etc) is called instead of when "prepare()" is called. Note that if the describe is triggered by the use of $sth->{NAME} or a similar attribute and the describe fails then *an exception is thrown* even if "RaiseError" is false! Set "ora_check_sql" to 0 in prepare() to enable this behaviour. bind_param_inout $rv = $sth->bind_param_inout($param_num, \$scalar, 0); DBD::Oracle fully supports bind_param_inout below are some uses for this method. Returning A Value from an INSERT Oracle supports an extended SQL insert syntax which will return one or more of the values inserted. This can be particularly useful for single-pass insertion of values with re-used sequence values (avoiding a separate "select seq.nextval from dual" step). $sth = $dbh->prepare(qq{ INSERT INTO foo (id, bar) VALUES (foo_id_seq.nextval, :bar) RETURNING id INTO :id }); $sth->bind_param(":bar", 42); $sth->bind_param_inout(":id", \my $new_id, 99); $sth->execute; print "The id of the new record is $new_id\n"; If you have many columns to bind you can use code like this: @params = (... column values for record to be inserted ...); $sth->bind_param($_, $params[$_-1]) for (1..@params); $sth->bind_param_inout(@params+1, \my $new_id, 99); $sth->execute; If you have many rows to insert you can take advantage of Oracle's built in execute array feature with code like this: my @in_values=('1',2,'3','4',5,'6',7,'8',9,'10'); my @out_values; my @status; my $sth = $dbh->prepare(qq{ INSERT INTO foo (id, bar) VALUES (foo_id_seq.nextval, ?) RETURNING id INTO ? }); $sth->bind_param_array(1,\@in_values); $sth->bind_param_inout_array(2,\@out_values,0,{ora_type => ORA_VARCHAR2}); $sth->execute_array({ArrayTupleStatus=>\@status}) or die "error inserting"; foreach my $id (@out_values){ print 'returned id='.$id.'\n'; } Which will return all the ids into @out_values. Note: This will only work for numbered (?) placeholders, The third parameter of bind_param_inout_array, (0 in the example), "maxlen" is required by DBI but not used by DBD::Oracle The "ora_type" attribute is not needed but only ORA_VARCHAR2 will work. Returning A Recordset DBD::Oracle does not currently support binding a PL/SQL table (aka array) as an IN OUT parameter to any Perl data structure. You cannot therefore call a PL/SQL function or procedure from DBI that uses a non-atomic datatype as either a parameter, or a return value. However, if you are using Oracle 9.0.1 or later, you can make use of table (or pipelined) functions. For example, assume you have the existing PL/SQL Package : CREATE OR REPLACE PACKAGE Array_Example AS -- TYPE tRec IS RECORD ( Col1 NUMBER, Col2 VARCHAR2 (10), Col3 DATE) ; -- TYPE taRec IS TABLE OF tRec INDEX BY BINARY_INTEGER ; -- FUNCTION Array_Func RETURN taRec ; -- END Array_Example ; CREATE OR REPLACE PACKAGE BODY Array_Example AS -- FUNCTION Array_Func RETURN taRec AS -- l_Ret taRec ; -- BEGIN FOR i IN 1 .. 5 LOOP l_Ret (i).Col1 := i ; l_Ret (i).Col2 := 'Row : ' || i ; l_Ret (i).Col3 := TRUNC (SYSDATE) + i ; END LOOP ; RETURN l_Ret ; END ; -- END Array_Example ; / Currently, there is no way to directly call the function Array_Example.Array_Func from DBI. However, by making the following relatively painless additions, its not only possible, but extremely efficient. First, you need to create database object types that correspond to the record and table types in the package. From the above example, these would be : CREATE OR REPLACE TYPE tArray_Example__taRec AS OBJECT ( Col1 NUMBER, Col2 VARCHAR2 (10), Col3 DATE ) ; CREATE OR REPLACE TYPE taArray_Example__taRec AS TABLE OF tArray_Example__taRec ; Now, assuming the existing function needs to remain unchanged (it is probably being called from other PL/SQL code), we need to add a new function to the package. Here's the new package specification and body : CREATE OR REPLACE PACKAGE Array_Example AS -- TYPE tRec IS RECORD ( Col1 NUMBER, Col2 VARCHAR2 (10), Col3 DATE) ; -- TYPE taRec IS TABLE OF tRec INDEX BY BINARY_INTEGER ; -- FUNCTION Array_Func RETURN taRec ; FUNCTION Array_Func_DBI RETURN taArray_Example__taRec PIPELINED ; -- END Array_Example ; CREATE OR REPLACE PACKAGE BODY Array_Example AS -- FUNCTION Array_Func RETURN taRec AS l_Ret taRec ; BEGIN FOR i IN 1 .. 5 LOOP l_Ret (i).Col1 := i ; l_Ret (i).Col2 := 'Row : ' || i ; l_Ret (i).Col3 := TRUNC (SYSDATE) + i ; END LOOP ; RETURN l_Ret ; END ; FUNCTION Array_Func_DBI RETURN taArray_Example__taRec PIPELINED AS l_Set taRec ; BEGIN l_Set := Array_Func ; FOR i IN l_Set.FIRST .. l_Set.LAST LOOP PIPE ROW ( tArray_Example__taRec ( l_Set (i).Col1, l_Set (i).Col2, l_Set (i).Col3 ) ) ; END LOOP ; RETURN ; END ; -- END Array_Example ; As you can see, the new function is very simple. Now, it is a simple matter of calling the function as a straight-forward SELECT from your DBI code. From the above example, the code would look something like this : my $sth = $dbh->prepare('SELECT * FROM TABLE(Array_Example.Array_Func_DBI)'); $sth->execute; while ( my ($col1, $col2, $col3) = $sth->fetchrow_array { ... } SYS.DBMS_SQL datatypes DBD::Oracle has built-in support for SYS.DBMS_SQL.VARCHAR2_TABLE and SYS.DBMS_SQL.NUMBER_TABLE datatypes. The simple example is here: my $statement=' DECLARE tbl SYS.DBMS_SQL.VARCHAR2_TABLE; BEGIN tbl := :mytable; :cc := tbl.count(); tbl(1) := \'def\'; tbl(2) := \'ijk\'; :mytable := tbl; END; '; my $sth=$dbh->prepare( $statement ); my @arr=( "abc","efg","hij" ); $sth->bind_param_inout(":mytable", \\@arr, 10, { ora_type => ORA_VARCHAR2_TABLE, ora_maxarray_numentries => 100 } ) ; $sth->bind_param_inout(":cc", \$cc, 100 ); $sth->execute(); print "Result: cc=",$cc,"\n", "\tarr=",Data::Dumper::Dumper(\@arr),"\n"; Note: Take careful note that we use '\\@arr' here because the 'bind_param_inout' will only take a reference to a scalar. ORA_VARCHAR2_TABLE SYS.DBMS_SQL.VARCHAR2_TABLE object is always bound to array reference. ( in bind_param() and bind_param_inout() ). When you bind array, you need to specify full buffer size for OUT data. So, there are two parameters: *max_len* (specified as 3rd argument of bind_param_inout() ), and *ora_maxarray_numentries*. They define maximum array entry length and maximum rows, that can be passed to Oracle and back to you. In this example we send array with 1 element with length=3, but allocate space for 100 Oracle array entries with maximum length 10 of each. So, you can get no more than 100 array entries with length <= 10. If you set *max_len* to zero, maximum array entry length is calculated as maximum length of entry of array bound. If 0 < *max_len* < length( $some_element ), truncation occur. If you set *ora_maxarray_numentries* to zero, current (at bind time) bound array length is used as maximum. If 0 < *ora_maxarray_numentries* < scalar(@array), not all array entries are bound. ORA_NUMBER_TABLE SYS.DBMS_SQL.NUMBER_TABLE object handling is much alike ORA_VARCHAR2_TABLE. The main difference is internal data representation. Currently 2 types of bind is allowed : as C-integer, or as C-double type. To select one of them, you may specify additional bind parameter *ora_internal_type* as either SQLT_INT or SQLT_FLT for C-integer and C-double types. Integer size is architecture-specific and is usually 32 or 64 bit. Double is standard IEEE 754 type. *ora_internal_type* defaults to double (SQLT_FLT). *max_len* is ignored for OCI_NUMBER_TABLE. Currently, you cannot bind full native Oracle NUMBER(38). If you really need, send request to dbi-dev list. The usage example is here: $statement=' DECLARE tbl SYS.DBMS_SQL.NUMBER_TABLE; BEGIN tbl := :mytable; :cc := tbl(2); tbl(4) := -1; tbl(5) := -2; :mytable := tbl; END; '; $sth=$dbh->prepare( $statement ); if( ! defined($sth) ){ die "Prepare error: ",$dbh->errstr,"\n"; } @arr=( 1,"2E0","3.5" ); # note, that ora_internal_type defaults to SQLT_FLT for ORA_NUMBER_TABLE . if( not $sth->bind_param_inout(":mytable", \\@arr, 10, { ora_type => ORA_NUMBER_TABLE, ora_maxarray_numentries => (scalar(@arr)+2), ora_internal_type => SQLT_FLT } ) ){ die "bind :mytable error: ",$dbh->errstr,"\n"; } $cc=undef; if( not $sth->bind_param_inout(":cc", \$cc, 100 ) ){ die "bind :cc error: ",$dbh->errstr,"\n"; } if( not $sth->execute() ){ die "Execute failed: ",$dbh->errstr,"\n"; } print "Result: cc=",$cc,"\n", "\tarr=",Data::Dumper::Dumper(\@arr),"\n"; The result is like: Result: cc=2 arr=$VAR1 = [ '1', '2', '3.5', '-1', '-2' ]; If you change bind type to SQLT_INT, like: ora_internal_type => SQLT_INT you get: Result: cc=2 arr=$VAR1 = [ 1, 2, 3, -1, -2 ]; bind_param_inout_array DBD::Oracle supports this undocumented feature of DBI. See "Returning A Value from an INSERT" for an example. bind_param_array $rv = $sth->bind_param_array($param_num, $array_ref_or_value) $rv = $sth->bind_param_array($param_num, $array_ref_or_value, $bind_type) $rv = $sth->bind_param_array($param_num, $array_ref_or_value, \%attr) Binds an array of values to a placeholder, so that each is used in turn by a call to the "execute_array" method. execute $rv = $sth->execute(@bind_values); Perform whatever processing is necessary to execute the prepared statement. execute_array $tuples = $sth->execute_array() or die $sth->errstr; $tuples = $sth->execute_array(\%attr) or die $sth->errstr; $tuples = $sth->execute_array(\%attr, @bind_values) or die $sth->errstr; ($tuples, $rows) = $sth->execute_array(\%attr) or die $sth->errstr; ($tuples, $rows) = $sth->execute_array(\%attr, @bind_values) or die $sth->errstr; Execute a prepared statement once for each item in a passed-in hashref, or items that were previously bound via the "bind_param_array" method. See the DBI documentation for more details. DBD::Oracle takes full advantage of OCI's array interface so inserts and updates using this interface will run very quickly. execute_for_fetch $tuples = $sth->execute_for_fetch($fetch_tuple_sub); $tuples = $sth->execute_for_fetch($fetch_tuple_sub, \@tuple_status); ($tuples, $rows) = $sth->execute_for_fetch($fetch_tuple_sub); ($tuples, $rows) = $sth->execute_for_fetch($fetch_tuple_sub, \@tuple_status); Used internally by the "execute_array" method, and rarely used directly. See the DBI documentation for more details. fetchrow_arrayref $ary_ref = $sth->fetchrow_arrayref; Fetches the next row of data from the statement handle, and returns a reference to an array holding the column values. Any columns that are NULL are returned as undef within the array. If there are no more rows or if an error occurs, the this method return undef. You should check "$sth->err" afterwards (or use the "RaiseError" attribute) to discover if the undef returned was due to an error. Note that the same array reference is returned for each fetch, so don't store the reference and then use it after a later fetch. Also, the elements of the array are also reused for each row, so take care if you want to take a reference to an element. See also "bind_columns". fetchrow_array @ary = $sth->fetchrow_array; Similar to the "fetchrow_arrayref" method, but returns a list of column information rather than a reference to a list. Do not use this in a scalar context. fetchrow_hashref $hash_ref = $sth->fetchrow_hashref; $hash_ref = $sth->fetchrow_hashref($name); Fetches the next row of data and returns a hashref containing the name of the columns as the keys and the data itself as the values. Any NULL value is returned as undef value. If there are no more rows or if an error occurs, the this method return undef. You should check "$sth->err" afterwards (or use the "RaiseError" attribute) to discover if the undef returned was due to an error. The optional $name argument should be either "NAME", "NAME_lc" or "NAME_uc", and indicates what sort of transformation to make to the keys in the hash. By default Oracle uses upper case. fetchall_arrayref $tbl_ary_ref = $sth->fetchall_arrayref(); $tbl_ary_ref = $sth->fetchall_arrayref( $slice ); $tbl_ary_ref = $sth->fetchall_arrayref( $slice, $max_rows ); Returns a reference to an array of arrays that contains all the remaining rows to be fetched from the statement handle. If there are no more rows, an empty arrayref will be returned. If an error occurs, the data read in so far will be returned. Because of this, you should always check "$sth->err" after calling this method, unless "RaiseError" has been enabled. If $slice is an array reference, fetchall_arrayref uses the "fetchrow_arrayref" method to fetch each row as an array ref. If the $slice array is not empty then it is used as a slice to select individual columns by perl array index number (starting at 0, unlike column and parameter numbers which start at 1). With no parameters, or if $slice is undefined, fetchall_arrayref acts as if passed an empty array ref. If $slice is a hash reference, fetchall_arrayref uses "fetchrow_hashref" to fetch each row as a hash reference. See the DBI documentation for a complete discussion. fetchall_hashref $hash_ref = $sth->fetchall_hashref( $key_field ); Returns a hashref containing all rows to be fetched from the statement handle. See the DBI documentation for a full discussion. finish $rv = $sth->finish; Indicates to DBI that you are finished with the statement handle and are not going to use it again. Only needed when you have not fetched all the possible rows. rows $rv = $sth->rows; Returns the number of rows affected for updates, deletes and inserts and -1 for selects. bind_col $rv = $sth->bind_col($column_number, \$var_to_bind); $rv = $sth->bind_col($column_number, \$var_to_bind, \%attr ); $rv = $sth->bind_col($column_number, \$var_to_bind, $bind_type ); Binds a Perl variable and/or some attributes to an output column of a SELECT statement. Column numbers count up from 1. You do not need to bind output columns in order to fetch data. NOTE: DBD::Oracle does not use the $bind_type to determine how to bind the column; it uses what Oracle says the data type is. You can however set the StrictlyTyped/DiscardString attributes and these will take effect as these attributes are applied after the column is retrieved. See the DBI documentation for a discussion of the optional parameters "\%attr" and $bind_type bind_columns $rv = $sth->bind_columns(@list_of_refs_to_vars_to_bind); Calls the "bind_col" method for each column in the SELECT statement, using the supplied list. dump_results $rows = $sth->dump_results($maxlen, $lsep, $fsep, $fh); Fetches all the rows from the statement handle, calls "DBI::neat_list" for each row, and prints the results to $fh (which defaults to STDOUT). Rows are separated by $lsep (which defaults to a newline). Columns are separated by $fsep (which defaults to a comma). The $maxlen controls how wide the output can be, and defaults to 35. This method is designed as a handy utility for prototyping and testing queries. Since it uses "neat_list" to format and edit the string for reading by humans, it is not recommended for data transfer applications. STATEMENT HANDLE ATTRIBUTES NUM_OF_FIELDS (integer, read-only) Returns the number of columns returned by the current statement. A number will only be returned for SELECT statements for INSERT, UPDATE, and DELETE statements which contain a RETURNING clause. This method returns undef if called before "execute()". NUM_OF_PARAMS (integer, read-only) Returns the number of placeholders in the current statement. NAME (arrayref, read-only) Returns an arrayref of column names for the current statement. This method will only work for SELECT statements, for SHOW statements, and for INSERT, UPDATE, and DELETE statements which contain a RETURNING clause. This method returns undef if called before "execute()". NAME_lc (arrayref, read-only) The same as the "NAME" attribute, except that all column names are forced to lower case. NAME_uc (arrayref, read-only) The same as the "NAME" attribute, except that all column names are forced to upper case. NAME_hash (hashref, read-only) Similar to the "NAME" attribute, but returns a hashref of column names instead of an arrayref. The names of the columns are the keys of the hash, and the values represent the order in which the columns are returned, starting at 0. This method returns undef if called before "execute()". NAME_lc_hash (hashref, read-only) The same as the "NAME_hash" attribute, except that all column names are forced to lower case. NAME_uc_hash (hashref, read-only) The same as the "NAME_hash" attribute, except that all column names are forced to lower case. TYPE (arrayref, read-only) Returns an arrayref indicating the data type for each column in the statement. This method returns undef if called before "execute()". PRECISION (arrayref, read-only) Returns an arrayref of integer values for each column returned by the statement. The number indicates the precision for "NUMERIC" columns, the size in number of characters for "CHAR" and "VARCHAR" columns, and for all other types of columns it returns the number of *bytes*. This method returns undef if called before "execute()". SCALE (arrayref, read-only) Returns an arrayref of integer values for each column returned by the statement. The number indicates the scale of the that column. The only type that will return a value is "NUMERIC". This method returns undef if called before "execute()". NULLABLE (arrayref, read-only) Returns an arrayref of integer values for each column returned by the statement. The number indicates if the column is nullable or not. 0 = not nullable, 1 = nullable, 2 = unknown. This method returns undef if called before "execute()". Database (dbh, read-only) Returns the database handle this statement handle was created from. ParamValues (hash ref, read-only) Returns a reference to a hash containing the values currently bound to placeholders. If the "named parameters" type of placeholders are being used (such as ":foo"), then the keys of the hash will be the names of the placeholders (without the colon). If the "dollar sign numbers" type of placeholders are being used, the keys of the hash will be the numbers, without the dollar signs. If the "question mark" type is used, integer numbers will be returned, starting at one and increasing for every placeholder. If this method is called before "execute", the literal values passed in are returned. If called after "execute", then the quoted versions of the values are returned. ParamTypes (hash ref, read-only) Returns a reference to a hash containing the type names currently bound to placeholders. The keys are the same as returned by the ParamValues method. The values are hashrefs containing a single key value pair, in which the key is either 'TYPE' if the type has a generic SQL equivalent, and 'pg_type' if the type can only be expressed by a Postgres type. The value is the internal number corresponding to the type originally passed in. (Placeholders that have not yet been bound will return undef as the value). This allows the output of ParamTypes to be passed back to the "bind_param" method. Statement (string, read-only) Returns the statement string passed to the most recent "prepare" method called in this database handle, even if that method failed. This is especially useful where "RaiseError" is enabled and the exception handler checks $@ and sees that a "prepare" method call failed. RowsInCache Returns the number of un-fetched rows in the cache for selects. SCROLLABLE CURSORS Oracle supports the concept of a 'Scrollable Cursor' which is defined as a 'Result Set' where the rows can be fetched either sequentially or non-sequentially. One can fetch rows forward, backwards, from any given position or the n-th row from the current position in the result set. Rows are numbered sequentially starting at one and client-side caching of the partial or entire result set can improve performance by limiting round trips to the server. Oracle does not support DML type operations with scrollable cursors so you are limited to simple 'Select' operations only. As well you can not use this functionality with remote mapped queries or if the LONG datatype is part of the select list. However, LOBSs, CLOBSs, and BLOBs do work as do all the regular bind, and fetch methods. Only use scrollable cursors if you really have a good reason to. They do use up considerable more server and client resources and have poorer response times than non-scrolling cursors. Enabling Scrollable Cursors To enable this functionality you must first import the 'Fetch Orientation' and the 'Execution Mode' constants by using; use DBD::Oracle qw(:ora_fetch_orient :ora_exe_modes); Next you will have to tell DBD::Oracle that you will be using scrolling by setting the ora_exe_mode attribute on the statement handle to 'OCI_STMT_SCROLLABLE_READONLY' with the prepare method; $sth=$dbh->prepare($SQL,{ora_exe_mode=>OCI_STMT_SCROLLABLE_READONLY}); When the statement is executed you will then be able to use 'ora_fetch_scroll' method to get a row or you can still use any of the other fetch methods but with a poorer response time than if you used a non-scrolling cursor. As well scrollable cursors are compatible with any applicable bind methods. Scrollable Cursor Methods The following driver-specific methods are used with scrollable cursors. ora_scroll_position $position = $sth->ora_scroll_position(); This method returns the current position (row number) attribute of the result set. Prior to the first fetch this value is 0. This is the only time this value will be 0 after the first fetch the value will be set, so you can use this value to test if any rows have been fetched. The minimum value will always be 1 after the first fetch. The maximum value will always be the total number of rows in the record set. ora_fetch_scroll $ary_ref = $sth->ora_fetch_scroll($fetch_orient,$fetch_offset); Works the same as "fetchrow_arrayref", excepts one passes in a 'Fetch Orientation' constant and a fetch_offset value which will then determine the row that will be fetched. It returns the row as a list containing the field values. Null fields are returned as *undef* values in the list. The valid orientation constant and fetch offset values combination are detailed below OCI_FETCH_CURRENT, fetches the current row, the fetch offset value is ignored. OCI_FETCH_NEXT, fetches the next row from the current position, the fetch offset value is ignored. OCI_FETCH_FIRST, fetches the first row, the fetch offset value is ignored. OCI_FETCH_LAST, fetches the last row, the fetch offset value is ignored. OCI_FETCH_PRIOR, fetches the previous row from the current position, the fetch offset value is ignored. OCI_FETCH_ABSOLUTE, fetches the row that is specified by the fetch offset value. OCI_FETCH_ABSOLUTE, and a fetch offset value of 1 is equivalent to a OCI_FETCH_FIRST. OCI_FETCH_ABSOLUTE, and a fetch offset value of 0 is equivalent to a OCI_FETCH_CURRENT. OCI_FETCH_RELATIVE, fetches the row relative from the current position as specified by the fetch offset value. OCI_FETCH_RELATIVE, and a fetch offset value of 0 is equivalent to a OCI_FETCH_CURRENT. OCI_FETCH_RELATIVE, and a fetch offset value of 1 is equivalent to a OCI_FETCH_NEXT. OCI_FETCH_RELATIVE, and a fetch offset value of -1 is equivalent to a OCI_FETCH_PRIOR. The effect that a ora_fetch_scroll method call has on the current_positon attribute is detailed below. OCI_FETCH_CURRENT, has no effect on the current_positon attribute. OCI_FETCH_NEXT, increments current_positon attribute by 1 OCI_FETCH_NEXT, when at the last row in the record set does not change current_positon attribute, it is equivalent to a OCI_FETCH_CURRENT OCI_FETCH_FIRST, sets the current_positon attribute to 1. OCI_FETCH_LAST, sets the current_positon attribute to the total number of rows in the record set. OCI_FETCH_PRIOR, decrements current_positon attribute by 1. OCI_FETCH_PRIOR, when at the first row in the record set does not change current_positon attribute, it is equivalent to a OCI_FETCH_CURRENT. OCI_FETCH_ABSOLUTE, sets the current_positon attribute to the fetch offset value. OCI_FETCH_ABSOLUTE, and a fetch offset value that is less than 1 does not change current_positon attribute, it is equivalent to a OCI_FETCH_CURRENT. OCI_FETCH_ABSOLUTE, and a fetch offset value that is greater than the number of records in the record set, does not change current_positon attribute, it is equivalent to a OCI_FETCH_CURRENT. OCI_FETCH_RELATIVE, sets the current_positon attribute to (current_positon attribute + fetch offset value). OCI_FETCH_RELATIVE, and a fetch offset value that makes the current position less than 1, does not change fetch offset value so it is equivalent to a OCI_FETCH_CURRENT. OCI_FETCH_RELATIVE, and a fetch offset value that makes it greater than the number of records in the record set, does not change fetch offset value so it is equivalent to a OCI_FETCH_CURRENT. The effects of the differing orientation constants on the first fetch (current_postion attribute at 0) are as follows. OCI_FETCH_CURRENT, dose not fetch a row or change the current_positon attribute. OCI_FETCH_FIRST, fetches row 1 and sets the current_positon attribute to 1. OCI_FETCH_LAST, fetches the last row in the record set and sets the current_positon attribute to the total number of rows in the record set. OCI_FETCH_NEXT, equivalent to a OCI_FETCH_FIRST. OCI_FETCH_PRIOR, equivalent to a OCI_FETCH_CURRENT. OCI_FETCH_ABSOLUTE, and a fetch offset value that is less than 1 is equivalent to a OCI_FETCH_CURRENT. OCI_FETCH_ABSOLUTE, and a fetch offset value that is greater than the number of records in the record set is equivalent to a OCI_FETCH_CURRENT. OCI_FETCH_RELATIVE, and a fetch offset value that is less than 1 is equivalent to a OCI_FETCH_CURRENT. OCI_FETCH_RELATIVE, and a fetch offset value that makes it greater than the number of records in the record set, is equivalent to a OCI_FETCH_CURRENT. Scrollable Cursor Usage Given a simple code like this: use DBI; use DBD::Oracle qw(:ora_types :ora_fetch_orient :ora_exe_modes); my $dbh = DBI->connect($dsn, $dbuser, ''); my $SQL = "select id, first_name, last_name from employee"; my $sth=$dbh->prepare($SQL,{ora_exe_mode=>OCI_STMT_SCROLLABLE_READONLY}); $sth->execute(); my $value; and one assumes that the number of rows returned from the query is 20, the code snippets below will illustrate the use of ora_fetch_scroll method; Fetching the Last Row $value = $sth->ora_fetch_scroll(OCI_FETCH_LAST,0); print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n"; print "current scroll position=".$sth->ora_scroll_position()."\n"; The current_positon attribute to will be 20 after this snippet. This is also a way to get the number of rows in the record set, however, if the record set is large this could take some time. Fetching the Current Row $value = $sth->ora_fetch_scroll(OCI_FETCH_CURRENT,0); print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n"; print "current scroll position=".$sth->ora_scroll_position()."\n"; The current_positon attribute will still be 20 after this snippet. Fetching the First Row $value = $sth->ora_fetch_scroll(OCI_FETCH_FIRST,0); print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n"; print "current scroll position=".$sth->ora_scroll_position()."\n"; The current_positon attribute will be 1 after this snippet. Fetching the Next Row for(my $i=0;$i<=3;$i++){ $value = $sth->ora_fetch_scroll(OCI_FETCH_NEXT,0); print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n"; } print "current scroll position=".$sth->ora_scroll_position()."\n"; The current_positon attribute will be 5 after this snippet. Fetching the Prior Row for(my $i=0;$i<=3;$i++){ $value = $sth->ora_fetch_scroll(OCI_FETCH_PRIOR,0); print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n"; } print "current scroll position=".$sth->ora_scroll_position()."\n"; The current_positon attribute will be 1 after this snippet. Fetching the 10th Row $value = $sth->ora_fetch_scroll(OCI_FETCH_ABSOLUTE,10); print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n"; print "current scroll position=".$sth->ora_scroll_position()."\n"; The current_positon attribute will be 10 after this snippet. Fetching the 10th to 14th Row for(my $i=10;$i<15;$i++){ $value = $sth->ora_fetch_scroll(OCI_FETCH_ABSOLUTE,$i); print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n"; } print "current scroll position=".$sth->ora_scroll_position()."\n"; The current_positon attribute will be 14 after this snippet. Fetching the 14th to 10th Row for(my $i=14;$i>9;$i--){ $value = $sth->ora_fetch_scroll(OCI_FETCH_ABSOLUTE,$i); print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n"; } print "current scroll position=".$sth->ora_scroll_position()."\n"; The current_positon attribute will be 10 after this snippet. Fetching the 5th Row From the Present Position. $value = $sth->ora_fetch_scroll(OCI_FETCH_RELATIVE,5); print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n"; print "current scroll position=".$sth->ora_scroll_position()."\n"; The current_positon attribute will be 15 after this snippet. Fetching the 9th Row Prior From the Present Position $value = $sth->ora_fetch_scroll(OCI_FETCH_RELATIVE,-9); print "id=".$value->[0].", First Name=".$value->[1].", Last Name=".$value->[2]."\n"; print "current scroll position=".$sth->ora_scroll_position()."\n"; The current_positon attribute will be 6 after this snippet. Use Finish $sth->finish(); When using scrollable cursors it is required that you use the $sth->finish() method when you are done with the cursor as this type of cursor has to be explicitly cancelled on the server. If you do not do this you may cause resource problems on your database. LOBS AND LONGS The key to working with LOBs (CLOB, BLOBs) is to remember the value of an Oracle LOB column is not the content of the LOB. It's a 'LOB Locator' which, after being selected or inserted needs extra processing to read or write the content of the LOB. There are also legacy LONG types (LONG, LONG RAW, VARCHAR2) which are presently deprecated by Oracle but are still in use. These LONG types do not utilize a 'LOB Locator' and also are more limited in functionality than CLOB or BLOB fields. DBD::Oracle now offers three interfaces to LOB and LONG data, "Data Interface for Persistent LOBs" With this interface DBD::Oracle handles your data directly utilizing regular OCI calls, Oracle itself takes care of the LOB Locator operations in the case of BLOBs and CLOBs treating them exactly as if they were the same as the legacy LONG or LONG RAW types. "Data Interface for LOB Locators" With this interface DBD::Oracle handles your data utilizing LOB Locator OCI calls so it only works with CLOB and BLOB datatypes. With this interface DBD::Oracle takes care of the LOB Locator operations for you. "LOB Locator Method Interface" This allows the user direct access to the LOB Locator methods, so you have to take case of the LOB Locator operations yourself. Generally speaking the interface that you will chose will be dependent on what end you are trying to achieve. All have their benefits and drawbacks. One point to remember when working with LOBs (CLOBs, BLOBs) is if your LOB column can be in one of three states; NULL The table cell is created, but the cell holds no locator or value. If your LOB field is in this state then there is no LOB Locator that DBD::Oracle can work so if your encounter a DBD::Oracle::db::ora_lob_read: locator is not of type OCILobLocatorPtr error when working with a LOB. You can correct this by using an SQL UPDATE statement to reset the LOB column to a non-NULL (or empty LOB) value with either EMPTY_BLOB or EMPTY_CLOB as in this example; UPDATE lob_example SET bindata=EMPTY_BLOB() WHERE bindata IS NULL. Empty A LOB instance with a locator exists in the cell, but it has no value. The length of the LOB is zero. In this case DBD::Oracle will return 'undef' for the field. Populated A LOB instance with a locator and a value exists in the cell. You actually get the LOB value. Data Interface for Persistent LOBs This is the original interface for LONG and LONG RAW datatypes and from Oracle 9iR1 and later the OCI API was extended to work directly with the other LOB datatypes. In other words you can treat all LOB type data (BLOB, CLOB) as if it was a LONG, LONG RAW, or VARCHAR2. So you can perform INSERT, UPDATE, fetch, bind, and define operations on LOBs using the same techniques you would use on other datatypes that store character or binary data. In some cases there are fewer round trips to the server as no 'LOB Locators' are used, normally one can get an entire LOB is a single round trip. Simple Fetch for LONGs and LONG RAWs As the name implies this is the simplest way to use this interface. DBD::Oracle just attempts to get your LONG datatypes as a single large piece. There are no special settings, simply set the database handle's 'LongReadLen' attribute to a value that will be the larger than the expected size of the LONG or LONG RAW. If the size of the LONG or LONG RAW exceeds the 'LongReadLen' DBD::Oracle will return a 'ORA-24345: A Truncation' error. To stop this set the database handle's 'LongTruncOk' attribute to '1'. The maximum value of 'LongReadLen' seems to be dependent on the physical memory limits of the box that Oracle is running on. You have most likely reached this limit if you run into an 'ORA-01062: unable to allocate memory for define buffer' error. One solution is to set the size of 'LongReadLen' to a lower value. For example give this table; CREATE TABLE test_long ( id NUMBER, long1 long) this code; $dbh->{LongReadLen} = 2*1024*1024; #2 meg $SQL='select p_id,long1 from test_long'; $sth=$dbh->prepare($SQL); $sth->execute(); while (my ( $p_id,$long )=$sth->fetchrow()){ print "p_id=".$p_id."\n"; print "long=".$long."\n"; } Will select out all of the long1 fields in the table as long as they are all under 2MB in length. A value in long1 longer than this will throw an error. Adding this line; $dbh->{LongTruncOk}=1; before the execute will return all the long1 fields but they will be truncated at 2MBs. Using ora_ncs_buff_mtpl When getting CLOBs and NCLOBs in or out of Oracle, the Server will translate from the Server's NCharSet to the Client's. If they happen to be the same or at least compatible then all of these actions are a 1 char to 1 char bases. Thus if you set your LongReadLen buffer to 10_000_000 you will get up to 10_000_000 char. However if the Server has to translate from one NCharSet to another it will use bytes for conversion. The buffer value is set to 4 * LONG_READ_LEN which was very wasteful as you might only be asking for 10_000_000 bytes but you were actually using 40_000_000 bytes of buffer under the hood. You would still get 10_000_000 bytes (maybe less characters though) but you are using allot more memory that you need. You can now customize the size of the buffer by setting the 'ora_ncs_buff_mtpl' either on the connection or statement handle. You can also set this as 'ORA_DBD_NCS_BUFFER' OS environment variable so you will have to go back and change all your code if you are getting into trouble. The default value is still set to 4 for backward compatibility. You can lower this value and thus increase the amount of data you can retrieve. If the ora_ncs_buff_mtpl is too small DBD::Oracle will throw and error telling you to increase this buffer by one. If the error is not captured then you may get at some random point later on, usually at a finish() or disconnect() or even a fetch() this error; ORA-03127: no new operations allowed until the active operation ends This is one of the more obscure ORA errors (have some fun and report it to Meta-Link they will scratch their heads for hours) If you get this, simply increment the ora_ncs_buff_mtpl by one until it goes away. This should greatly increase your ability to select very large CLOBs or NCLOBs, by freeing up a large block of memory. You can tune this value by setting ora_oci_success_warn which will display the following OCILobRead field 2 of 3 SUCCESS: csform 1 (SQLCS_IMPLICIT), LOBlen 10240(characters), LongReadLen 20(characters), BufLen 80(characters), Got 28(characters) In the case above the query Got 28 characters (well really only 20 characters of 28 bytes) so we could use ora_ncs_buff_mtpl=>2 (20*2=40) thus saving 40bytes of memory. Simple Fetch for CLOBs and BLOBs To use this interface for CLOBs and LOBs datatypes set the 'ora_pers_lob' attribute of the statement handle to '1' with the prepare method, as well set the database handle's 'LongReadLen' attribute to a value that will be the larger than the expected size of the LOB. If the size of the LOB exceeds the 'LongReadLen' DBD::Oracle will return a 'ORA-24345: A Truncation' error. To stop this set the database handle's 'LongTruncOk' attribute to '1'. The maximum value of 'LongReadLen' seems to be dependent on the physical memory limits of the box that Oracle is running on in the same way that LONGs and LONG RAWs are. For CLOBs and NCLOBs the limit is 64k chars if there is no truncation, this is an internal OCI limit complain to them if you want it changed. However if you CLOB is longer than this and also larger than the 'LongReadLen' than the 'LongReadLen' in chars is returned. It seems with BLOBs you are not limited by the 64k. For example give this table; CREATE TABLE test_lob (id NUMBER, clob1 CLOB, clob2 CLOB, blob1 BLOB, blob2 BLOB) this code; $dbh->{LongReadLen} = 2*1024*1024; #2 meg $SQL='select p_id,lob_1,lob_2,blob_2 from test_lobs'; $sth=$dbh->prepare($SQL,{ora_pers_lob=>1}); $sth->execute(); while (my ( $p_id,$log,$log2,$log3,$log4 )=$sth->fetchrow()){ print "p_id=".$p_id."\n"; print "clob1=".$clob1."\n"; print "clob2=".$clob2."\n"; print "blob1=".$blob2."\n"; print "blob2=".$blob2."\n"; } Will select out all of the LOBs in the table as long as they are all under 2MB in length. Longer lobs will throw an error. Adding this line; $dbh->{LongTruncOk}=1; before the execute will return all the lobs but they will be truncated at 2MBs. Piecewise Fetch with Callback With a piecewise callback fetch DBD::Oracle sets up a function that will 'callback' to the DB during the fetch and gets your LOB (LONG, LONG RAW, CLOB, BLOB) piece by piece. To use this interface set the 'ora_clbk_lob' attribute of the statement handle to '1' with the prepare method. Next set the 'ora_piece_size' to the size of the piece that you want to return on the callback. Finally set the database handle's 'LongReadLen' attribute to a value that will be the larger than the expected size of the LOB. Like the "Simple Fetch for LONGs and LONG RAWs" and "Simple Fetch for CLOBs and BLOBs" the if the size of the LOB exceeds the is 'LongReadLen' you can use the 'LongTruncOk' attribute to truncate the LOB or set the 'LongReadLen' to a higher value. With this interface the value of 'ora_piece_size' seems to be constrained by the same memory limit as found on the Simple Fetch interface. If you encounter an 'ORA-01062' error try setting the value of 'ora_piece_size' to a smaller value. The value for 'LongReadLen' is dependent on the version and settings of the Oracle DB you are using. In theory it ranges from 8GBs in 9iR1 up to 128 terabytes with 11g but you will also be limited by the physical memory of your PERL instance. Using the table from the last example this code; $dbh->{LongReadLen} = 20*1024*1024; #20 meg $SQL='select p_id,lob_1,lob_2,blob_2 from test_lobs'; $sth=$dbh->prepare($SQL,{ora_clbk_lob=>1,ora_piece_size=>5*1024*1024}); $sth->execute(); while (my ( $p_id,$log,$log2,$log3,$log4 )=$sth->fetchrow()){ print "p_id=".$p_id."\n"; print "clob1=".$clob1."\n"; print "clob2=".$clob2."\n"; print "blob1=".$blob2."\n"; print "blob2=".$blob2."\n"; } Will select out all of the LOBs in the table as long as they are all under 20MB in length. If the LOB is longer than 5MB (ora_piece_size) DBD::Oracle will fetch it in at least 2 pieces to a maximum of 4 pieces (4*5MB=20MB). Like the Simple Fetch examples Lobs longer than 20MB will throw an error. Using the table from the first example (LONG) this code; $dbh->{LongReadLen} = 20*1024*1024; #2 meg $SQL='select p_id,long1 from test_long'; $sth=$dbh->prepare($SQL,{ora_clbk_lob=>1,ora_piece_size=>5*1024*1024}); $sth->execute(); while (my ( $p_id,$long )=$sth->fetchrow()){ print "p_id=".$p_id."\n"; print "long=".$long."\n"; } Will select all of the long1 fields from table as long as they are is under 20MB in length. If the long1 filed is longer than 5MB (ora_piece_size) DBD::Oracle will fetch it in at least 2 pieces to a maximum of 4 pieces (4*5MB=20MB). Like the other examples long1 fields longer than 20MB will throw an error. Piecewise Fetch with Polling With a polling piecewise fetch DBD::Oracle iterates (Polls) over the LOB during the fetch getting your LOB (LONG, LONG RAW, CLOB, BLOB) piece by piece. To use this interface set the 'ora_piece_lob' attribute of the statement handle to '1' with the prepare method. Next set the 'ora_piece_size' to the size of the piece that you want to return on the callback. Finally set the database handle's 'LongReadLen' attribute to a value that will be the larger than the expected size of the LOB. Like the "Piecewise Fetch with Callback" and Simple Fetches if the size of the LOB exceeds the is 'LongReadLen' you can use the 'LongTruncOk' attribute to truncate the LOB or set the 'LongReadLen' to a higher value. With this interface the value of 'ora_piece_size' seems to be constrained by the same memory limit as found on the "Piecewise Fetch with Callback". Using the table from the example above this code; $dbh->{LongReadLen} = 20*1024*1024; #20 meg $SQL='select p_id,lob_1,lob_2,blob_2 from test_lobs'; $sth=$dbh->prepare($SQL,{ora_piece_lob=>1,ora_piece_size=>5*1024*1024}); $sth->execute(); while (my ( $p_id,$log,$log2,$log3,$log4 )=$sth->fetchrow()){ print "p_id=".$p_id."\n"; print "clob1=".$clob1."\n"; print "clob2=".$clob2."\n"; print "blob1=".$blob2."\n"; print "blob2=".$blob2."\n"; } Will select out all of the LOBs in the table as long as they are all under 20MB in length. If the LOB is longer than 5MB (ora_piece_size) DBD::Oracle will fetch it in at least 2 pieces to a maximum of 4 pieces (4*5MB=20MB). Like the other fetch methods LOBs longer than 20MB will throw an error. Finally with this code; $dbh->{LongReadLen} = 20*1024*1024; #2 meg $SQL='select p_id,long1 from test_long'; $sth=$dbh->prepare($SQL,{ora_piece_lob=>1,ora_piece_size=>5*1024*1024}); $sth->execute(); while (my ( $p_id,$long )=$sth->fetchrow()){ print "p_id=".$p_id."\n"; print "long=".$long."\n"; } Will select all of the long1 fields from table as long as they are is under 20MB in length. If the long1 field is longer than 5MB (ora_piece_size) DBD::Oracle will fetch it in at least 2 pieces to a maximum of 4 pieces (4*5MB=20MB). Like the other examples long1 fields longer than 20MB will throw an error. Binding for Updates and Inserts for CLOBs and BLOBs To bind for updates and inserts all that is required to use this interface is to set the statement handle's prepare method 'ora_type' attribute to 'SQLT_CHR' in the case of CLOBs and NCLOBs or 'SQLT_BIN' in the case of BLOBs as in this example for an insert; my $in_clob = "\n"; $in_clob .= " $_\n" for 1 .. 10_000; $in_clob .= "\n"; my $in_blob ="0101" for 1 .. 10_000; $SQL='insert into test_lob3@tpgtest (id,clob1,clob2, blob1,blob2) values(?,?,?,?,?)'; $sth=$dbh->prepare($SQL ); $sth->bind_param(1,3); $sth->bind_param(2,$in_clob,{ora_type=>SQLT_CHR}); $sth->bind_param(3,$in_clob,{ora_type=>SQLT_CHR}); $sth->bind_param(4,$in_blob,{ora_type=>SQLT_BIN}); $sth->bind_param(5,$in_blob,{ora_type=>SQLT_BIN}); $sth->execute(); So far the only limit reached with this form of insert is the LOBs must be under 2GB in size. Support for Remote LOBs; Starting with Oracle 10gR2 the interface for Persistent LOBs was expanded to support remote LOBs (access over a dblink). Given a database called 'lob_test' that has a 'LINK' defined like this; CREATE DATABASE LINK link_test CONNECT TO test_lobs IDENTIFIED BY tester USING 'lob_test'; to a remote database called 'test_lobs', the following code will work; $dbh = DBI->connect('dbi:Oracle:','test@lob_test','test'); $dbh->{LongReadLen} = 2*1024*1024; #2 meg $SQL='select p_id,lob_1,lob_2,blob_2 from test_lobs@link_test'; $sth=$dbh->prepare($SQL,{ora_pers_lob=>1}); $sth->execute(); while (my ( $p_id,$log,$log2,$log3,$log4 )=$sth->fetchrow()){ print "p_id=".$p_id."\n"; print "clob1=".$clob1."\n"; print "clob2=".$clob2."\n"; print "blob1=".$blob2."\n"; print "blob2=".$blob2."\n"; } Below are the limitations of Remote LOBs; Queries involving more than one database are not supported; so the following returns an error: SELECT t1.lobcol, a2.lobcol FROM t1, t2.lobcol@dbs2 a2 W WHERE LENGTH(t1.lobcol) = LENGTH(a2.lobcol); as does: SELECT t1.lobcol FROM t1@dbs1 UNION ALL SELECT t2.lobcol FROM t2@dbs2; DDL commands are not supported; so the following returns an error: CREATE VIEW v AS SELECT lob_col FROM tab@dbs; Only binds and defines for data going into remote persistent LOBs are supported. so that parameter passing in PL/SQL where CHAR data is bound or defined for remote LOBs is not allowed . These statements all produce errors: SELECT foo() FROM table1@dbs2; SELECT foo()@dbs INTO char_val FROM DUAL; SELECT XMLType().getclobval FROM table1@dbs2; If the remote object is a view such as CREATE VIEW v AS SELECT foo() FROM ... the following would not work: SELECT * FROM v@dbs2; Limited PL/SQL parameter passing PL/SQL parameter passing is not allowed where the actual argument is a LOB type and the remote argument is one of VARCHAR2, NVARCHAR2, CHAR, NCHAR, or RAW. RETURNING INTO does not support implicit conversions between CHAR and CLOB. so the following returns an error: SELECT t1.lobcol as test, a2.lobcol FROM t1, t2.lobcol@dbs2 a2 RETURNING test Locator Data Interface Simple Usage When fetching LOBs with this interface a 'LOB Locator' is created then used to get the lob with the LongReadLen and LongTruncOk attributes. The value for 'LongReadLen' is dependent on the version and settings of the Oracle DB you are using. In theory it ranges from 8GBs in 9iR1 up to 128 terabytes with 11g but you will also be limited by the physical memory of your PERL instance. When inserting or updating LOBs some *major* magic has to be performed behind the scenes to make it transparent. Basically the driver has to insert a 'LOB Locator' and then refetch the newly inserted LOB Locator before being able to write the data into it. However, it works well most of the time, and I've made it as fast as possible, just one extra server-round-trip per insert or update after the first. For the time being, only single-row LOB updates are supported. To insert or update a large LOB using a placeholder, DBD::Oracle has to know in advance that it is a LOB type. So you need to say: $sth->bind_param($field_num, $lob_value, { ora_type => ORA_CLOB }); The ORA_CLOB and ORA_BLOB constants can be imported using use DBD::Oracle qw(:ora_types); or use the corresponding integer values (112 and 113). One further wrinkle: for inserts and updates of LOBs, DBD::Oracle has to be able to tell which parameters relate to which table fields. In all cases where it can possibly work it out for itself, it does, however, if there are multiple LOB fields of the same type in the table then you need to tell it which field each LOB param relates to: $sth->bind_param($idx, $value, { ora_type=>ORA_CLOB, ora_field=>'foo' }); There are some limitations inherent in the way DBD::Oracle makes typical LOB operations simple by hiding the LOB Locator processing: - Can't read/write LOBs in chunks (except via DBMS_LOB.WRITEAPPEND in PL/SQL) - To INSERT a LOB, you need UPDATE privilege. The alternative is to disable the automatic LOB Locator processing. If "ora_auto_lob" is 0 in prepare(), you can fetch the LOB Locators and do all the work yourself using the ora_lob_*() methods. See the "Data Interface for LOB Locators" section below. LOB support in PL/SQL LOB Locators can be passed to PL/SQL calls by binding them to placeholders with the proper "ora_type". If "ora_auto_lob" is true, output LOB parameters will be automatically returned as strings. If the Oracle driver has support for temporary LOBs (Oracle 9i and higher), strings can be bound to input LOB placeholders and will be automatically converted to LOBs. Example: # Build a large XML document, bind it as a CLOB, # extract elements through PL/SQL and return as a CLOB # $dbh is a connected database handle # output will be large local $dbh->{LongReadLen} = 1_000_000; my $in_clob = "\n"; $in_clob .= " $_\n" for 1 .. 10_000; $in_clob .= "\n"; my $out_clob; my $sth = $dbh->prepare(<bind_param( ':in', $in_clob, { ora_type => ORA_CLOB } ); $sth->bind_param_inout( ':out', \$out_clob, 0, { ora_type => ORA_CLOB } ); $sth->execute; If you ever get an ORA-01691 unable to extend lob segment sss.ggg by nnn in tablespace ttt error, while attempting to insert a LOB, this means the Oracle user has insufficient space for LOB you are trying to insert. One solution it to use "alter database datafile 'sss.ggg' resize Mnnn" to increase the available memory for LOBs. Persistent & Locator Interface Caveats Now that one has the option of using the Persistent or the Locator interface for LOBs the questions arises which one to use. For starters, if you want to access LOBs over a dblink you will have to use the Persistent interface so that choice is simple. The question of which one to use after that is a little more tricky. It basically boils down to a choice between LOB size and speed. The Callback and Polling piecewise fetches are very very slow when compared to the Simple and the Locator fetches but they can handle very large blocks of data. Given a situation where a large LOB is to be read the Locator fetch may time out while either of the piecewise fetches may not. With the Simple fetch you are limited by physical memory of your server but it runs a little faster than the Locator, as there are fewer round trips to the server. So if you have small LOBs and need to save a little bandwidth this is the one to use. It you are going after large LOBs then the Locator interface is the one to use. If you need to update more than a single row of with LOB data then the Persistent interface can do it while the Locator can't. If you encounter a situation where you have to access the legacy LOBs (LONG, LONG RAW) and the values are to large for you system then you can use the Callback or Polling piecewise fetches to get all of the data. Not all of the Persistent interface has been implemented yet, the following are not supported; 1) Piecewise, polling and callback binds for INSERT and UPDATE operations. 2) Piecewise array binds for SELECT, INSERT and UPDATE operations. Most of the time you should just use the "Locator Data Interface" as this is in one that has the best combination of speed and size. All this being said if you are doing some critical programming I would use the "Data Interface for LOB Locators" as this gives you very fine grain control of your LOBs, of course the code for this will be somewhat more involved. Data Interface for LOB Locators The following driver-specific methods let you manipulate "LOB Locators" directly. To select a LOB locator directly set the if the "ora_auto_lob" attribute to false, or alternatively they can be returned via PL/SQL procedure calls. (If using a DBI version earlier than 1.36 they must be called via the func() method. Note that methods called via func() don't honour RaiseError etc, and so it's important to check $dbh->err after each call. It's recommended that you upgrade to DBI 1.38 or later.) Note that LOB locators are only valid while the statement handle that created them is valid. When all references to the original statement handle are lost, the handle is destroyed and the locators are freed. ora_lob_read $data = $dbh->ora_lob_read($lob_locator, $offset, $length); Read a portion of the LOB. $offset starts at 1. Uses the Oracle OCILobRead function. NOTE: DBD::Oracle post 1.46 will return undef for any read lob if the length specified in the ora_lob_read is 0. See RT 55028. This avoids the potential problem with empty lobs (created with empty_clob) which return a length of 0 from ora_lob_length and prior to 1.46 a call to ora_lob_read with a 0 length would segfault. ora_lob_write $rc = $dbh->ora_lob_write($lob_locator, $offset, $data); Write/overwrite a portion of the LOB. $offset starts at 1. Uses the Oracle OCILobWrite function. ora_lob_append $rc = $dbh->ora_lob_append($lob_locator, $data); Append $data to the LOB. Uses the Oracle OCILobWriteAppend function. ora_lob_trim $rc = $dbh->ora_lob_trim($lob_locator, $length); Trims the length of the LOB to $length. Uses the Oracle OCILobTrim function. ora_lob_length $length = $dbh->ora_lob_length($lob_locator); Returns the length of the LOB. Uses the Oracle OCILobGetLength function. ora_lob_is_init $is_init = $dbh->ora_lob_is_init($lob_locator); Returns true(1) if the Lob Locator is initialized false(0) if it is not, or 'undef' if there is an error. Uses the Oracle OCILobLocatorIsInit function. ora_lob_chunk_size $chunk_size = $dbh->ora_lob_chunk_size($lob_locator); Returns the chunk size of the LOB. Uses the Oracle OCILobGetChunkSize function. For optimal performance, Oracle recommends reading from and writing to a LOB in batches using a multiple of the LOB chunk size. In Oracle 10g and before, when all defaults are in place, this chunk size defaults to 8k (8192). LOB Locator Method Examples *Note:* Make sure you first read the note in the section above about multi-byte character set issues with these methods. The following examples demonstrate the usage of LOB Locators to read, write, and append data, and to query the size of large data. The following examples assume a table containing two large object columns, one binary and one character, with a primary key column, defined as follows: CREATE TABLE lob_example ( lob_id INTEGER PRIMARY KEY, bindata BLOB, chardata CLOB ) It also assumes a sequence for use in generating unique lob_id field values, defined as follows: CREATE SEQUENCE lob_example_seq Example: Inserting a new row with large data Unless enough memory is available to store and bind the entire LOB data for insert all at once, the LOB columns must be written interactively, piece by piece. In the case of a new row, this is performed by first inserting a row, with empty values in the LOB columns, then modifying the row by writing the large data interactively to the LOB columns using their LOB locators as handles. The insert statement must create token values in the LOB columns. Here, we use the empty string for both the binary and character large object columns 'bindata' and 'chardata'. After the INSERT statement, a SELECT statement is used to acquire LOB locators to the 'bindata' and 'chardata' fields of the newly inserted row. Because these LOB locators are subsequently written, they must be acquired from a select statement containing the clause 'FOR UPDATE' (LOB locators are only valid within the transaction that fetched them, so can't be used effectively if AutoCommit is enabled). my $lob_id = $dbh->selectrow_array( <<" SQL" ); SELECT lob_example_seq.nextval FROM DUAL SQL my $sth = $dbh->prepare( <<" SQL" ); INSERT INTO lob_example ( lob_id, bindata, chardata ) VALUES ( ?, EMPTY_BLOB(),EMPTY_CLOB() ) SQL $sth->execute( $lob_id ); $sth = $dbh->prepare( <<" SQL", { ora_auto_lob => 0 } ); SELECT bindata, chardata FROM lob_example WHERE lob_id = ? FOR UPDATE SQL $sth->execute( $lob_id ); my ( $bin_locator, $char_locator ) = $sth->fetchrow_array(); $sth->finish(); open BIN_FH, "/binary/data/source" or die; open CHAR_FH, "/character/data/source" or die; my $chunk_size = $dbh->ora_lob_chunk_size( $bin_locator ); # BEGIN WRITING BIN_DATA COLUMN my $offset = 1; # Offsets start at 1, not 0 my $length = 0; my $buffer = ''; while( $length = read( BIN_FH, $buffer, $chunk_size ) ) { $dbh->ora_lob_write( $bin_locator, $offset, $buffer ); $offset += $length; } # BEGIN WRITING CHAR_DATA COLUMN $chunk_size = $dbh->ora_lob_chunk_size( $char_locator ); $offset = 1; # Offsets start at 1, not 0 $length = 0; $buffer = ''; while( $length = read( CHAR_FH, $buffer, $chunk_size ) ) { $dbh->ora_lob_write( $char_locator, $offset, $buffer ); $offset += $length; } In this example we demonstrate the use of ora_lob_write() interactively to append data to the columns 'bin_data' and 'char_data'. Had we used ora_lob_append(), we could have saved ourselves the trouble of keeping track of the offset into the lobs. The snippet of code beneath the comment 'BEGIN WRITING BIN_DATA COLUMN' could look as follows: my $buffer = ''; while ( read( BIN_FH, $buffer, $chunk_size ) ) { $dbh->ora_lob_append( $bin_locator, $buffer ); } The scalar variables $offset and $length are no longer needed, because ora_lob_append() keeps track of the offset for us. Example: Updating an existing row with large data In this example, we demonstrate a technique for overwriting a portion of a blob field with new binary data. The blob data before and after the section overwritten remains unchanged. Hence, this technique could be used for updating fixed length subfields embedded in a binary field. my $lob_id = 5; # Arbitrary row identifier, for example $sth = $dbh->prepare( <<" SQL", { ora_auto_lob => 0 } ); SELECT bindata FROM lob_example WHERE lob_id = ? FOR UPDATE SQL $sth->execute( $lob_id ); my ( $bin_locator ) = $sth->fetchrow_array(); my $offset = 100234; my $data = "This string will overwrite a portion of the blob"; $dbh->ora_lob_write( $bin_locator, $offset, $data ); After running this code, the row where lob_id = 5 will contain, starting at position 100234 in the bin_data column, the string "This string will overwrite a portion of the blob". Example: Streaming character data from the database In this example, we demonstrate a technique for streaming data from the database to a file handle, in this case STDOUT. This allows more data to be read in and written out than could be stored in memory at a given time. my $lob_id = 17; # Arbitrary row identifier, for example $sth = $dbh->prepare( <<" SQL", { ora_auto_lob => 0 } ); SELECT chardata FROM lob_example WHERE lob_id = ? SQL $sth->execute( $lob_id ); my ( $char_locator ) = $sth->fetchrow_array(); my $chunk_size = 1034; # Arbitrary chunk size, for example my $offset = 1; # Offsets start at 1, not 0 while(1) { my $data = $dbh->ora_lob_read( $char_locator, $offset, $chunk_size ); last unless length $data; print STDOUT $data; $offset += $chunk_size; } Notice that the select statement does not contain the phrase "FOR UPDATE". Because we are only reading from the LOB Locator returned, and not modifying the LOB it refers to, the select statement does not require the "FOR UPDATE" clause. A word of caution when using the data returned from an ora_lob_read in a conditional statement. for example if the code below; while( my $data = $dbh->ora_lob_read( $char_locator, $offset, $chunk_size ) ) { print STDOUT $data; $offset += $chunk_size; } was used with a chunk size of 4096 against a blob that requires more than 1 chunk to return the data and the last chunk is one byte long and contains a zero (ASCII 48) you will miss this last byte as $data will contain 0 which PERL will see as false and not print it out. Example: Truncating existing large data In this example, we truncate the data already present in a large object column in the database. Specifically, for each row in the table, we truncate the 'bindata' value to half its previous length. After acquiring a LOB Locator for the column, we query its length, then we trim the length by half. Because we modify the large objects with the call to ora_lob_trim(), we must select the LOB locators 'FOR UPDATE'. my $sth = $dbh->prepare( <<" SQL", { ora_auto_lob => 0 } ); SELECT bindata FROM lob_example FOR UPATE SQL $sth->execute(); while( my ( $bin_locator ) = $sth->fetchrow_array() ) { my $binlength = $dbh->ora_lob_length( $bin_locator ); if( $binlength > 0 ) { $dbh->ora_lob_trim( $bin_locator, $binlength/2 ); } } SPACES AND PADDING Trailing Spaces Only the Oracle OCI 8 strips trailing spaces from VARCHAR placeholder values and uses Nonpadded Comparison Semantics with the result. This causes trouble if the spaces are needed for comparison with a CHAR value or to prevent the value from becoming '' which Oracle treats as NULL. Look for Blank-padded Comparison Semantics and Nonpadded Comparison Semantics in Oracle's SQL Reference or Server SQL Reference for more details. To preserve trailing spaces in placeholder values for Oracle clients that use OCI 8, either change the default placeholder type with "ora_ph_type" or the placeholder type for a particular call to "bind" in DBI or "bind_param_inout" in DBI with "ora_type" or "TYPE". Using ORA_CHAR with ora_type or "SQL_CHAR" with "TYPE" allows the placeholder to be used with Padded Comparison Semantics if the value it is being compared to is a CHAR, NCHAR, or literal. Please remember that using spaces as a value or at the end of a value makes visually distinguishing values with different numbers of spaces difficult and should be avoided. Oracle Clients that use OCI 9.2 do not strip trailing spaces. Padded Char Fields Oracle Clients after OCI 9.2 will automatically pad CHAR placeholder values to the size of the CHAR. As the default placeholder type value in DBD::Oracle is ORA_VARCHAR2 to access this behaviour you will have to change the default placeholder type with "ora_ph_type" or placeholder type for a particular call with "bind" in DBI or "bind_param_inout" in DBI with "ORA_CHAR". UNICODE DBD::Oracle now supports Unicode UTF-8. There are, however, a number of issues you should be aware of, so please read all this section carefully. In this section we'll discuss "Perl and Unicode", then "Oracle and Unicode", and finally "DBD::Oracle and Unicode". Information about Unicode in general can be found at: . It is well worth reading because there are many misconceptions about Unicode and you may be holding some of them. Perl and Unicode Perl began implementing Unicode with version 5.6, but the implementation did not mature until version 5.8 and later. If you plan to use Unicode you are *strongly* urged to use Perl 5.8.2 or later and to *carefully* read the Perl documentation on Unicode: perldoc perluniintro # in Perl 5.8 or later perldoc perlunicode And then read it again. Perl's internal Unicode format is UTF-8 which corresponds to the Oracle character set called AL32UTF8. Oracle and Unicode Oracle supports many characters sets, including several different forms of Unicode. These include: AL16UTF16 => valid for NCHAR columns (CSID=2000) UTF8 => valid for NCHAR columns (CSID=871), deprecated AL32UTF8 => valid for NCHAR and CHAR columns (CSID=873) When you create an Oracle database, you must specify the DATABASE character set (used for DDL, DML and CHAR datatypes) and the NATIONAL character set (used for NCHAR and NCLOB types). The character sets used in your database can be found using: $hash_ref = $dbh->ora_nls_parameters() $database_charset = $hash_ref->{NLS_CHARACTERSET}; $national_charset = $hash_ref->{NLS_NCHAR_CHARACTERSET}; The Oracle 9.2 and later default for the national character set is AL16UTF16. The default for the database character set is often US7ASCII. Although many experienced DBAs will consider an 8bit character set like WE8ISO8859P1 or WE8MSWIN1252. To use any character set with Oracle other than US7ASCII, requires that the NLS_LANG environment variable be set. See the "Oracle UTF8 is not UTF-8" section below. You are strongly urged to read the Oracle Internationalization documentation specifically with respect the choices and trade offs for creating a databases for use with international character sets. Oracle uses the NLS_LANG environment variable to indicate what character set is being used on the client. When fetching data Oracle will convert from whatever the database character set is to the client character set specified by NLS_LANG. Similarly, when sending data to the database Oracle will convert from the character set specified by NLS_LANG to the database character set. The NLS_NCHAR environment variable can be used to define a different character set for 'national' (NCHAR) character types. Both UTF8 and AL32UTF8 can be used in NLS_LANG and NLS_NCHAR. For example: NLS_LANG=AMERICAN_AMERICA.UTF8 NLS_LANG=AMERICAN_AMERICA.AL32UTF8 NLS_NCHAR=UTF8 NLS_NCHAR=AL32UTF8 Oracle UTF8 is not UTF-8 AL32UTF8 should be used in preference to UTF8 if it works for you, which it should for Oracle 9.2 or later. If you're using an old version of Oracle that doesn't support AL32UTF8 then you should avoid using any Unicode characters that require surrogates, in other words characters beyond the Unicode BMP (Basic Multilingual Plane). That's because the character set that Oracle calls "UTF8" doesn't conform to the UTF-8 standard in its handling of surrogate characters. Technically the encoding that Oracle calls "UTF8" is known as "CESU-8". Here are a couple of extracts from : CESU-8 is useful in 8-bit processing environments where binary collation with UTF-16 is required. It is designed and recommended for use only within products requiring this UTF-16 binary collation equivalence. It is not intended nor recommended for open interchange. As a very small percentage of characters in a typical data stream are expected to be supplementary characters, there is a strong possibility that CESU-8 data may be misinterpreted as UTF-8. Therefore, all use of CESU-8 outside closed implementations is strongly discouraged, such as the emittance of CESU-8 in output files, markup language or other open transmission forms. Oracle uses this internally because it collates (sorts) in the same order as UTF16, which is the basis of Oracle's internal collation definitions. Rather than change UTF8 for clients Oracle chose to define a new character set called "AL32UTF8" which does conform to the UTF-8 standard. (The AL32UTF8 character set can't be used on the server because it would break collation.) Because of that, for the rest of this document we'll use "AL32UTF8". If you're using an Oracle version below 9.2 you'll need to use "UTF8" until you upgrade. DBD::Oracle and Unicode DBD::Oracle Unicode support has been implemented for Oracle versions 9 or greater, and Perl version 5.6 or greater (though we *strongly* suggest that you use Perl 5.8.2 or later). You can check which Oracle version your DBD::Oracle was built with by importing the "ORA_OCI" constant from DBD::Oracle. Fetching Data Any data returned from Oracle to DBD::Oracle in the AL32UTF8 character set will be marked as UTF-8 to ensure correct handling by Perl. For Oracle to return data in the AL32UTF8 character set the NLS_LANG or NLS_NCHAR environment variable *must* be set as described in the previous section. When fetching NCHAR, NVARCHAR, or NCLOB data from Oracle, DBD::Oracle will set the Perl UTF-8 flag on the returned data if either NLS_NCHAR is AL32UTF8, or NLS_NCHAR is not set and NLS_LANG is AL32UTF8. When fetching other character data from Oracle, DBD::Oracle will set the Perl UTF-8 flag on the returned data if NLS_LANG is AL32UTF8. Sending Data using Placeholders Data bound to a placeholder is assumed to be in the default client character set (specified by NLS_LANG) except for a few special cases. These are listed here with the highest precedence first: If the "ora_csid" attribute is given to bind_param() then that is passed to Oracle and takes precedence. If the value is a Perl Unicode string (UTF-8) then DBD::Oracle ensures that Oracle uses the Unicode character set, regardless of the NLS_LANG and NLS_NCHAR settings. If the placeholder is for inserting an NCLOB then the client NLS_NCHAR character set is used. (That's useful but inconsistent with the other behaviour so may change. Best to be explicit by using the "ora_csform" attribute.) If the "ora_csform" attribute is given to bind_param() then that determines if the value should be assumed to be in the default (NLS_LANG) or NCHAR (NLS_NCHAR) client character set. use DBD::Oracle qw( SQLCS_IMPLICIT SQLCS_NCHAR ); ... $sth->bind_param(1, $value, { ora_csform => SQLCS_NCHAR }); or $dbh->{ora_ph_csform} = SQLCS_NCHAR; # default for all future placeholders Binding with bind_param_array and execute_array is also UTF-8 compatible in the same way. If you attempt to insert UTF-8 data into a non UTF-8 Oracle instance or with an non UTF-8 NCHAR or NVARCHAR the insert will still happen but a error code of 0 will be returned with the following warning; DBD Oracle Warning: You have mixed utf8 and non-utf8 in an array bind in parameter#1. This may result in corrupt data. The Query charset id=1, name=US7ASCII The warning will report the parameter number and the NCHAR setting that the query is running. Sending Data using SQL Oracle assumes the SQL statement is in the default client character set (as specified by NLS_LANG). So Unicode strings containing non-ASCII characters should not be used unless the default client character set is AL32UTF8. DBD::Oracle and Other Character Sets and Encodings The only multi-byte Oracle character set supported by DBD::Oracle is "AL32UTF8" (and "UTF8"). Single-byte character sets should work well. OBJECT & COLLECTION DATA TYPES Oracle databases allow for the creation of object oriented like user-defined types. There are two types of objects, Embedded--an object stored in a column of a regular table and REF--an object that uses the REF retrieval mechanism. DBD::Oracle supports only the 'selection' of embedded objects of the following types OBJECT, VARRAY and TABLE in any combination. Support is seamless and recursive, meaning you need only supply a simple SQL statement to get all the values in an embedded object. You can either get the values as an array of scalars or they can be returned into a DBD::Oracle::Object. Array example, given this type and table; CREATE OR REPLACE TYPE "PHONE_NUMBERS" as varray(10) of varchar(30); CREATE TABLE "CONTACT" ( "COMPANYNAME" VARCHAR2(40), "ADDRESS" VARCHAR2(100), "PHONE_NUMBERS" "PHONE_NUMBERS" ) The code to access all the data in the table could be something like this; my $sth = $dbh->prepare('SELECT * FROM CONTACT'); $sth->execute; while ( my ($company, $address, $phone) = $sth->fetchrow()) { print "Company: ".$company."\n"; print "Address: ".$address."\n"; print "Phone #: "; foreach my $items (@$phone){ print $items.", "; } print "\n"; } Note that values in PHONE_NUMBERS are returned as an array reference '@$phone'. As stated before DBD::Oracle will automatically drill into the embedded object and extract all of the data as reference arrays of scalars. The example below has OBJECT type embedded in a TABLE type embedded in an SQL TABLE; CREATE OR REPLACE TYPE GRADELIST AS TABLE OF NUMBER; CREATE OR REPLACE TYPE STUDENT AS OBJECT( NAME VARCHAR2(60), SOME_GRADES GRADELIST); CREATE OR REPLACE TYPE STUDENTS_T AS TABLE OF STUDENT; CREATE TABLE GROUPS( GRP_ID NUMBER(4), GRP_NAME VARCHAR2(10), STUDENTS STUDENTS_T) NESTED TABLE STUDENTS STORE AS GROUP_STUDENTS_TAB (NESTED TABLE SOME_GRADES STORE AS GROUP_STUDENT_GRADES_TAB); The following code will access all of the embedded data; $SQL='select grp_id,grp_name,students as my_students_test from groups'; $sth=$dbh->prepare($SQL); $sth->execute(); while (my ($grp_id,$grp_name,$students)=$sth->fetchrow()){ print "Group ID#".$grp_id." Group Name =".$grp_name."\n"; foreach my $student (@$students){ print "Name:".$student->[0]."\n"; print "Marks:"; foreach my $grades (@$student->[1]){ foreach my $marks (@$grades){ print $marks.","; } } print "\n"; } print "\n"; } Object example, given this object and table; CREATE OR REPLACE TYPE Person AS OBJECT ( name VARCHAR2(20), age INTEGER) ) NOT FINAL; CREATE TYPE Employee UNDER Person ( salary NUMERIC(8,2) ); CREATE TABLE people (id INTEGER, obj Person); INSERT INTO people VALUES (1, Person('Black', 25)); INSERT INTO people VALUES (2, Employee('Smith', 44, 5000)); The following code will access the data; $dbh{'ora_objects'} =>1; $sth = $dbh->prepare("select * from people order by id"); $sth->execute(); # object are fetched as instance of DBD::Oracle::Object my ($id1, $obj1) = $sth->fetchrow(); my ($id2, $obj2) = $sth->fetchrow(); # get full type-name of object print $obj1->type_name."44\n"; # 'TEST.PERSON' is printed print $obj2->type_name."4\n"; # 'TEST.EMPLOYEE' is printed # get attribute NAME from object print $obj1->attr('NAME')."3\n"; # 'Black' is printed print $obj2->attr('NAME')."3\n"; # 'Smith' is printed # get all atributes as hash reference my $h1 = $obj1->attr; # returns {'NAME' => 'Black', 'AGE' => 25} my $h2 = $obj2->attr; # returns {'NAME' => 'Smith', 'AGE' => 44, # 'SALARY' => 5000 } # get all attributes (names and values) as array my @a1 = $obj1->attributes; # returns ('NAME', 'Black', 'AGE', 25) my @a2 = $obj2->attributes; # returns ('NAME', 'Smith', 'AGE', 44, # 'SALARY', 5000 ) So far DBD::Oracle has been tested on a table with 20 embedded Objects, Varrays and Tables nested to 10 levels. Any NULL values found in the embedded object will be returned as 'undef'. OTHER DATA TYPES DBD::Oracle does not *explicitly* support most Oracle datatypes. It simply asks Oracle to return them as strings and Oracle does so. Mostly. Similarly when binding placeholder values DBD::Oracle binds them as strings and Oracle converts them to the appropriate type, such as DATE, when used. Some of these automatic conversions to and from strings use NLS settings to control the formatting for output and the parsing for input. The most common example is the DATE type. The default NLS format for DATE might be DD-MON-YYYY and so when a DATE type is fetched that's how Oracle will format the date. NLS settings also control the default parsing of strings into DATE values. An error will be generated if the contents of the string don't match the NLS format. If you're dealing in dates which don't match the default NLS format then you can either change the default NLS format or, more commonly, use TO_CHAR(field, "format") and TO_DATE(?, "format") to explicitly specify formats for converting to and from strings. A slightly more subtle problem can occur with NUMBER types. The default NLS settings might format numbers with a fullstop (""."") to separate thousands and a comma ("","") as the decimal point. Perl will generate warnings and use incorrect values when numbers, returned and formatted as strings in this way by Oracle, are used in a numeric context. You could explicitly convert each numeric value using the TO_CHAR(...) function but that gets tedious very quickly. The best fix is to change the NLS settings. That can be done for an individual connection by doing: $dbh->do("ALTER SESSION SET NLS_NUMERIC_CHARACTERS = '.,'"); There are some types, like BOOLEAN, that Oracle does not automatically convert to or from strings (pity). These need to be converted explicitly using SQL or PL/SQL functions. Examples: # DATE values my $sth0 = $dbh->prepare( <= TO_DATE( ?, ? ) SQL_END $sth0->execute( 'YYYY-MM-DD HH24:MI:SS', "2003", 'YYYY' ); # BOOLEAN values my $sth2 = $dbh->prepare( <bind_param( ":i0", $i0 ); $sth2->bind_param( ":i1", $i1 ); $sth2->bind_param_inout( ":o0", \$o0, 32 ); $sth2->bind_param_inout( ":o1", \$o1, 32 ); $sth2->execute(); foreach ( $i0, $b0, $o0, $i1, $b1, $o1 ) { $_ = "(undef)" if ! defined $_; } print "$i0 to $o0, $i1 to $o1\n"; # Result is : "'' to '(undef)', 'Something else' to '1'" Support for Insert of XMLType (ORA_XMLTYPE) Inserting large XML data sets into tables with XMLType fields is now supported by DBD::Oracle. The only special requirement is the use of bind_param() with an attribute hash parameter that specifies ora_type as ORA_XMLTYPE. For example with a table like this; create table books (book_id number, book_xml XMLType); one can insert data using this code $SQL='insert into books values (1,:p_xml)'; $xml= ' Programming the Perl DBI The Cheetah Book T. Bunce Alligator Descartes ... '; my $sth =$dbh-> prepare($SQL); $sth-> bind_param("p_xml", $xml, { ora_type => ORA_XMLTYPE }); $sth-> execute(); In the above case we will assume that $xml has 10000 Book nodes and is over 32k in size and is well formed XML. This will also work for XML that is smaller than 32k as well. Attempting to insert malformed XML will cause an error. Binding Cursors Cursors can be returned from PL/SQL blocks, either from stored functions (or procedures with OUT parameters) or from direct "OPEN" statements, as shown below: use DBI; use DBD::Oracle qw(:ora_types); my $dbh = DBI->connect(...); my $sth1 = $dbh->prepare(q{ BEGIN OPEN :cursor FOR SELECT table_name, tablespace_name FROM user_tables WHERE tablespace_name = :space; END; }); $sth1->bind_param(":space", "USERS"); my $sth2; $sth1->bind_param_inout(":cursor", \$sth2, 0, { ora_type => ORA_RSET } ); $sth1->execute; # $sth2 is now a valid DBI statement handle for the cursor while ( my @row = $sth2->fetchrow_array ) { ... } The only special requirement is the use of "bind_param_inout()" with an attribute hash parameter that specifies "ora_type" as "ORA_RSET". If you don't do that you'll get an error from the "execute()" like: "ORA-06550: line X, column Y: PLS-00306: wrong number or types of arguments in call to ...". Here's an alternative form using a function that returns a cursor. This example uses the pre-defined weak (or generic) REF CURSOR type SYS_REFCURSOR. This is an Oracle 9 feature. # Create the function that returns a cursor $dbh->do(q{ CREATE OR REPLACE FUNCTION sp_ListEmp RETURN SYS_REFCURSOR AS l_cursor SYS_REFCURSOR; BEGIN OPEN l_cursor FOR select ename, empno from emp ORDER BY ename; RETURN l_cursor; END; }); # Use the function that returns a cursor my $sth1 = $dbh->prepare(q{BEGIN :cursor := sp_ListEmp; END;}); my $sth2; $sth1->bind_param_inout(":cursor", \$sth2, 0, { ora_type => ORA_RSET } ); $sth1->execute; # $sth2 is now a valid DBI statement handle for the cursor while ( my @row = $sth2->fetchrow_array ) { ... } A cursor obtained from PL/SQL as above may be passed back to PL/SQL by binding for input, as shown in this example, which explicitly closes a cursor: my $sth3 = $dbh->prepare("BEGIN CLOSE :cursor; END;"); $sth3->bind_param(":cursor", $sth2, { ora_type => ORA_RSET } ); $sth3->execute; It is not normally necessary to close a cursor explicitly in this way. Oracle will close the cursor automatically at the first client-server interaction after the cursor statement handle is destroyed. An explicit close may be desirable if the reference to the cursor handle from the PL/SQL statement handle delays the destruction of the cursor handle for too long. This reference remains until the PL/SQL handle is re-bound, re-executed or destroyed. NOTE: From DBD::Oracle 1.57 functions or procedures returning SYS_REFCURSORs which have not been opened (are still in the initialised state) will return undef for the cursor statement handle e.g., in the example above if the sp_ListEmp function simply returned l_cursor instead of opening it. This means you can have a function/procedure which can elect to open the cursor or not, Before this change if you called a function/procedure which returned a SYS_REFCURSOR which was not opened DBD::Oracle would error in the execute for a OCIAttrGet on the uninitialised cursor. See the "curref.pl" script in the Oracle.ex directory in the DBD::Oracle source distribution for a complete working example. Fetching Nested Cursors Oracle supports the use of select list expressions of type REF CURSOR. These may be explicit cursor expressions - "CURSOR(SELECT ...)", or calls to PL/SQL functions which return REF CURSOR values. The values of these expressions are known as nested cursors. The value returned to a Perl program when a nested cursor is fetched is a statement handle. This statement handle is ready to be fetched from. It should not (indeed, must not) be executed. Oracle imposes a restriction on the order of fetching when nested cursors are used. Suppose $sth1 is a handle for a select statement involving nested cursors, and $sth2 is a nested cursor handle fetched from $sth1. $sth2 can only be fetched from while $sth1 is still active, and the row containing $sth2 is still current in $sth1. Any attempt to fetch another row from $sth1 renders all nested cursor handles previously fetched from $sth1 defunct. Fetching from such a defunct handle results in an error with the message "ERROR nested cursor is defunct (parent row is no longer current)". This means that the "fetchall..." or "selectall..." methods are not useful for queries returning nested cursors. By the time such a method returns, all the nested cursor handles it has fetched will be defunct. It is necessary to use an explicit fetch loop, and to do all the fetching of nested cursors within the loop, as the following example shows: use DBI; my $dbh = DBI->connect(...); my $sth = $dbh->prepare(q{ SELECT dname, CURSOR( SELECT ename FROM emp WHERE emp.deptno = dept.deptno ORDER BY ename ) FROM dept ORDER BY dname }); $sth->execute; while ( my ($dname, $nested) = $sth->fetchrow_array ) { print "$dname\n"; while ( my ($ename) = $nested->fetchrow_array ) { print " $ename\n"; } } The cursor returned by the function "sp_ListEmp" defined in the previous section can be fetched as a nested cursor as follows: my $sth = $dbh->prepare(q{SELECT sp_ListEmp FROM dual}); $sth->execute; my ($nested) = $sth->fetchrow_array; while ( my @row = $nested->fetchrow_array ) { ... } Pre-fetching Nested Cursors By default, DBD::Oracle pre-fetches rows in order to reduce the number of round trips to the server. For queries which do not involve nested cursors, the number of pre-fetched rows is controlled by the DBI database handle attribute "RowCacheSize" (q.v.). In Oracle, server side open cursors are a controlled resource, limited in number, on a per session basis, to the value of the initialization parameter "OPEN_CURSORS". Nested cursors count towards this limit. Each nested cursor in the current row counts 1, as does each nested cursor in a pre-fetched row. Defunct nested cursors do not count. An Oracle specific database handle attribute, "ora_max_nested_cursors", further controls pre-fetching for queries involving nested cursors. For each statement handle, the total number of nested cursors in pre-fetched rows is limited to the value of this parameter. The default value is 0, which disables pre-fetching for queries involving nested cursors. PL/SQL Examples Most of these PL/SQL examples come from: Eric Bartley . /* * PL/SQL to create package with stored procedures invoked by * Perl examples. Execute using sqlplus. * * Use of "... OR REPLACE" prevents failure in the event that the * package already exists. */ CREATE OR REPLACE PACKAGE plsql_example IS PROCEDURE proc_np; PROCEDURE proc_in ( err_code IN NUMBER ); PROCEDURE proc_in_inout ( test_num IN NUMBER, is_odd IN OUT NUMBER ); FUNCTION func_np RETURN VARCHAR2; END plsql_example; / CREATE OR REPLACE PACKAGE BODY plsql_example IS PROCEDURE proc_np IS whoami VARCHAR2(20) := NULL; BEGIN SELECT USER INTO whoami FROM DUAL; END; PROCEDURE proc_in ( err_code IN NUMBER ) IS BEGIN RAISE_APPLICATION_ERROR(err_code, 'This is a test.'); END; PROCEDURE proc_in_inout ( test_num IN NUMBER, is_odd IN OUT NUMBER ) IS BEGIN is_odd := MOD(test_num, 2); END; FUNCTION func_np RETURN VARCHAR2 IS ret_val VARCHAR2(20); BEGIN SELECT USER INTO ret_val FROM DUAL; RETURN ret_val; END; END plsql_example; / /* End PL/SQL for example package creation. */ use DBI; my($db, $csr, $ret_val); $db = DBI->connect('dbi:Oracle:database','user','password') or die "Unable to connect: $DBI::errstr"; # So we don't have to check every DBI call we set RaiseError. # See the DBI docs now if you're not familiar with RaiseError. $db->{RaiseError} = 1; # Example 1 Eric Bartley # # Calling a PLSQL procedure that takes no parameters. This shows you the # basic's of what you need to execute a PLSQL procedure. Just wrap your # procedure call in a BEGIN END; block just like you'd do in SQL*Plus. # # p.s. If you've used SQL*Plus's exec command all it does is wrap the # command in a BEGIN END; block for you. $csr = $db->prepare(q{ BEGIN PLSQL_EXAMPLE.PROC_NP; END; }); $csr->execute; # Example 2 Eric Bartley # # Now we call a procedure that has 1 IN parameter. Here we use bind_param # to bind out parameter to the prepared statement just like you might # do for an INSERT, UPDATE, DELETE, or SELECT statement. # # I could have used positional placeholders (e.g. :1, :2, etc.) or # ODBC style placeholders (e.g. ?), but I prefer Oracle's named # placeholders (but few DBI drivers support them so they're not portable). my $err_code = -20001; $csr = $db->prepare(q{ BEGIN PLSQL_EXAMPLE.PROC_IN(:err_code); END; }); $csr->bind_param(":err_code", $err_code); # PROC_IN will RAISE_APPLICATION_ERROR which will cause the execute to 'fail'. # Because we set RaiseError, the DBI will croak (die) so we catch that with eval. eval { $csr->execute; }; print 'After proc_in: $@=',"'$@', errstr=$DBI::errstr, ret_val=$ret_val\n"; # Example 3 Eric Bartley # # Building on the last example, I've added 1 IN OUT parameter. We still # use a placeholders in the call to prepare, the difference is that # we now call bind_param_inout to bind the value to the place holder. # # Note that the third parameter to bind_param_inout is the maximum size # of the variable. You normally make this slightly larger than necessary. # But note that the Perl variable will have that much memory assigned to # it even if the actual value returned is shorter. my $test_num = 5; my $is_odd; $csr = $db->prepare(q{ BEGIN PLSQL_EXAMPLE.PROC_IN_INOUT(:test_num, :is_odd); END; }); # The value of $test_num is _copied_ here $csr->bind_param(":test_num", $test_num); $csr->bind_param_inout(":is_odd", \$is_odd, 1); # The execute will automagically update the value of $is_odd $csr->execute; print "$test_num is ", ($is_odd) ? "odd - ok" : "even - error!", "\n"; # Example 4 Eric Bartley # # What about the return value of a PLSQL function? Well treat it the same # as you would a call to a function from SQL*Plus. We add a placeholder # for the return value and bind it with a call to bind_param_inout so # we can access it's value after execute. my $whoami = ""; $csr = $db->prepare(q{ BEGIN :whoami := PLSQL_EXAMPLE.FUNC_NP; END; }); $csr->bind_param_inout(":whoami", \$whoami, 20); $csr->execute; print "Your database user name is $whoami\n"; $db->disconnect; You can find more examples in the t/plsql.t file in the DBD::Oracle source directory. Oracle 9.2 appears to have a bug where a variable bound with bind_param_inout() that isn't assigned to by the executed PL/SQL block may contain garbage. See Avoid Using "SQL Call" Avoid using the "SQL Call" statement with DBD:Oracle as you might find that DBD::Oracle will not raise an exception in some case. Specifically if you use "SQL Call" to run a procedure all "No data found" exceptions will be quietly ignored and returned as null. According to Oracle support this is part of the same mechanism where; select (select * from dual where 0=1) from dual returns a null value rather than an exception. CONTRIBUTING If you'd like DBD::Oracle to do something new or different the best way to make that happen is to do it yourself and email to dbi-dev@perl.org a patch of the source code (using 'diff' - see below) that shows the changes. How to create a patch using Subversion The DBD::Oracle source code is maintained using Subversion (a replacement for CVS, see ). To access the source you'll need to install a Subversion client. Then, to get the source code, do: svn checkout http://svn.perl.org/modules/dbd-oracle/trunk If it prompts for a username and password use your perl.org account if you have one, else just 'guest' and 'guest'. The source code will be in a new subdirectory called "trunk". To keep informed about changes to the source you can send an empty email to dbd-oracle-changes-subscribe@perl.org after which you'll get an email with the change log message and diff of each change checked-in to the source. After making your changes you can generate a patch file, but before you do, make sure your source is still upto date using: svn update If you get any conflicts reported you'll need to fix them first. Then generate the patch file from within the "trunk" directory using: svn diff > foo.patch Read the patch file, as a sanity check, and then email it to dbi-dev@perl.org. How to create a patch without Subversion Unpack a fresh copy of the distribution: tar xfz DBD-Oracle-1.40.tar.gz Rename the newly created top level directory: mv DBD-Oracle-1.40 DBD-Oracle-1.40.your_foo Edit the contents of DBD-Oracle-1.40.your_foo/* till it does what you want. Test your changes and then remove all temporary files: make test && make distclean Go back to the directory you originally unpacked the distribution: cd .. Unpack *another* copy of the original distribution you started with: tar xfz DBD-Oracle-1.40.tar.gz Then create a patch file by performing a recursive "diff" on the two top level directories: diff -r -u DBD-Oracle-1.40 DBD-Oracle-1.40.your_foo > DBD-Oracle-1.40.your_foo.patch Speak before you patch For anything non-trivial or possibly controversial it's a good idea to discuss (on dbi-dev@perl.org) the changes you propose before actually spending time working on them. Otherwise you run the risk of them being rejected because they don't fit into some larger plans you may not be aware of. GitHub repository A git mirror of the subversion is also available at `https://github.com/yanick/DBD-Oracle`. WHICH VERSION OF DBD::ORACLE IS FOR ME? From version 1.25 onwards DBD::Oracle only support Oracle clients 9.2 or greater. Support for ProC connections was dropped in 1.29. If you are still stuck with an older version of Oracle or its client you might want to look at the table below. +---------------------+-----------------------------------------------------+ | | Oracle Version | +---------------------+----+-------------+---------+------+--------+--------+ | DBD::Oracle Version | <8 | 8.0.3~8.0.6 | 8iR1~R2 | 8iR3 | 9i | 9.2~11 | +---------------------+----+-------------+---------+------+--------+--------+ | 0.1~16 | Y | Y | Y | Y | Y | Y | +---------------------+----+-------------+---------+------+--------+--------+ | 1.17 | Y | Y | Y | Y | Y | Y | +---------------------+----+-------------+---------+------+--------+--------+ | 1.18 | N | N | N | Y | Y | Y | +---------------------+----+-------------+---------+------+--------+--------+ | 1.19 | N | N | N | Y | Y | Y | +---------------------+----+-------------+---------+------+--------+--------+ | 1.20 | N | N | N | Y | Y | Y | +---------------------+----+-------------+---------+------+--------+--------+ | 1.21~1.24 | N | N | N | N | Y | Y | +---------------------+----+-------------+---------+------+--------+--------+ | 1.25+ | N | N | N | N | N | Y | +---------------------+----+-------------+---------+------+--------+--------+ As there are dozens of different versions of Oracle's clients this list does not include all of them, just the major released versions of Oracle. Note that one can still connect to any Oracle version with the older DBD::Oracle versions the only problem you will have is that some of the newer OCI and Oracle features available in later DBD::Oracle releases will not be available to you. So to make a short story a little longer: 1 If you are using Oracle 7 or early 8 DB and you can manage to get a 9 client and you can use any DBD::Oracle version. 2 If you have to use an Oracle 7 client then DBD::Oracle 1.17 should work 3 Same thing for 8 up to R2, use 1.17, if you are lucky and have the right patch-set you might go with 1.18. 4 For 8iR3 you can use any of the DBD::Oracle versions up to 1.21. Again this depends on your patch-set, If you run into trouble go with 1.19 5 After 9.2 you can use any version you want. 6 It seems that the 10g client can only connect to 9 and 11 DBs while the 9 can go back to 7 and even get to 10. I am not sure what the 11g client can connect to. BUGS AND LIMITATIONS There is a known problem with the 11.2g Oracle client and the "DBMS_LOB.GETLENGTH()" PL/SQL function. See for the details. SEE ALSO DBI http://search.cpan.org/~timb/DBD-Oracle/MANIFEST for all files in the DBD::Oracle source distribution including the examples in the Oracle.ex directory DBD::Oracle Tutorial http://www.pythian.com/blogs/wp-content/uploads/introduction-dbd-ora cle.html Oracle Instant Client http://www.oracle.com/technology/tech/oci/instantclient/index.html Oracle on Linux http://www.ixora.com.au/ Free Oracle Tools and Links ora_explain supplied and installed with DBD::Oracle. http://www.orafaq.com/ http://vonnieda.org/oracletool/ Commercial Oracle Tools and Links Assorted tools and references for general information. No recommendation implied. http://www.platinum.com http://www.SoftTreeTech.com Also PL/Vision from RevealNet and Steven Feuerstein, and "Q" from Savant Corporation. AUTHORS DBI by Tim Bunce . The original "DBD::Oracle" was by Tim Bunce. Maintained as of release 1.17 (February 2006) by John Scoles, then Yanick Champoux, under the auspice of the Pythian Group (). ACKNOWLEDGEMENTS A great many people have helped with DBD::Oracle over the 17 years between 1994 and 2011. Far too many to name, but we thank them all. Many are named in the Changes file. COPYRIGHT The DBD::Oracle module is Copyright (c) 1994-2006 Tim Bunce. Ireland. The DBD::Oracle module is Copyright (c) 2006-2011 John Scoles (The Pythian Group). Canada. The DBD::Oracle module is Copyright (c) 2011 John Scoles. Canada. The DBD::Oracle module is free open source software; you can redistribute it and/or modify it under the same terms as Perl 5. AUTHORS * Tim Bunce * John Scoles * Yanick Champoux * Martin J. Evans COPYRIGHT AND LICENSE This software is copyright (c) 1994 by Tim Bunce. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself.