# # OraConnection.pm - encapsulate a connection to an Oracle DB. # # This Perl module encapsulates a connection to an Oracle database. # It provides methods to connect and disconnect from the database, # as well as execute common queries. # # Error handling is provided in several flavors: text and html output are # provided to either stdout or a provided file handle. # # Written by Clint Goss , August 1997 - April 1999 # # 04/21/1999 CG Fix case sensitivity issues with respect to table names. # # 04/19/1999 CG Integration of large object code written by Tim Boettscher. # # 04/14/1999 CG Add ability to surface schemas and data dictionary tables # from RDB databases. # # 04/07/1999 CG Added routines to surf indices applied to a table. # # 04/06/1999 CG Added ability to specify a schema name other than the default # user schema. # # 03/11/1999 CG Added method to return the constraint check text for a column. # # 06/17/1998 CG Added method to return whether a column in a table is # a primary key, and its position. # # 05/30/1998 CG Added methods for setting OPTIMIZER_GOAL and date format. # Augmented connect() with new optional arguments for # OPTIMIZER_GOAL and date format. # Added methods to get view and sequence names # and fetch their attributes. # package OraConnection; # Perl Modules use DBI; # Database Interface use DBD::Oracle; # Database Interface use FileHandle; require Exporter; @ISA = qw (Exporter); @EXPORT = qw (); @EXPORT_OK = qw (); use strict; # Restrict unsafe variables, references, barewords # Constructor: # # my ($ora) = new OraConnection; sub new { my ($class) = @_; my ($self) = {}; bless ($self, $class); $self->{'msgFormat'} = "text"; return $self; } # Destructor needed for Database cleanup # If the user didn't clean up, we'll do it for her when our object goes # out of scope or otherwise gets destroyed. sub DESTROY { my ($self) = @_; $self->disconnect (); } # Error handling. # # Problems encountered by routines in this class are divided up # into these flavors: # # Fatal Error Something really bad happened when dealing with the underlying # database, which make it unlikely that the calling program will # want to continue. Examples are a failure to connect to the # database. # # SQL Error An error was encountered preparing or executing an SQL # statement. # # Warning Nothing too serious. # # System Error The caller has made some error in using the methods of this # class. For example, trying to execute an SQL statement prior # to connecting to the database. # # This module provides a default behaviour in each of these situations. # # The behaviour can be overridden by the owner/caller/progenitor of the # class instance. The owner provides class object which (re-)implements # the above 'databaseProblem' method. # # Default problem handler. # # $problemType One of "fatalError", "sqlError", "warning", "systemError" # $msg Text describing the problem. This message is either plain text # or html formatted text. sub databaseProblem { my ($self, $problemType, $problemDescription) = @_; print $problemDescription; if ($problemType ne "warning") { die "Database $problemType"; } } # Provide/declare a class which implements the databaseProblem method. # If $handlerClass is undef, the default handler in this module is used. sub overrideDatabaseProblemHandler { my ($self, $handlerClass) = @_; $self->{'handlerClass'} = $handlerClass; } # Fetch the class which currently implements the databaseProblem method. # If this class is the handler (i.e. the default handler is in use), we # will return undef. sub databaseProblemHandler { my ($self) = @_; return $self->{'handlerClass'}; } # Select the format for error messages. # MUST be one of 'html' or 'text'. sub setMsgFormat { my ($self, $format) = @_; $self->{'msgFormat'} = $format; } # Connect to the Oracle database and return the Oracle db handle. # # The $databaseName is the "TNS" name of the database on your local system. # The $username and $password specify the login context. # # The optional $goal and optional $dformat specify the OPTIMIZER_GOAL # and default date format to use for this connection. # See the setOptimizerGoal() and setDefaultDateFormat() methods below. # # If either the prepare or execute fails, perform fatal processing. sub connect { my ($self, $databaseName, $username, $password, $goal, $dformat) = @_; $self->{'driverName'} = "Oracle"; $self->{'databaseName'} = $databaseName; $self->{'username'} = $username; $self->{'password'} = $password; my ($dataSource) = $self->{'dataSource'} = "dbi:Oracle:" . $databaseName; # Attempt to connect to the database. my ($dbh) = DBI->connect ($dataSource, $username, $password); # Check connection success. # NOTE that $dbh IS DEFINED (as a hash) even in the case # of connection failure. if ($DBI::err) { $self->fatal ("Unable to connect to Oracle at " . $dataSource . " as user '" . $username . "'"); } $self->{'dbh'} = $dbh; $self->{'connected'} = 1; if ($goal) { $self->setOptimizerGoal ($goal); } if ($dformat) { $self->setDefaultDateFormat ($dformat); } return $dbh; } # Specify the flavor of the database. # The choices are "Oracle" or "RDB". # Oracle is the default, if "" or undef is passed. sub setDatabaseFlavor { my ($self, $flavor) = @_; if ($flavor && (($flavor ne "Oracle") && ($flavor ne "RDB"))) { $self->fatal ("Invalid argument to setDatabaseFlavor()"); } $self->{'flavor'} = $flavor; } # Specify the name of a link to add to table names for composed queries. # For example, to make queries of the form "SELECT * from tblname@linkname" # you would invoke ->setLinkName("linkname") after the connect(). # # The "@" is optional to this method. # Note that the linkName() method will NOT return the leading "@", # regardless of whether it was specified on the call to setLinkName(). # # To clear a linkname, call ->setLinkName(""); sub setLinkName { my ($self, $linkName) = @_; if ($linkName) { $linkName = "\@" . $linkName; $linkName =~ s/\@\@/\@/; $self->{'linkName'} = $linkName; } else { $self->{'linkName'} = ""; } } # Specify the name of a schema to add to table names for composed queries, # overriding the default schema for the username on the connect() call. # For example, to make queries of the form "SELECT * from myschema.tblname" # you would invoke ->setSchema("myschema") after the connect(). # # To clear a linkname, call ->setSchema(""); sub setSchema { my ($self, $schemaName) = @_; $self->{'schemaName'} = $schemaName; } # Set this connection's OPTIMIZER_GOAL. The supplied $goal must be one of # the known optimizer goals listed below (case insensitive). The setting of # OPTIMIZER_GOAL specifies the optimization mode to use when handling # database queries: # # CHOOSE Tells the optimizer to search the data dictionary views # for data on at least one related table # (referenced in the SQL statement). # If data exists, the optimizer will optimize the statement # according to the cost-based approach. # If no data exists for any tables being referenced, # the optimizer will use rule-based optimization. # # ALL_ROWS Chooses cost-based optimization with the goal of best # throughput. # # FIRST_ROWS Chooses cost-based optimization with the goal of best # response time. # # RULE Chooses rule-based optimization regardless of the presence # of data in the data dictionary views related to the tables # being referenced. # # On success, this method returns 1. If an invalid goal is supplied, # no action is taken and this method return undef. sub setOptimizerGoal { my ($self, $goal) = @_; my ($ugoal) = uc ($goal); if (($ugoal eq "CHOOSE") || ($ugoal eq "ALL_ROWS") || ($ugoal eq "FIRST_ROWS") || ($ugoal eq "RULE")) { $self->exec ("ALTER SESSION SET OPTIMIZER_GOAL = " . $ugoal); $self->{'optimizerGoal'} = $ugoal; return 1; } else { return undef; } } # Set this connection's default date format. The supplied $dformat must be # a valid Oracle date format. If an invalid date format is supplied, # perform fatal processing. # This method always returns 1. sub setDefaultDateFormat { my ($self, $dformat) = @_; $self->exec ("ALTER SESSION SET NLS_DATE_FORMAT = " . $self->quote ($dformat)); $self->{'defaultDateFormat'} = $dformat; return 1; } # Disconnect from Oracle # # This user is REQUIRED to execute this. # # However, since the DESTROY method for this class calls disconnect (), # the user can simply call this by destroying the object or letting it # go out of scope. sub disconnect { my ($self) = @_; if ($self->{'connected'}) { $self->{'connected'} = 0; my ($dbh) = $self->{'dbh'}; # CG 1/21/98. The disconnect sometimes gets errors if called by the # DESTROY method of this class. Don't know why. # It's really bad to try to report this error, since the object # seems to be "half-destroyed" at this point. Just ignore errors. $dbh->disconnect; # $dbh->disconnect || # $self->fatal ("Can't disconnect from database '" . # $self->{'databaseName'} . "', user '" . # $self->{'username'} . "'"); } } # Access methods sub connected { return $_[0]->{'connected'}; } sub dataSource { return $_[0]->{'dataSource'}; } sub dbh { return $_[0]->{'dbh'}; } sub driverName { return $_[0]->{'driverName'}; } sub databaseName { return $_[0]->{'databaseName'}; } sub password { return $_[0]->{'password'}; } sub username { return $_[0]->{'username'}; } sub optimizerGoal { return $_[0]->{'optimizerGoal'}; } sub defaultDateFormat { return $_[0]->{'defaultDateFormat'}; } sub databaseFlavor { return $_[0]->{'flavor'}; } sub schemaName { return $_[0]->{'schemaName'}; } # Return any currently specified linkname. # This method will NOT return the leading "@", # regardless of whether it was specified on the call to setLinkName(). sub linkName { my ($self) = @_; my ($linkName) = $self->{'linkName'}; $linkName =~ s/^@//; return $linkName; } # Quote a given string in the context of the particular database connection. # This routine is prefereable to trying to quote values yourself, because # different database connections have different syntax(es) for quoting # values. # For example, quoting the value don't might yield 'don''t' in one # variation of SQL and "don't" in another, and $don't in another. sub quote { my ($self, $quotable) = @_; return $self->{'dbh'}->quote ($quotable); } # A version of quote which performs special processing: # If the supplied $quotable has leading and trailing double quote characters, # then strip those two double quotes and quote the remaining string as is. # Otherwise, convert the string to UPPER case and quote the result. # # This is an internal special-purpose internal routine. sub quoteUC { my ($self, $quotable) = @_; if ($quotable =~ /^".*"$/) { $quotable =~ s/^.//; $quotable =~ s/.$//; } else { $quotable = uc ($quotable); } return $self->{'dbh'}->quote ($quotable); } ################################################################################ # # SQL Query Execution - Multiple execute style # # This section emulates the DBI style of prepare-execute-execute-execute-finish # query handling. Results must be fetched by the caller, typically using the # DBI::fetch method directly. # ################################################################################ # Take an SQL query, prepare it, execute it, and return its statement handle. # # The resulting statement handle can be re-executed without another # prepare() call, by calling reExec (). # # You MUST (eventually) call finish () on the returned statement handle. # # If either the prepare or execute fails, perform fatal processing. sub execMulti { my ($self, $query) = @_; my ($dbh) = $self->{'dbh'}; my ($sth) = $dbh->prepare ($query) || $self->fatal ($dbh, "Can't prepare"); # Caution here - the execute returns the number of rows, # which could be zero even for a successful execute call. my ($rc) = $sth->execute; if (! defined ($rc)) { $self->fatal ("Can't execute query '$query'"); } return $sth; } # Re-execute a statement prepared earlier using the statement handle # returned by an early exec () invocation. # # Return the statement handle for uniformity with exec (). # # If the execute fails, perform fatal processing. sub reExec { my ($self, $sth) = @_; # Caution here - the execute returns the number of rows, # which could be zero even for a successful execute call. my ($rc) = $sth->execute; if (! defined ($rc)) { $self->fatal ("Can't reExec"); } return $sth; } # Finish the statement and free the associated resources. # # If the finish fails, perform fatal processing. sub finish { my ($self, $sth) = @_; $sth->finish || $self->fatal ("Can't finish"); } ################################################################################ # # MetaData/Data Dictionary methods # # This section implements routines which return information about the # tables and columns in the database. # ################################################################################ # Return a reference to a list of the names of the tables in this database. # The list is sorted alphabetically by table name. sub tableNames { my ($self) = @_; my ($schemaName) = $self->{'schemaName'}; my ($linkName) = $self->{'linkName'}; my ($stmt) = "SELECT table_name FROM " . "user_tables$linkName ORDER BY table_name ASC"; if ($schemaName) { $stmt = "SELECT table_name FROM all_tables$linkName " . "WHERE owner=" . $self->quote ($schemaName) . " ORDER BY table_name ASC"; } my ($rows) = $self->fetchAll ($stmt); # Copy the first (only) column value in each record into a new # anonymous list. my ($result) = []; my ($record); foreach $record (@$rows) { push @$result, $record->[0]; } return $result; } # Return a reference to a list of the names of the views in this database. # The list is sorted alphabetically by view name. sub viewNames { my ($self) = @_; my ($schemaName) = $self->{'schemaName'}; my ($linkName) = $self->{'linkName'}; my ($stmt) = "SELECT view_name FROM user_views$linkName " . "ORDER BY view_name ASC"; if ($schemaName) { $stmt = "SELECT view_name FROM all_views$linkName " . "WHERE owner=" . $self->quote ($schemaName) . " ORDER BY view_name ASC"; } my ($rows) = $self->fetchAll ($stmt); # Copy the first (only) column value in each record into a new # anonymous list. my ($result) = []; my ($record); foreach $record (@$rows) { push @$result, $record->[0]; } return $result; } # Return a reference to a list of the names of the tables and views # in this database. # The list is sorted alphabetically by view name. sub tableOrViewNames { my ($self) = @_; my ($schemaName) = $self->{'schemaName'}; my ($linkName) = $self->{'linkName'}; my ($stmt) = "SELECT view_name FROM user_views$linkName " . "UNION " . "SELECT table_name FROM user_tables$linkName " . "ORDER BY 1 ASC"; if ($self->{'flavor'} eq "RDB") { $stmt = "SELECT table_name FROM user_tables$linkName"; } if ($schemaName) { $stmt = "SELECT table_name FROM all_tables$linkName " . "WHERE owner=" . $self->quote ($schemaName) . " ORDER BY table_name ASC"; } my ($rows) = $self->fetchAll ($stmt); # Copy the first (only) column value in each record into a new # anonymous list. my ($result) = []; my ($record); foreach $record (@$rows) { push @$result, $record->[0]; } return $result; } # Return a reference to a list of the names of the DB links in this database. # The list is sorted alphabetically by DB links name. sub dbLinkNames { my ($self) = @_; my ($schemaName) = $self->{'schemaName'}; my ($linkName) = $self->{'linkName'}; my ($stmt) = "SELECT db_link FROM user_db_links$linkName " . "ORDER BY db_link ASC"; if ($schemaName) { $stmt = "SELECT db_link FROM all_db_links$linkName " . "WHERE owner=" . $self->quote ($schemaName) . " ORDER BY db_link ASC"; } my ($rows) = $self->fetchAll ($stmt); # Copy the first (only) column value in each record into a new # anonymous list. my ($result) = []; my ($record); foreach $record (@$rows) { push @$result, $record->[0]; } return $result; } # Return a reference to a list of the names of the sequences in this database. # The list is sorted alphabetically by sequence name. sub sequenceNames { my ($self) = @_; my ($schemaName) = $self->{'schemaName'}; my ($linkName) = $self->{'linkName'}; my ($stmt) = "SELECT sequence_name FROM user_sequences$linkName " . "ORDER BY sequence_name ASC"; if ($schemaName) { $stmt = "SELECT sequence_name FROM all_sequences$linkName " . "WHERE owner=" . $self->quote ($schemaName) . " ORDER BY sequence_name ASC"; } my ($rows) = $self->fetchAll ($stmt); # Copy the first (only) column value in each record into a new # anonymous list. my ($result) = []; my ($record); foreach $record (@$rows) { push @$result, $record->[0]; } return $result; } # Return a reference to a list of the names of the synonyms in this database. # The list is sorted alphabetically by synonyms name. sub synonymNames { my ($self) = @_; my ($schemaName) = $self->{'schemaName'}; my ($linkName) = $self->{'linkName'}; my ($stmt) = "SELECT synonym_name FROM user_synonyms$linkName " . "ORDER BY synonym_name ASC"; if ($schemaName) { $stmt = "SELECT synonym_name FROM all_synonyms$linkName " . "WHERE owner=" . $self->quote ($schemaName) . " ORDER BY synonym_name ASC"; } my ($rows) = $self->fetchAll ($stmt); # Copy the first (only) column value in each record into a new # anonymous list. my ($result) = []; my ($record); foreach $record (@$rows) { push @$result, $record->[0]; } return $result; } # Return the value of the comment attribute in the database for a given # table or column in a table. # If the column is not specified, the value of the comment for the # table is returned. # The table and column names are case insensitive, # unless they are enclosed in double quotes. # Returns undef if the table name or column name (if specified in the call) # does not exist. # Returns "" if the comment attribute is not set. sub comment { my ($self, $tName, $cName) = @_; my ($schemaName) = $self->{'schemaName'}; my ($linkName) = $self->{'linkName'}; if ($linkName) { # The comments don't seem work properly through links, so ... return undef; } my ($stmt) = "SELECT comments FROM "; if ($cName) { if ($schemaName) { $stmt .= "all_col_comments$linkName WHERE " . "owner = " . $self->quote ($schemaName) . " and "; } else { $stmt .= "user_col_comments$linkName WHERE "; } } else { if ($schemaName) { $stmt .= "all_tab_comments$linkName WHERE " . "owner = " . $self->quote ($schemaName) . " and "; } else { $stmt .= "user_tab_comments$linkName WHERE "; } } $stmt .= "table_name = " . $self->quoteUC ($tName); if ($cName) { $stmt .= " and column_name = " . $self->quoteUC ($cName); } my ($rows, $rowCount) = $self->fetchAll ($stmt); #if (! $cName) { return $stmt; } if (! $rowCount) { return undef; } my ($record) = $rows->[0]; return $record->[0]; } # Set the value of the comment attribute in the database for a given # table or column in a table. # If the column is not specified, the value of the comment for the # table is set. sub setComment { my ($self, $comment, $tName, $cName) = @_; my ($stmt); if ($cName) { $stmt = "comment on column $tName.$cName is " . $self->quote ($comment); } else { $stmt = "comment on table $tName is " . $self->quote ($comment); } $self->exec ($stmt); } # Return the table type of a given named table. # The returned string is, for example, "TABLE" or "VIEW". # The table name is case insensitive, unless it is enclosed in double quotes. # If the table does not exist, an SQL error is triggered. sub tabtype { my ($self, $tableOrViewName) = @_; my ($schemaName) = $self->{'schemaName'}; if ($schemaName) { return "TABLE"; } if ($self->{'flavor'} eq "RDB") { return "TABLE"; } # Look up this attribute in the TAB table. my ($linkName) = $self->{'linkName'}; my ($stmt) = "SELECT tabtype FROM tab$linkName " . "WHERE tname=" . $self->quoteUC ($tableOrViewName); my ($result) = $self->fetchSingle ($stmt); return $result->[0]; } # Return the given named attribute of a given named table. # The table name is case insensitive, unless it is enclosed in double quotes. # If the table does not exist, an SQL error is triggered. sub avg_row_len { my ($self, $tName) = @_; return $self->tableAttribute ($tName, "avg_row_len"); } sub avg_space { my ($self, $tName) = @_; return $self->tableAttribute ($tName, "avg_space"); } sub backed_up { my ($self, $tName) = @_; return $self->tableAttribute ($tName, "backed_up"); } sub blocks { my ($self, $tName) = @_; return $self->tableAttribute ($tName, "blocks"); } sub cache { my ($self, $tName) = @_; return $self->tableAttribute ($tName, "cache"); } sub chain_cnt { my ($self, $tName) = @_; return $self->tableAttribute ($tName, "chain_cnt"); } sub cluster_name { my ($self, $tName) = @_; return $self->tableAttribute ($tName, "cluster_name"); } sub degree { my ($self, $tName) = @_; return $self->tableAttribute ($tName, "degree"); } sub empty_blocks { my ($self, $tName) = @_; return $self->tableAttribute ($tName, "empty_blocks"); } sub freelists { my ($self, $tName) = @_; return $self->tableAttribute ($tName, "freelists"); } sub freelist_groups { my ($self, $tName) = @_; return $self->tableAttribute ($tName, "freelist_groups"); } sub ini_trans { my ($self, $tName) = @_; return $self->tableAttribute ($tName, "ini_trans"); } sub initial_extent { my ($self, $tName) = @_; return $self->tableAttribute ($tName, "initial_extent"); } sub instances { my ($self, $tName) = @_; return $self->tableAttribute ($tName, "instances"); } sub max_extents { my ($self, $tName) = @_; return $self->tableAttribute ($tName, "max_extents"); } sub max_trans { my ($self, $tName) = @_; return $self->tableAttribute ($tName, "max_trans"); } sub min_extents { my ($self, $tName) = @_; return $self->tableAttribute ($tName, "min_extents"); } sub next_extent { my ($self, $tName) = @_; return $self->tableAttribute ($tName, "next_extent"); } sub num_rows { my ($self, $tName) = @_; return $self->tableAttribute ($tName, "num_rows"); } sub pct_free { my ($self, $tName) = @_; return $self->tableAttribute ($tName, "pct_free"); } sub pct_used { my ($self, $tName) = @_; return $self->tableAttribute ($tName, "pct_used"); } sub pct_increase { my ($self, $tName) = @_; return $self->tableAttribute ($tName, "pct_increase"); } sub table_lock { my ($self, $tName) = @_; return $self->tableAttribute ($tName, "table_lock"); } sub tablespace_name { my ($self, $tName) = @_; return $self->tableAttribute ($tName, "tablespace_name"); } # Returns a given attribute of a named table. # The table name and attribute are case insensitive. # If the table or attribute do not exist, an SQL error is triggered. sub tableAttribute { my ($self, $tableName, $attribute) = @_; # Look up this attribute in the USER_TABLES table. my ($schemaName) = $self->{'schemaName'}; my ($linkName) = $self->{'linkName'}; my ($stmt) = "SELECT $attribute FROM user_tables$linkName " . "WHERE table_name=" . $self->quoteUC ($tableName); if ($schemaName) { $stmt = "SELECT $attribute FROM all_tables$linkName " . "WHERE owner=" . $self->quote ($schemaName) . " and table_name=" . $self->quoteUC ($tableName); } my ($result) = $self->fetchSingle ($stmt); return $result->[0]; } # Return a reference to a list of column names in a given table. # The table name is case insensitive, unless it is enclosed in double quotes. # If the table does not exist, an SQL error is triggered. sub columnNames { my ($self, $tableName) = @_; # Build a statement handle for a broad-band select from the table my ($schemaName) = $self->{'schemaName'}; my ($linkName) = $self->{'linkName'}; my ($stmt) = "SELECT * FROM $tableName$linkName"; if ($schemaName) { $stmt = "SELECT * FROM $schemaName.$tableName$linkName"; } my ($sth) = $self->execMulti ($stmt); # Fetch the column names. my ($nfields) = $sth->{NUM_OF_FIELDS}; my ($result) = []; my ($f); for ($f = 0; $f < $nfields; $f++) { push @$result, $sth->{NAME}->[$f]; } $sth->finish || $self->fatal ("Can't finish"); return $result; } # Return 1 or 0 if the given named column in the given named table # is nullable or not. # The table name and column names are case insensitive. # If the table or column do not exist, an SQL error is triggered. sub nullable { my ($self, $tName, $cName) = @_; if ($self->{'flavor'} eq "RDB") { return 1; } my ($attrValue) = $self->columnAttribute ($tName, $cName, "nullable"); return ($attrValue eq "Y") ? 1 : 0; } # Return the given named attribute of a given named table and column. # The table name and column name are case insensitive. # If the table or column do not exist, an SQL error is triggered. sub column_id { my ($self, $tName, $cName) = @_; if ($self->{'flavor'} ne "RDB") { return $self->columnAttribute ($tName, $cName, "column_id"); } # Here for RDB my ($linkName) = $self->{'linkName'}; my ($relationID) = $self->rdbRelationID ($tName); my ($stmt) = "SELECT rdb\$field_id FROM " . "rdb\$field_versions$linkName " . "WHERE rdb\$relation_id=$relationID and " . "rdb\$field_name=" . $self->quoteUC ($cName); my ($result) = $self->fetchSingle ($stmt); my ($fid) = $result->[0]; $fid =~ s/\s//g; return $fid; } sub data_default { my ($self, $tName, $cName) = @_; return $self->columnAttribute ($tName, $cName, "data_default"); } sub default_length { my ($self, $tName, $cName) = @_; return $self->columnAttribute ($tName, $cName, "default_length"); } sub density { my ($self, $tName, $cName) = @_; return $self->columnAttribute ($tName, $cName, "density"); } sub high_value { my ($self, $tName, $cName) = @_; return $self->columnAttribute ($tName, $cName, "high_value"); } sub last_analyzed { my ($self, $tName, $cName) = @_; return $self->columnAttribute ($tName, $cName, "last_analyzed"); } sub low_value { my ($self, $tName, $cName) = @_; return $self->columnAttribute ($tName, $cName, "low_value"); } sub num_buckets { my ($self, $tName, $cName) = @_; return $self->columnAttribute ($tName, $cName, "num_buckets"); } sub num_distinct { my ($self, $tName, $cName) = @_; return $self->columnAttribute ($tName, $cName, "num_distinct"); } sub num_nulls { my ($self, $tName, $cName) = @_; return $self->columnAttribute ($tName, $cName, "num_nulls"); } sub sample_size { my ($self, $tName, $cName) = @_; return $self->columnAttribute ($tName, $cName, "sample_size"); } # Data Dictionary routines dealing with data types. # # For database flavor RDB: # # RDB native_ # Type data_ # Code type Oracle Type data_type # # 7 SMALLINT NUMBER (5, 0) NUMBER # 8 INTEGER NUMBER (10, 0) NUMBER # 10 REAL FLOAT (24) FLOAT # 14 CHAR CHAR (fld_len) CHAR # 35 DATE VMS DATE DATE # 37 VARCHAR VARCHAR2 (fld_len) VARCHAR2 # # ?? TINYINT NUMBER (3, 0) NUMBER # ?? BIGINT NUMBER (20, 0) NUMBER # ?? DOUBLE PRECISION FLOAT (53) FLOAT # %OraConnection::rdb_map = ( 7 => { "data_type" => "NUMBER", "data_type_native" => "SMALLINT", "data_length" => 5, "data_precision" => 5, "data_scale" => 0 }, 8 => { "data_type" => "NUMBER", "data_type_native" => "INTEGER", "data_length" => 10, "data_precision" => 10, "data_scale" => 0 }, 10 => { "data_type" => "FLOAT", "data_type_native" => "REAL", "data_length" => 24, "data_precision" => 24, "data_scale" => 0 }, 14 => { "data_type" => "CHAR", "data_type_native" => "CHAR", "data_length" => "fld_len", "data_precision" => "fld_len", "data_scale" => 0 }, 35 => { "data_type" => "DATE", "data_type_native" => "DATE VMS", "data_length" => 7, "data_precision" => 7, "data_scale" => 0 }, 37 => { "data_type" => "VARCHAR2", "data_type_native" => "VARCHAR", "data_length" => "fld_len", "data_precision" => "fld_len", "data_scale" => 0 } ); sub data_type { my ($self, $tName, $cName) = @_; if ($self->{'flavor'} ne "RDB") { return $self->columnAttribute ($tName, $cName, "data_type"); } # Here for RDB my ($linkName) = $self->{'linkName'}; my ($relationID) = $self->rdbRelationID ($tName); my ($stmt) = "SELECT rdb\$field_type FROM " . "rdb\$field_versions$linkName " . "WHERE rdb\$relation_id=$relationID and " . "rdb\$field_name=" . $self->quoteUC ($cName); my ($result) = $self->fetchSingle ($stmt); my ($tcode) = $result->[0]; # Remove unexpected leading spaces, # then look up the corresponding Oracle data type # in our master RDB->Oracle map. $tcode =~ s/\s//g; my ($map) = $OraConnection::rdb_map {$tcode}; if ($map) { return $map->{'data_type'}; } else { return "Type $tcode"; } } sub data_type_native { my ($self, $tName, $cName) = @_; if ($self->{'flavor'} ne "RDB") { return $self->data_type ($tName, $cName); } # Here for RDB my ($linkName) = $self->{'linkName'}; my ($relationID) = $self->rdbRelationID ($tName); my ($stmt) = "SELECT rdb\$field_type FROM " . "rdb\$field_versions$linkName " . "WHERE rdb\$relation_id=$relationID and " . "rdb\$field_name=" . $self->quoteUC ($cName); my ($result) = $self->fetchSingle ($stmt); my ($tcode) = $result->[0]; # Remove unexpected leading spaces, # then look up the name of the underlying RDB data type # in our master RDB->Oracle map. $tcode =~ s/\s//g; my ($map) = $OraConnection::rdb_map {$tcode}; if ($map) { return $map->{'data_type_native'}; } else { return "Type $tcode"; } } sub data_length { my ($self, $tName, $cName) = @_; if ($self->{'flavor'} ne "RDB") { return $self->columnAttribute ($tName, $cName, "data_length"); } # Here for RDB my ($linkName) = $self->{'linkName'}; my ($relationID) = $self->rdbRelationID ($tName); my ($stmt) = "SELECT rdb\$field_type, rdb\$field_length FROM " . "rdb\$field_versions$linkName " . "WHERE rdb\$relation_id=$relationID and " . "rdb\$field_name=" . $self->quoteUC ($cName); my ($result) = $self->fetchSingle ($stmt); my ($tcode) = $result->[0]; my ($tlen) = $result->[1]; # Remove unexpected leading spaces, # then look up the length of the corresponding Oracle data type # in our master RDB->Oracle map. $tcode =~ s/\s//g; $tlen =~ s/\s//g; my ($map) = $OraConnection::rdb_map {$tcode}; if ($map) { my ($olen) = $map->{'data_length'}; if ($olen eq "fld_len") { return $tlen; } else { return $olen; } } else { return $tlen; } } sub data_precision { my ($self, $tName, $cName) = @_; if ($self->{'flavor'} ne "RDB") { return $self->columnAttribute ($tName, $cName, "data_precision"); } # Here for RDB my ($linkName) = $self->{'linkName'}; my ($relationID) = $self->rdbRelationID ($tName); my ($stmt) = "SELECT rdb\$field_type, rdb\$field_length FROM " . "rdb\$field_versions$linkName " . "WHERE rdb\$relation_id=$relationID and " . "rdb\$field_name=" . $self->quoteUC ($cName); my ($result) = $self->fetchSingle ($stmt); my ($tcode) = $result->[0]; my ($tlen) = $result->[1]; # Remove unexpected leading spaces, # then look up the precision of the corresponding Oracle data type # in our master RDB->Oracle map. $tcode =~ s/\s//g; $tlen =~ s/\s//g; my ($map) = $OraConnection::rdb_map {$tcode}; if ($map) { my ($olen) = $map->{'data_precision'}; if ($olen eq "fld_len") { return $tlen; } else { return $olen; } } else { return $tlen; } } sub data_scale { my ($self, $tName, $cName) = @_; if ($self->{'flavor'} ne "RDB") { return $self->columnAttribute ($tName, $cName, "data_scale"); } # Here for RDB my ($linkName) = $self->{'linkName'}; my ($relationID) = $self->rdbRelationID ($tName); my ($stmt) = "SELECT rdb\$field_type FROM " . "rdb\$field_versions$linkName " . "WHERE rdb\$relation_id=$relationID and " . "rdb\$field_name=" . $self->quoteUC ($cName); my ($result) = $self->fetchSingle ($stmt); my ($tcode) = $result->[0]; # Remove unexpected leading spaces, # then look up the scale of the corresponding Oracle data type # in our master RDB->Oracle map. $tcode =~ s/\s//g; my ($map) = $OraConnection::rdb_map {$tcode}; if ($map) { return $map->{'data_scale'}; } else { return 0; } } # Service routine used internally to return the ID of a relation (table). sub rdbRelationID { my ($self, $tName) = @_; my ($linkName) = $self->{'linkName'}; my ($stmt) = "SELECT rdb\$relation_id FROM rdb\$relations$linkName " . "WHERE rdb\$relation_name=" . $self->quoteUC ($tName); my ($result) = $self->fetchSingle ($stmt); return $result->[0]; } ################################################################################ # # Key and Index Methods # # This section implements methods which return information on # primary and foreign key constraints. # ################################################################################ # Return a reference to a list of primary key names in a given table. # The table name is case insensitive, unless it is enclosed in double quotes. # If the table does not exist, an SQL error is triggered. sub primaryKeyNames { my ($self, $tableName) = @_; my ($schemaName) = $self->{'schemaName'}; my ($linkName) = $self->{'linkName'}; my ($stmt) = "SELECT constraint_name FROM " . "user_constraints$linkName " . "WHERE " . "user_constraints.constraint_type = 'P' and " . "user_constraints.status = 'ENABLED' and " . "user_constraints.table_name = " . $self->quoteUC ($tableName); if ($schemaName) { $stmt = "SELECT constraint_name FROM " . "all_constraints$linkName " . "WHERE " . "all_constraints.owner = " . $self->quote ($schemaName) . " and " . "all_constraints.constraint_type = 'P' and " . "all_constraints.status = 'ENABLED' and " . "all_constraints.table_name = " . $self->quoteUC ($tableName); } if ($self->{'flavor'} eq "RDB") { $stmt = "SELECT rdb\$constraint_name FROM " . "rdb\$relation_constraints$linkName " . "WHERE " . "rdb\$relation_name = " . $self->quoteUC ($tableName) . " and " . "rdb\$constraint_type = 2"; } my ($rows, $rowCount) = $self->fetchAll ($stmt); # Copy the first (only) column value in each record into a new # anonymous list. my ($result) = []; my ($record); foreach $record (@$rows) { my ($conName) = $record->[0]; $conName =~ s/\s//g; # Strip blanks from RDB push @$result, $conName; } return $result; } # Return a reference to a list of foreign key names in a given table. # The table name is case insensitive, unless it is enclosed in double quotes. # If the table does not exist, an SQL error is triggered. sub foreignKeyNames { my ($self, $tableName) = @_; my ($schemaName) = $self->{'schemaName'}; my ($linkName) = $self->{'linkName'}; my ($stmt) = "SELECT constraint_name FROM " . "user_constraints$linkName " . "WHERE " . "user_constraints.constraint_type = 'R' and " . "user_constraints.status = 'ENABLED' and " . "user_constraints.table_name = " . $self->quoteUC ($tableName); if ($schemaName) { $stmt = "SELECT constraint_name FROM " . "all_constraints$linkName " . "WHERE " . "all_constraints.owner = " . $self->quote ($schemaName) . " and " . "all_constraints.constraint_type = 'R' and " . "all_constraints.status = 'ENABLED' and " . "all_constraints.table_name = " . $self->quoteUC ($tableName); } if ($self->{'flavor'} eq "RDB") { $stmt = "SELECT rdb\$constraint_name FROM " . "rdb\$relation_constraints$linkName " . "WHERE " . "rdb\$relation_name = " . $self->quoteUC ($tableName) . " and " . "rdb\$constraint_type = 3"; } my ($rows, $rowCount) = $self->fetchAll ($stmt); # Copy the first (only) column value in each record into a new # anonymous list. my ($result) = []; my ($record); foreach $record (@$rows) { my ($conName) = $record->[0]; $conName =~ s/\s//g; # Strip blanks from RDB push @$result, $conName; } return $result; } # Return a reference to a list of index names for indices in a given table. # The table name is case insensitive, unless it is enclosed in double quotes. # If the table does not exist, an SQL error is triggered. sub indexNames { my ($self, $tableName) = @_; my ($schemaName) = $self->{'schemaName'}; my ($linkName) = $self->{'linkName'}; my ($stmt) = "SELECT DISTINCT index_name FROM " . "user_ind_columns$linkName " . "WHERE " . "user_ind_columns.table_name = " . $self->quoteUC ($tableName); if ($schemaName) { $stmt = "SELECT DISTINCT index_name FROM " . "all_ind_columns$linkName " . "WHERE " . "index_owner = " . $self->quote ($schemaName) . " and " . "table_owner = " . $self->quote ($schemaName) . " and " . "table_name = " . $self->quoteUC ($tableName) . " ORDER BY index_name"; # print $stmt, "\n"; } if ($self->{'flavor'} eq "RDB") { $stmt = "SELECT rdb\$index_name FROM " . "rdb\$indices$linkName " . "WHERE " . "rdb\$relation_name = " . $self->quoteUC ($tableName); } my ($rows, $rowCount) = $self->fetchAll ($stmt); # Copy the first (only) column value in each record into a new # anonymous list. my ($result) = []; my ($record); foreach $record (@$rows) { my ($idxName) = $record->[0]; $idxName =~ s/\s//g; # Strip blanks from RDB push @$result, $idxName; } return $result; } # Position of the given column in the primary key of the given table. # Returns undef if the column is not part of the primary key of the table. # Otherwise, returns the 1-based index of its position in the primary key. sub primaryKeyPosition { my ($self, $tName, $cName) = @_; my ($schemaName) = $self->{'schemaName'}; my ($linkName) = $self->{'linkName'}; my ($stmt) = "SELECT position FROM " . "user_cons_columns$linkName, user_constraints$linkName " . "WHERE " . "user_constraints.constraint_type = 'P' and " . "user_constraints.status = 'ENABLED' and " . "user_constraints.table_name = " . $self->quoteUC ($tName) . " and " . "user_cons_columns.table_name = " . $self->quoteUC ($tName) . " and " . "user_cons_columns.column_name = " . $self->quoteUC ($cName) . " and " . "user_cons_columns.constraint_name = " . "user_constraints.constraint_name"; if ($schemaName) { $stmt = "SELECT position FROM " . "all_cons_columns$linkName, all_constraints$linkName " . "WHERE " . "all_constraints.owner = " . $self->quote ($schemaName) . " and " . "all_constraints.constraint_type = 'P' and " . "all_constraints.status = 'ENABLED' and " . "all_constraints.table_name = " . $self->quoteUC ($tName) . " and " . "all_cons_columns.owner = " . $self->quote ($schemaName) . " and " . "all_cons_columns.table_name = " . $self->quoteUC ($tName) . " and " . "all_cons_columns.column_name = " . $self->quoteUC ($cName) . " and " . "all_cons_columns.constraint_name = " . "all_constraints.constraint_name"; } if ($self->{'flavor'} eq "RDB") { my ($pkNames) = $self->primaryKeyNames ($tName); if (! $pkNames) { return undef; } my ($pkName) = $pkNames->[0]; if (! $pkName) { return undef; } $stmt = "SELECT rdb\$field_position FROM " . "rdb\$relation_constraint_flds$linkName " . "WHERE " . "rdb\$constraint_name = " . $self->quote ($pkName) . " and " . "rdb\$field_name = " . $self->quoteUC ($cName); } my ($rows, $rowCount) = $self->fetchAll ($stmt); if (! $rowCount) { return undef; } my ($record) = $rows->[0]; my ($position) = $record->[0]; $position =~ s/\s//g; return $position; } # Given the name of a primary key (see primaryKeyNames), # return a reference to a list of column names which make up # the primary key, in order of their position. # If the primary key does not exist, an SQL error is triggered. sub primaryKeyColumnNames { my ($self, $pkName) = @_; my ($result) = []; my ($schemaName) = $self->{'schemaName'}; my ($linkName) = $self->{'linkName'}; my ($stmt) = "SELECT column_name FROM " . "user_cons_columns$linkName " . "WHERE " . "user_cons_columns.constraint_name = " . $self->quoteUC ($pkName) . " " . "ORDER BY position"; if ($schemaName) { $stmt = "SELECT column_name FROM " . "all_cons_columns$linkName " . "WHERE " . "all_cons_columns.owner = " . $self->quote ($schemaName) . " and " . "all_cons_columns.constraint_name = " . $self->quoteUC ($pkName) . " " . "ORDER BY position"; } if ($self->{'flavor'} eq "RDB") { $stmt = "SELECT rdb\$field_name FROM " . "rdb\$relation_constraint_flds$linkName " . "WHERE " . "rdb\$constraint_name = " . $self->quoteUC ($pkName); } my ($rows, $rowCount) = $self->fetchAll ($stmt); # Copy the first (only) column value in each record into a new # anonymous list. my ($record); foreach $record (@$rows) { my ($conName) = $record->[0]; $conName =~ s/\s//g; # Strip blanks from RDB push @$result, $conName; } return $result; } # Given the name of a foreign key (see foreignKeyNames), # return a reference to a list of column names which make up # the foreign key, in order of their position. # If the foreign key does not exist, an SQL error is triggered. sub foreignKeyColumnNames { my ($self, $fkName) = @_; my ($schemaName) = $self->{'schemaName'}; my ($linkName) = $self->{'linkName'}; my ($stmt) = "SELECT column_name FROM " . "user_cons_columns$linkName " . "WHERE " . "user_cons_columns.constraint_name = " . $self->quoteUC ($fkName) . " " . "ORDER BY position"; if ($schemaName) { $stmt = "SELECT column_name FROM " . "all_cons_columns$linkName " . "WHERE " . "all_cons_columns.owner = " . $self->quote ($schemaName) . " and " . "all_cons_columns.constraint_name = " . $self->quoteUC ($fkName) . " " . "ORDER BY position"; } if ($self->{'flavor'} eq "RDB") { $stmt = "SELECT rdb\$field_name FROM " . "rdb\$relation_constraint_flds$linkName " . "WHERE " . "rdb\$constraint_name = " . $self->quoteUC ($fkName); } my ($rows, $rowCount) = $self->fetchAll ($stmt); # Copy the first (only) column value in each record into a new # anonymous list. my ($result) = []; my ($record); foreach $record (@$rows) { my ($conName) = $record->[0]; $conName =~ s/\s//g; # Strip blanks from RDB push @$result, $conName; } return $result; } # Given the name of a foreign key (see foreignKeyNames), # return the target (R_CONSTRAINT_NAME) of the foreign key. # This is typically the name of a primary key. # If the foreign key does not exist, an SQL error is triggered. sub foreignKeyTarget { my ($self, $fkName) = @_; my ($schemaName) = $self->{'schemaName'}; my ($linkName) = $self->{'linkName'}; my ($stmt) = "SELECT r_constraint_name FROM " . "user_constraints$linkName " . "WHERE " . "user_constraints.constraint_name = " . $self->quoteUC ($fkName); if ($schemaName) { $stmt = "SELECT r_constraint_name FROM " . "all_constraints$linkName " . "WHERE " . "all_constraints.owner = " . $self->quote ($schemaName) . " and " . "all_constraints.constraint_name = " . $self->quoteUC ($fkName); } if ($self->{'flavor'} eq "RDB") { $stmt = "SELECT rdb\$refd_constraint_name FROM " . "rdb\$relation_constraints$linkName " . "WHERE " . "rdb\$constraint_name = " . $self->quoteUC ($fkName); } my ($result) = $self->fetchSingle ($stmt); my ($fkTarget) = $result->[0]; $fkTarget =~ s/\s//g; return $fkTarget; } # Given the name of a index (see indexNames), # return a reference to a list of column names which make up # the index, in order of their position. # If the index does not exist, an SQL error is triggered. sub indexColumnNames { my ($self, $idxName) = @_; my ($schemaName) = $self->{'schemaName'}; my ($linkName) = $self->{'linkName'}; my ($stmt) = "SELECT column_name FROM " . "user_ind_columns$linkName " . "WHERE " . "user_ind_columns.index_name = " . $self->quoteUC ($idxName) . " " . "ORDER BY column_position"; if ($schemaName) { $stmt = "SELECT column_name FROM " . "all_ind_columns$linkName " . "WHERE " . "table_owner = " . $self->quote ($schemaName) . " and " . "index_name = " . $self->quoteUC ($idxName) . " " . "ORDER BY column_position"; } if ($self->{'flavor'} eq "RDB") { $stmt = "SELECT rdb\$field_name FROM " . "rdb\$index_segments$linkName " . "WHERE " . "rdb\$index_name = " . $self->quoteUC ($idxName); } my ($rows, $rowCount) = $self->fetchAll ($stmt); # Copy the first (only) column value in each record into a new # anonymous list. my ($result) = []; my ($record); foreach $record (@$rows) { my ($idxName) = $record->[0]; $idxName =~ s/\s//g; # Strip blanks from RDB push @$result, $idxName; } return $result; } # Given the name of a index (see indexNames), # return the UNIQUENESS setting for the index. # This is typically the string "UNIQUE" or "NONUNIQUE". # If the index does not exist, an SQL error is triggered. sub indexUnique { my ($self, $idxName) = @_; my ($schemaName) = $self->{'schemaName'}; my ($linkName) = $self->{'linkName'}; my ($stmt) = "SELECT uniqueness FROM " . "user_indexes$linkName " . "WHERE " . "user_indexes.index_name = " . $self->quoteUC ($idxName); if ($schemaName) { $stmt = "SELECT uniqueness FROM " . "all_indexes$linkName " . "WHERE " . "table_owner = " . $self->quote ($schemaName) . " and " . "index_name = " . $self->quoteUC ($idxName); } if ($self->{'flavor'} eq "RDB") { $stmt = "SELECT rdb\$unique_flag FROM " . "rdb\$indices$linkName " . "WHERE " . "rdb\$index_name = " . $self->quoteUC ($idxName); my ($result) = $self->fetchSingle ($stmt); my ($flag) = $result->[0]; $flag =~ s/\s//g; # Strip blanks from RDB return $flag ? "UNIQUE" : "NONUNIQUE"; } my ($result) = $self->fetchSingle ($stmt); return $result->[0]; } # Position of the given column in the primary key of the given table. # Returns undef if the column is not part of the primary key of the table. # Otherwise, returns the 1-based index of its position in the primary key. sub constraintCheckText { my ($self, $tName, $cName) = @_; my ($schemaName) = $self->{'schemaName'}; my ($linkName) = $self->{'linkName'}; my ($stmt) = "SELECT search_condition FROM " . "user_cons_columns$linkName, user_constraints$linkName " . "WHERE " . "user_constraints.constraint_type = 'C' and " . "user_constraints.status = 'ENABLED' and " . "user_constraints.table_name = " . $self->quoteUC ($tName) . " and " . "user_cons_columns.table_name = " . $self->quoteUC ($tName) . " and " . "user_cons_columns.column_name = " . $self->quoteUC ($cName) . " and " . "user_cons_columns.constraint_name = " . "user_constraints.constraint_name"; my ($rows, $rowCount) = $self->fetchAll ($stmt); if (! $rowCount) { return undef; } my ($record) = $rows->[0]; my ($checkText) = $record->[0]; $checkText =~ s/^.*IS NOT NULL//; $checkText =~ s/^.* in \(/in \(/; return $checkText; } # Returns a given attribute of a named column in a named table. # The table name, column name, and attrubute are case insensitive. # If the table, column, or attribute do not exist, an SQL error is triggered. sub columnAttribute { my ($self, $tableName, $columnName, $attribute) = @_; # RDB cannot deal with accesses to the user_tab_columns or # all_tab_columns table through the Transparant Gateway. if ($self->{'flavor'} eq "RDB") { return undef; } # Look up this attribute in the USER_TAB_COLUMNS table. my ($schemaName) = $self->{'schemaName'}; my ($linkName) = $self->{'linkName'}; my ($stmt) = "SELECT $attribute FROM user_tab_columns$linkName " . "WHERE table_name=" . $self->quoteUC ($tableName) . " and " . "column_name=" . $self->quoteUC ($columnName); if ($schemaName) { $stmt = "SELECT $attribute FROM all_tab_columns$linkName " . "WHERE owner=" . $self->quote ($schemaName) . " and " . "table_name=" . $self->quoteUC ($tableName) . " and " . "column_name=" . $self->quoteUC ($columnName); } my ($result) = $self->fetchSingle ($stmt); return $result->[0]; } ################################################################################ # # SQL Query Execution - Single execute style # # This section implements a once-only style of query execution. # NO subsequent finish() method call is needed for these routines. # ################################################################################ # Once-only execution of a statement. # Useful for SQL INSERT, UPDATE, etc type of queries. # On failure, perform fatal processing. sub exec { my ($self, $statement) = @_; my ($sth) = $self->execMulti ($statement); $sth->finish || $self->fatal ("Can't finish"); } # Convenience routine to execute a stored procedure call once. # Tacks on the obligatory BEGIN and END around the procedure call itself. # On failure, perform fatal processing. sub execStoredProcedure { my ($self, $procedureInvocation) = @_; $procedureInvocation =~ s/; *$//; my ($statement) = "BEGIN " . $procedureInvocation . "; END;"; $self->exec ($statement); } # Once-only execution of a query. # # Returns the entire result set of a query as an array reference. # The array contains zero or more array references, each of which represents # one row of the result. Each result array/row holds the field values. # # If the 'get_col_names' param is set, it will return the column names of the # columns returned in the first row. # # For example, if the resulting rows of "SELECT name, consort FROM KINGS" is: # henry, joan # henry, marie-gallant # # the resulting anonymous hash would be: # [ [ "henry", "joan" ], [ "henry", "marie-gallant" ] ] # # As a convenience, this routine returns the count of records/rows returned. # # For example, the following will fetch a ref to a list (and count) of # the tables in the database. # # my ($rows, $rowCount) = $connection->fetchAll ( # "SELECT * FROM user_tables"); # # This method is potentially a huge memory hog. # "Hello Sun? Yea, we need summore of those reeeely big servers" sub fetchAll { my ($self, $query, $get_col_names) = @_; my ($sth) = $self->execMulti ($query); # Fetch an array with all the resulting rows my ($resultRows) = []; # DOES NOT WORK!!! The fetchall_arrayref does not seem to be # present in the Oracle DBD!! # $resultRows = $sth->fetchall_arrayref; # Build the result array ourselves. my ($rowCount) = 0; my ($singleRow); # Build the result array ourselves. if ($get_col_names) { my ($nfields) = $sth->{NUM_OF_FIELDS}; my ($result) = []; my ($f); for ($f = 0; $f < $nfields; $f++) { push @$result, $sth->{NAME}->[$f]; } push @$resultRows, $result; $rowCount++; } while ($singleRow = $sth->fetch) { my ($localRow) = []; my ($fieldValue); foreach $fieldValue (@$singleRow) { push @$localRow, $fieldValue; } push @$resultRows, $localRow; $rowCount++; } # And a fine meal it was $sth->finish || $self->fatal ("Can't finish"); return ($resultRows, $rowCount); } # Similar to fetchAll(), but returns only those rows within the range specified. # # It is a way to guard against the potentially unlimited data returned # by fetchAll(). It is particularly well suited to the Web style of fetching # a "page" of data, then having "NEXT" and "PREV" page links. # # The $firstRow and $lastRow are the 0-based indices of the first and last # result row to return. # If $firstRow is undef or less than 0, it assumed to be 0. # If $lastRow is undef, all rows from $firstRow to the end are returned. # # This routine returns the same array reference as the first returned # element of fetchAll(), except that the returned arrayref has # the first $firstRow elements missing, and never # has more than $lastRow-$firstRow+1 elements. # # This routine does not return the total $rowCount (as does fetchAll()). # Use the rowCountOfQuery() method to get the total row count, if needed. sub fetchRange { my ($self, $query, $firstRow, $lastRow) = @_; my ($sth) = $self->execMulti ($query); # Skip unwanted rows my ($rowCount) = 0; while (($rowCount < $firstRow) && $sth->fetch) { $rowCount++; } # Fetch an array with the resulting rows in the range. my ($resultRows) = []; my ($singleRow); while (($rowCount <= $lastRow) && ($singleRow = $sth->fetch)) { my ($localRow) = []; my ($fieldValue); foreach $fieldValue (@$singleRow) { push @$localRow, $fieldValue; } push @$resultRows, $localRow; $rowCount++; } $sth->finish || $self->fatal ("Can't finish"); # Here when we've read in all the rows in the range OR # we've run out of rows. return $resultRows; } # Once-only execution of a query which should yield exactly one result row. # # Returns a reference to an anonymous array which holds the fields values # of the single result row. # # If you don't get exactly one row, it complains and return undef. sub fetchSingle { my ($self, $query, $noComplainMissing, $noComplainMulti) = @_; my ($sth) = $self->execMulti ($query); # Fetch the pointer to the DBI result my ($singleRow); $singleRow = $sth->fetch; if (! defined ($singleRow)) { unless ($noComplainMissing) { $self->warn ("Expected row count=1, " . "actual count=0, query='$query'"); } $sth->finish || $self->fatal ("Can't finish"); return undef; } # Build the result array my ($resultRow) = []; my ($fieldValue); foreach $fieldValue (@$singleRow) { push @$resultRow, $fieldValue; } # Check if there are more rows. my ($nextRow); if ($nextRow = $sth->fetch) { unless ($noComplainMulti) { $self->warn ("Expected single row, got multiple rows."); # Extended debugging $self->warn ("query: '$query'\n"); } my ($row) = 1; printf "row=%3d ", $row++; print "cols=", scalar (@$resultRow), " "; foreach $fieldValue (@$resultRow) { print $fieldValue, " "; } print "\n"; printf "row=%3d ", $row++; print "cols=", scalar (@$nextRow), " "; foreach $fieldValue (@$nextRow) { print $fieldValue, " "; } print "\n"; while ($nextRow = $sth->fetch) { print "row=%3d ", $row++; print "cols=", scalar (@$nextRow), " "; foreach $fieldValue (@$nextRow) { print $fieldValue, " "; } print "\n"; } $sth->finish || $self->fatal ("Can't finish"); return undef; } $sth->finish || $self->fatal ("Can't finish"); return $resultRow; } # Return the number of rows in a given table. sub rowCount { my ($self, $tableName) = @_; return $self->matchingRowCount ($tableName); } # Return the number of rows in a given table where the given field(s) match # the given value(s). # # Returns the count of matching rows. sub matchingRowCount { my ($self, $tableName, $field1, $value1, %moreFieldPairs) = @_; my ($schemaName) = $self->{'schemaName'}; my ($schema) = $schemaName ? $schemaName . "." : ""; my ($linkName) = $self->{'linkName'}; my ($stmt) = "SELECT count(*) FROM $schema$tableName$linkName"; # Qualify the search with an (optional) field/value pair if ($field1) { $stmt .= " WHERE " . $field1 . "=" . $self->quote ($value1); } # Tack on any addition field/value pairs my ($field, $value); foreach $field (keys %moreFieldPairs) { $stmt .= " and " . $field . "=" . $self->quote ($moreFieldPairs{$field}); } # Fetch the single-row, single-value result my ($result) = $self->fetchSingle ($stmt); return $result->[0]; } # Return the number of which will match a given SELECT query. # The $query MUST begin with the form: # # "SELECT field1 {, fieldN} FROM ..." # # Note that the SELECT and FROM MUST BE ALL CAPITALS # # This method basically issues a query of the form: # # "SELECT count(*) FROM ..." # # and returns the count of matching rows. sub rowCountOfQuery { my ($self, $query) = @_; # Hack the query into a count(*) query $query =~ s/SELECT.*FROM/SELECT count(*) FROM/ || $self->fatal ("Query '$query' " . "must begin with 'SELECT ... FROM'"); # Just a bit more hacking - strip off any ORDER BY clause $query =~ s/ORDER BY.*$//; # Fetch the single-row, single-value result my ($result) = $self->fetchSingle ($query); return $result->[0]; } # Return the current value of a given named sequence number in the database. sub currval { my ($self, $sequenceName) = @_; # This sometimes fails if you have not yet worked with the # sequence in this session. # my ($schemaName) = $self->{'schemaName'}; my ($schema) = $schemaName ? $schemaName . "." : ""; my ($linkName) = $self->{'linkName'}; my ($stmt) = "SELECT " . $sequenceName . ".currval FROM " . $schema . "DUAL$linkName"; # This version seems more robust: #my ($stmt) = "SELECT last_number FROM USER_SEQUENCES " . # "WHERE sequence_name = " . $self->quote ($sequenceName); # Fetch the single-row, single-value result my ($result) = $self->fetchSingle ($stmt); return $result->[0]; } # Return the next value of a given named sequence number in the database, # AND INCREMENT THE SEQUENCE. sub nextval { my ($self, $sequenceName) = @_; my ($schemaName) = $self->{'schemaName'}; my ($schema) = $schemaName ? $schemaName . "." : ""; my ($linkName) = $self->{'linkName'}; my ($stmt) = "SELECT " . $sequenceName . ".nextval FROM " . $schema . "DUAL$linkName"; # Fetch the single-row, single-value result my ($result) = $self->fetchSingle ($stmt); return $result->[0]; } # Return the minimum value of a given named sequence number in the database. sub minValue { my ($self, $sequenceName) = @_; my ($schemaName) = $self->{'schemaName'}; my ($linkName) = $self->{'linkName'}; my ($stmt) = "SELECT min_value FROM USER_SEQUENCES$linkName " . "WHERE sequence_name = " . $self->quote ($sequenceName); if ($schemaName) { $stmt = "SELECT min_value FROM ALL_SEQUENCES$linkName " . "WHERE sequence_name = " . $self->quote ($sequenceName) . " and " . "sequence_owner = " . $self->quote ($schemaName); } # Fetch the single-row, single-value result my ($result) = $self->fetchSingle ($stmt); return $result->[0]; } # Return the maximum value of a given named sequence number in the database. sub maxValue { my ($self, $sequenceName) = @_; my ($schemaName) = $self->{'schemaName'}; my ($linkName) = $self->{'linkName'}; my ($stmt) = "SELECT max_value FROM USER_SEQUENCES$linkName " . "WHERE sequence_name = " . $self->quote ($sequenceName); if ($schemaName) { $stmt = "SELECT max_value FROM ALL_SEQUENCES$linkName " . "WHERE sequence_name = " . $self->quote ($sequenceName) . " and " . "sequence_owner = " . $self->quote ($schemaName); } # Fetch the single-row, single-value result my ($result) = $self->fetchSingle ($stmt); return $result->[0]; } # Return the increment of a given named sequence number in the database. sub incrementBy { my ($self, $sequenceName) = @_; my ($schemaName) = $self->{'schemaName'}; my ($linkName) = $self->{'linkName'}; my ($stmt) = "SELECT increment_by FROM USER_SEQUENCES$linkName " . "WHERE sequence_name = " . $self->quote ($sequenceName); if ($schemaName) { $stmt = "SELECT increment_by FROM ALL_SEQUENCES$linkName " . "WHERE sequence_name = " . $self->quote ($sequenceName) . " and " . "sequence_owner = " . $self->quote ($schemaName); } # Fetch the single-row, single-value result my ($result) = $self->fetchSingle ($stmt); return $result->[0]; } # Return the table_owner of a given named synonym number in the database. sub table_owner_of_synonym { my ($self, $synonymName) = @_; my ($schemaName) = $self->{'schemaName'}; my ($linkName) = $self->{'linkName'}; my ($stmt) = "SELECT table_owner FROM USER_SYNONYMS$linkName " . "WHERE synonym_name = " . $self->quote ($synonymName); # Fetch the single-row, single-value result my ($result) = $self->fetchSingle ($stmt); return $result->[0]; } # Return the table_name of a given named synonym number in the database. sub table_name_of_synonym { my ($self, $synonymName) = @_; my ($schemaName) = $self->{'schemaName'}; my ($linkName) = $self->{'linkName'}; my ($stmt) = "SELECT table_name FROM USER_SYNONYMS$linkName " . "WHERE synonym_name = " . $self->quote ($synonymName); # Fetch the single-row, single-value result my ($result) = $self->fetchSingle ($stmt); return $result->[0]; } # Fetch a given field value from a matching record # # No check is made as to how many matching result rows exist. # If there is more than one result row, you get an result field value # from an arbitrary one of the matching rows. # Use of ROWID will avoid this problem. For example: # # $result = $dbc->get ("MY_TABLE", "RESULT", "ROWID", $theRowID); # # The arguments after $resultField are fieldName/value pairs which must # be matched by the column values. A value of undef or "IS_NULL" # for a value will generate an "is NULL" check in the corresponding column. # # The resultField argument can name a field of data type LONG or LONG RAW. # In this case, the entire field value is returned in a single # perl string object. This get() method is currently the only way to # read LONG and LONG RAW fields from an Oracle database. Large objects # cannot be accessed from an RDB database in this manner. sub get { my ($self, $tableName, $resultField, $field1, $value1, %moreFieldPairs) = @_; my ($schemaName) = $self->{'schemaName'}; my ($schema) = $schemaName ? $schemaName . "." : ""; my ($linkName) = $self->{'linkName'}; my ($dataType) = $self->data_type ($tableName, $resultField); my ($stmt) = "SELECT " . $resultField . " FROM $schema$tableName$linkName"; # Qualify the search with an (optional) field/value pair if ($field1) { if (defined ($value1) && ($value1 ne "IS_NULL")) { $stmt .= " WHERE " . $field1 . "=" . $self->quote ($value1); } else { $stmt .= " WHERE " . $field1 . " is NULL"; } } # Tack on any addition field/value pairs my ($field, $value); foreach $field (keys %moreFieldPairs) { my ($val) = $moreFieldPairs{$field}; if (defined ($val) && ($val ne "IS_NULL")) { $stmt .= " and " . $field . "=" . $self->quote ($val); } else { $stmt .= " and " . $field . " is NULL"; } } my ($sth) = $self->execMulti ($stmt); my ($resultValue); if (($dataType eq "LONG") || ($dataType eq "LONG RAW")) { # A large character (CLOB) or large binary (BLOB) object! # print "1: $stmt\n"; # Prevent low-level warnings from being issued # on truncation errors. $sth->{'LongTruncOk'} = 1; my (@data); @data = $sth->fetch (); if ($DBD::Oracle::ora_errno) { $self->warn ( "LONG fetch error: $DBD::Oracle::ora_errstr"); } my ($lumpSize) = 32768; my ($offset) = 0; while (1) { # Get the LONG value a "lump" at a time and use # the lump to build the string. my ($lump); $lump = $sth->blob_read (0, $offset, $lumpSize); if ($DBD::Oracle::ora_errno) { $self->warn ( "blob_read error: $DBD::Oracle::ora_errstr"); } my ($lumpLength) = length ($lump); last unless defined $lump; last unless $lumpLength; # print "fetched '$lump'\n"; $resultValue .= $lump; $offset += $lumpLength; } } else { # Fetch one row and get the value of the resultField $sth->bind_columns (undef, \($resultValue)) || $self->fatal ("Can't bind_columns"); my ($singleRow); $singleRow = $sth->fetch; if (! defined ($singleRow)) { return undef; } if ($DBI::err) { $self->warn ("Failure to issue fetch"); } } $sth->finish || $self->fatal ("Can't finish"); return $resultValue; } # Insert a row with a single LONG or LONG RAW field value. # # A field of type LONG is available in Oracle 7 and later for handling up to # 2 gigabytes of character data. LONG RAW is used for up to # 2 gigabytes of binary data. # # The statement must be of the form: # # INSERT INTO (field1, field2, ..., longField) # values ('val1', 'val2', ..., :MARKER) # # where the field of type LONG or LONG RAW is named last and :MARKER # is a token which MUST begin with a colon character. # # The call to insertLong() or insertLongRaw() inserts a single record. # The value for the LONG or LONG RAW field is supplied as a # single perl string. # # For example: # # $stmt = "INSERT INTO mytable (key, longField) values ('a', :MyMarker)"; # $dbc->insertLong ($stmt, ":MyMarker", $reallyReallyLongValue); # # These insertLong() and insertLongRaw() methods are currently the # only way to set a LONG or LONG RAW field. # Large objects in an RDB database cannot be set in this manner. sub insertLong { my ($self, $statement, $marker, $bigValue) = @_; $self->insertLongParameterized ($statement, 8, $marker, $bigValue); } sub insertLongRaw { my ($self, $statement, $marker, $bigValue) = @_; $self->insertLongParameterized ($statement, 24, $marker, $bigValue); } sub insertLongParameterized { my ($self, $statement, $oracleTypeCode, $marker, $bigValue) = @_; my (%attrib); $attrib{'ora_type'} = $oracleTypeCode; # print "1: $statement\n"; my ($dbh) = $self->{'dbh'}; my ($sth) = $dbh->prepare ($statement); $sth->bind_param ($marker, $bigValue, \%attrib); my ($rc) = $sth->execute; if (! defined ($rc)) { $self->fatal ("Can't exec $statement"); } $sth->finish || $self->fatal ("Can't finish"); } ################################################################################ # # Table Dump and Import # # This section implements multi-row and full table operations. # ################################################################################ # Siphon a given table from a given (other) OraConnect object into # a given table in this database, mapping the column names. # NOTE: all tab characters are removed from field value! sub dumpTable { my ($self, $fileName, $tableName, $optionalWhereClause, $maxRowCount, @specificFieldList) = @_; my ($fieldList) = "*"; if (scalar @specificFieldList) { $fieldList = join ", ", @specificFieldList; } my ($schemaName) = $self->{'schemaName'}; my ($schema) = $schemaName ? $schemaName . "." : ""; my ($linkName) = $self->{'linkName'}; my ($stmt) = "SELECT $fieldList FROM $schema$tableName$linkName " . $optionalWhereClause; my ($sth) = $self->execMulti ($stmt); my ($fh) = new FileHandle; if (! $fh->open ("> " . $fileName)) { $self->fatal ("Can't open $fileName for writing"); return; } print $fh "# Dump of table $tableName", " from database ", $self->{'databaseName'}, " as user ", $self->{'username'}, "\n"; print $fh "# Date: ", `date`; print $fh "# Query: $stmt\n"; my ($nfields) = $sth->{NUM_OF_FIELDS}; my ($f); for ($f = 0; $f < $nfields; $f++) { print $fh ($f ? "\t" : "#"), $sth->{NAME}->[$f]; } print $fh "\n"; my (@fieldList, $i); while (@fieldList = $sth->fetchrow_array) { for ($f = 0; $f < $nfields; $f++) { if ($f) { print $fh "\t"; } my ($fval) = $fieldList[$f]; $fval =~ s/\t//g; print $fh $fval; } print $fh "\n"; $i++; if ($maxRowCount && ($i > $maxRowCount)) { last; } } if ($DBI::err) { $self->warn ("Failure to issue fetchrow_array"); } $sth->finish || $self->fatal ("Can't finish"); } ################################################################################ # # Low-level error handling routines # ################################################################################ # Issue a database warning. Several call formats are supported: # # warn "Can't do what I want"; # Issue complaint with DBI:: data # warn $dbh, "Can't do what I want"; # Issue complaint with $dbh-> data sub warn { my ($self, $arg1, $arg2) = @_; $self->_kvetch ("warning", 0, 0, $arg1, $arg2); } # Death due to database error # Same args as warn sub fatal { my ($self, $arg1, $arg2) = @_; $self->_kvetch ("fatalError", 1, 1, $arg1, $arg2); } sub sqlError { my ($self, $arg1, $arg2) = @_; $self->_kvetch ("sqlError", 1, 1, $arg1, $arg2); } sub systemError { my ($self, $arg1, $arg2) = @_; $self->_kvetch ("systemError", 1, 1, $arg1, $arg2); } sub trace { my ($self, $arg1, $arg2) = @_; $self->_kvetch ("DB Trace", 1, 0, $arg1, $arg2); } # Common (private) error handling routine sub _kvetch { my ($self, $severity, $verbose, $dieAfterComplaining, $arg1, $arg2) = @_; my ($dbh, $complaint); my ($errstr); # Error message from underlying DBD driver my ($err); # Error code from underlying DBD driver my ($state); # SQLSTATE 5-char code if (defined ($arg2)) { # format: warn/fatal $dbh, $complaint $dbh = $arg1; $complaint = $arg2; $errstr = $dbh->errstr; $err = $dbh->err; $state = $dbh->state; } else { # format: warn/fatal $complaint $complaint = $arg1; $errstr = $DBI::errstr; $err = $DBI::err; $state = $DBI::state; } if (!$complaint) { $complaint = "Database error"; } my ($format) = $self->{'msgFormat'}; my ($html) = ($format eq "html"); my ($eol) = "\n"; if ($html) { $eol = "
\n"; } my ($msg); $msg .= "*** " . $severity . ": " . $complaint . $eol; $msg .= " " . $errstr . $eol; $msg .= " Error code: " . $err . $eol; $msg .= " SQLSTATE: " . $state . $eol; $msg .= " Driver: " . $self->{'driverName'} . $eol; $msg .= " Database name: " . $self->{'databaseName'} . $eol; $msg .= " User name: " . $self->{'username'} . $eol; # And now for some context my ($package, $file, $line) = caller; $msg .= " Location: File $file, package $package, at line $line$eol"; if ($verbose) { # Stack frame - very detailed info my ($stackFrame) = 0; my ($subname, $hashargs, $wantarray); if ($html) { $msg .= "
\n"; }
		$msg .=
"\n" .
"  Frame                                                                Wantarray\n" .
"  vv File                         Line Package::Subroutine                Hash |\n" .
"\n";
		while (($package, $file, $line, $subname,
				$hashargs, $wantarray) =
						caller ($stackFrame++)) {

			$msg .= sprintf (
				"  %2d %-28s %4d %-37s %1d %1d\n",
				$stackFrame, $file, $line,
				$subname, $hashargs, $wantarray);
		}
		$msg .= "\n";

		# For html output, we add precautionary end-of-table
		# tags so that any open table will be closed.
		# Without this, some browser show absolutely not text!

		if ($html) { $msg .= "
\n"; } } my ($handlerClass) = $self->{'handlerClass'}; if (! $handlerClass) { $handlerClass = $self; } $handlerClass->databaseProblem ($severity, $msg, $err); } 1; # return true; __END__ =head1 NAME OraConnection - Connection to an Oracle Database =head1 SYNOPSIS # Access to modules (see the NOTES section for setup) BEGIN { ... push (@INC, ...location of library... ); ... $ENV{'ORACLE_HOME'} = ...location of your Oracle Home...; } use OraConnection; $db = new OraConnection; $db->connect ($databaseName, $username, $password, $optionalOptimizerGoal, $optionalDefaultDateFormat); $tableNames = $db->tableNames (); $viewNames = $db->viewNames (); $tableOrViewNames = $db->tableOrViewNames (); $dbLinkNames = $db->dbLinkNames (); $sequenceNames = $db->sequenceNames (); $colNames = $db->columnNames ("MY_TABLE"); $quotedValue = $db->quote ("Don't shoot the piano player"); # Repetitive execution $insertStmt = "INSERT INTO TBL (who, when) VALUES (" . db->quote ("Clint") . ", SYSDATE)"; # First execution, fetching statement handle for other exec's $sth = $db->execMulti ($insertStmt); # Second execution $db->reExec ($sth); # You MUST call finish to free the statement handle $db->finish ($sth); # One-time execution - no finish() required or allowed $db->exec ($insertStmt); $query = "SELECT height, weight from INFO " . "WHERE name=" . db->quote ("Clint"); # Fetch EXACTLY one result row. Fails if 0 or # multiple rows $resultRow = $db->fetchSingle ($query); ($height, $weight) = @$resultRow; # Direct fetch of height $height = $db->get ("INFO", "height", "name", "Clint"); # Fetch all result rows. ($resultRows, $rowCount) = $db->fetchAll ($query); foreach $resultRow (@$resultRows) { ($height, $weight) = @$resultRow; } # Count of all rows and rows matching various # column values $rowCount = $db->rowCount ("INFO"); $rowCount = $db->matchingRowCount ("INFO", "height", "72", "weight", "195"); # Sequence number values $sequenceVal = $db->currval ($sequenceName); $sequenceVal = $db->nextval ($sequenceName); $minValue = $db->minValue ($sequenceName); $maxValue = $db->maxValue ($sequenceName); $incrementBy = $db->incrementBy ($sequenceName); # Not required - done automatically if $db # goes "out of scope" $db->disconnect (); =head1 DESCRIPTION This Perl module encapsulates a connection to an Oracle database. It provides methods to connect and disconnect from the database, as well as execute common queries. Error handling is provided in several flavors: text and html output are provided to either stdout or a provided file handle. The module uses the DBI Database Independent Perl5 interface class. =head2 ERRORS Problems encountered by routines in this class are divided up into these flavors: =over 4 =item Fatal Error Something really bad happened when dealing with the underlying database, which make it unlikely that the calling program will want to continue. Examples are a failure to connect to the database. =item SQL Error An error was encountered preparing or executing an SQL statement. =item Warning Nothing too serious. =item System Error The caller has made some error in using the methods of this class. For example, trying to execute an SQL statement prior to connecting to the database. =back This OraConnection module provides a default behaviour in each of the above situations. The behaviour can be overridden for an OraConnection instance by providing a method which which (re-)implements the databaseProblem() method. =head2 Case Sensitivity Issues Table and column names are, by default, case insensitive in Oracle. However, there are some situations where mixed case names can creep into an Oracle database: when importing an Access database or when column names are reserved words. In most situations, specifying a table or column name is folded to upper case. However, if you need to specify a mixed case name, you will need to enclose the table or column name in double quotes. For example: # Fetch column MYCOLUMN from table MYTABLE # where column COLOR = 'red'. $dbc->get ("MyTable", "MyColumn", "Color" => "red"); # Fetch column MYCOLUMN from table MyTable # where column Color = 'red'. $dbc->get ("\"MyTable\"", "MyColumn", "\"Color\"" => "red"); =head2 RDB Support Access to RDB databases is provided through the Oracle Translucent Gateway. If you have such a gateway set up, OraConnection is designed to work "seamlessly" using a combination of the functionality provided by the gateway and direct access to underlying RDB tables. You will need to call setDatabaseFlavor ("RDB") after the connect () is issued and prior to any work on the database. One issue is the mapping of data types: RDB native_ Type data_ Code type Oracle Type data_type 7 SMALLINT NUMBER (5, 0) NUMBER 8 INTEGER NUMBER (10, 0) NUMBER 10 REAL FLOAT (24) FLOAT 14 CHAR CHAR (fld_len) CHAR 35 DATE VMS DATE DATE 37 VARCHAR VARCHAR2 (fld_len) VARCHAR2 ?? TINYINT NUMBER (3, 0) NUMBER ?? BIGINT NUMBER (20, 0) NUMBER ?? DOUBLE PRECISION FLOAT (53) FLOAT =head2 Support for LONG and LONG RAW OraConnection has basic handling for the LONG and LONG RAW Oracle field types. You can insert a record with a single LONG or LONG RAW column value using the insertLong() and insertLongRaw() methods. You can fetch a LONG or LONG RAW value using the get() method. NOTE: Handling of LONG and LONG RAW requires at least version 1.06 of the DBI module and 0.61 of DBD::Oracle. NO CHECK IS MADE that these version are being used and your code may well HANG on earlier versions of the DBI and DBD::Oracle. =head1 FUNCTIONS =over 4 =item *** SETUP =item OraConnection->new(); Constructor. No arguments are accepted. =item databaseProblem ($problemType, $problemDescription, $errcode) Default problem handler. $problemType - One of "fatalError", "sqlError", "warning", "systemError" $problemDescription - Text describing the problem. This message is either plain text or html formatted text. $errcode - The integer Oracle error code. =item overrideDatabaseProblemHandler ($handlerClass) Provide/declare a class which implements the databaseProblem method. If $handlerClass is undef, the default handler in this module is used. =item databaseProblemHandler () Fetch the class which currently implements the databaseProblem method. If this class is the handler (i.e. the default handler is in use), we will return undef. =item setMsgFormat ($format) Select the format for error messages. Currently MUST be one of 'html' or 'text'. =item *** DATABASE CONNECTION =item connect ($databaseName, $username, $password, $goal, $dformat) Connect to the Oracle database and return the Oracle db handle. The $databaseName is the "TNS" name of the database on your local system. The $username and $password specify the login context. The optional $goal and optional $dformat specify the OPTIMIZER_GOAL and default date format to use for this connection. See the setOptimizerGoal() and setDefaultDateFormat() methods below. If either the prepare or execute fails, perform fatal processing. Returns the underlying database handle of the Perl DBI class. =item setDatabaseFlavor ($flavor) Specify the flavor of the database. The choices are "Oracle" or "RDB". "Oracle" is assumed, if "" or undef is passed. =item setLinkName ($linkName) Specify the name of a link to add to table names for composed queries. For example, to make queries of the form "SELECT * from tblname@linkname" you would invoke ->setLinkName("linkname") after the connect(). The "@" is optional to this method. Note that the linkName() method will NOT return the leading "@", regardless of whether it was specified on the call to setLinkName(). To clear a linkname, call ->setLinkName(""); =item setSchema ($schemaName) Specify the name of a schema to add to table names for composed queries, overriding the default schema for the username on the connect() call. For example, to make queries of the form "SELECT * from myschema.tblname" you would invoke ->setSchema("myschema") after the connect(). To clear a linkname, call ->setSchema(""); =item setOptimizerGoal ($goal) Set this connection's OPTIMIZER_GOAL. The supplied $goal must be one of the known optimizer goals listed below (case insensitive). The setting of OPTIMIZER_GOAL specifies the optimization mode to use when handling database queries: CHOOSE Tells the optimizer to search the data dictionary views for data on at least one related table (referenced in the SQL statement). If data exists, the optimizer will optimize the statement according to the cost-based approach. If no data exists for any tables being referenced, the optimizer will use rule-based optimization. ALL_ROWS Chooses cost-based optimization with the goal of best throughput. FIRST_ROWS Chooses cost-based optimization with the goal of best response time. RULE Chooses rule-based optimization regardless of the presence of data in the data dictionary views related to the tables being referenced. On success, this method returns 1. If an invalid goal is supplied, no action is taken and this method return undef. =item setDefaultDateFormat ($dformat) Set this connection's default date format. The supplied $dformat must be a valid Oracle date format. Some examples of valid date formats (using the date Saturday October 31, 1998): Format Example output "Day Month DD, YYYY" Saturday October 31, 1998 "Dy Mon DDTH, YY" Sat Oct 31st, 98 "DD mon, Year" 31 oct, Nineteen-Ninety-Eight "CC YYYY Month Day" 20 1998 October Saturday "YY,D,DD,DDD" 98,7,31,304 "YYYYSP" ONE THOUSAND NINE HUNDRED NINETY EIGHT "YYYY: Q" 1998: 4 If an invalid date format is supplied, perform fatal processing. This method always returns 1. =item disconnect () Break the connection to Oracle. Even though a connection to Oracle MUST be disconnected, this user is typically not required to execute this method. Since the DESTROY method for this class calls disconnect(), the user can effect a disconnect by destroying the object or letting it go out of scope. =item connected () Return 1 if connected, 0 or undef otherwise. =item dataSource () Return the DBI 'datasource'. For Oracle database connections, this is a string with the form "dbi:Oracle:" . databaseName(). =item dbh () Return the DBI database handle. This is useful for issuing requests directly to the DBI layer. =item driverName () Return the DBI 'drivername'. For Oracle database connections, this is the string "Oracle". =item databaseName () Return the name of the database - the first argument on the call to connect(). =item username () Return the username - the second argument on the call to connect(). =item password () Return the password - the third argument on the call to connect(). =item databaseFlavor () Return the database flavor specified on a call to setDatabaseFlavor(). =item schemaName () Return any currently specified schema name provided on a call to setSchema(). =item linkName () Return any currently specified linkname. This method will NOT return the leading "@", regardless of whether it was specified on the call to setLinkName(). =item optimizerGoal () Return an upper-caser version of the optimizer goal as specified in the optional argument to connect() or in a call to setOptimizerGoal(). If the optimizer goal was not specified on the connect() and no setOptimizerGoal() call has been made, this method returns undef. =item defaultDateFormat () Return the default date format as specified in the optional argument to connect() or in a call to setDefaultDateFormat(). If the default date format was not specified on the connect() and no setDefaultDateFormat() call has been made, this method returns undef. =item quote ($quotable) Return the 'quote' of the given string in the context of the particular database connection. This routine is prefereable to trying to quote values yourself, because different database connections have different syntax(es) for quoting values. For example, quoting the value don't might yield 'don''t' in one variation of SQL and "don't" in another, and $don't in another. =item *** DATA DICTIONARY METHODS =item tableNames () Returns a reference to a list of the names of the tables in this database. The list is sorted alphabetically by table name. NOTE: the result must be dereferenced - see the example below. =item viewNames () Returns a reference to a list of the names of the views in this database. The list is sorted alphabetically by view name. NOTE: the result must be dereferenced - see the example below. =item tableOrViewNames () Returns a reference to a list of the names of the tables and views in this database. The list is sorted alphabetically by the table or view name. NOTE: the result must be dereferenced - see the example below. =item dbLinkNames () Returns a reference to a list of the names of the DB links in this database. The list is sorted alphabetically by DB link name. NOTE: the result must be dereferenced - see the example below. =item sequenceNames () Returns a reference to a list of the names of the sequences in this database. The list is sorted alphabetically by sequence name. NOTE: the result must be dereferenced - see the example below. =item synonymNames () Returns a reference to a list of the names of the synonyms in this database. The list is sorted alphabetically by synonym name. NOTE: the result must be dereferenced - see the example below. =item comment ($tableName, $columnName) Return the value of the comment attribute in the database for a given table or column in a table. If the column is not specified, the value of the comment for the table is returned. The table and column names are case insensitive, unless they are enclosed in double quotes. Returns undef if the table name or column name (if specified in the call) does not exist. Returns "" if the comment attribute is not set. =item setComment ($comment, $tableName, $columnName) Set the value of the comment attribute in the database for a given table or column in a table. If the column is not specified, the value of the comment for the table is set. =item tabtype ($tableOrViewName) Return the table type of a given named table or view. Examples of table types are "TABLE" and "VIEW". The table/view name is case insensitive, unless it is enclosed in double quotes. If the table or view does not exist, an SQL error is triggered. =item tableAttribute ($tableName, $attribute) Returns a given named attribute of a named table. The table name and attribute are case insensitive. If the table or attribute do not exist, an SQL error is triggered. This is a low level routine for accessing attributes - refer to the TABLE ATTRIBUTES METHODS section below for specific methods to fetch table attributes. =item columnNames ($tableName) Return a reference to a list of column names in a given table. The table name is case insensitive, unless it is enclosed in double quotes. If the table does not exist, an SQL error is triggered. The returned list is not sorted in any particular order. NOTE: the result must be dereferenced - see the example below. =item nullable ($tableName, $columnName) Return 1 or 0 if the given named column in the given named table is nullable or not. The table name and column names are case insensitive. If the table or column do not exist, an SQL error is triggered. =item columnAttribute ($tableName, $columnName, $attribute) Returns a given named attribute of a named column in a named table. The table name, column name, and attrubute are case insensitive. If the table, column, or attribute do not exist, an SQL error is triggered. This is a low level routine for accessing attributes - refer to the COLUMN ATTRIBUTES METHODS section below for specific methods to fetch column attributes. =item *** KEY AND INDEX METHODS =item primaryKeyNames ($tableName) Return a reference to a list of primary key names in a given table. The table name is case insensitive, unless it is enclosed in double quotes. If the table does not exist, an SQL error is triggered. =item foreignKeyNames ($tableName) Return a reference to a list of foreign key names in a given table. The table name is case insensitive, unless it is enclosed in double quotes. If the table does not exist, an SQL error is triggered. =item indexNames ($tableName) Return a reference to a list of index names for indices in a given table. The table name is case insensitive, unless it is enclosed in double quotes. If the table does not exist, an SQL error is triggered. =item primaryKeyPosition ($tableName, $columnName) Position of the given column in the primary key of the given table. Returns undef if the column is not part of the primary key of the table. Otherwise, returns the 1-based index of its position in the primary key. =item primaryKeyColumnNames ($primaryKeyName) Given the name of a primary key (see primaryKeyNames), return a reference to a list of column names which make up the primary key, in order of their position. If the primary key does not exist, an SQL error is triggered. =item foreignKeyColumnNames ($foreignKeyName) Given the name of a foreign key (see foreignKeyNames), return a reference to a list of column names which make up the foreign key, in order of their position. If the foreign key does not exist, an SQL error is triggered. =item foreignKeyTarget ($foreignKeyName) Given the name of a foreign key (see foreignKeyNames), return the target (R_CONSTRAINT_NAME) of the foreign key. This is typically the name of a primary key. If the foreign key does not exist, an SQL error is triggered. =item indexColumnNames ($indexName) Given the name of a index (see indexNames), return a reference to a list of column names which make up the index, in order of their position. If the index does not exist, an SQL error is triggered. =item indexUnique ($indexName) Given the name of a index (see indexNames), return the UNIQUENESS setting for the index. This is typically the string "UNIQUE" or "NONUNIQUE". If the index does not exist, an SQL error is triggered. =item constraintCheckText ($tableName, $columnName) Somewhat post-processed text of the constraint on the column. The constraint IS NOT NULL is not returned (use the nullable() method for this information). This is primarily used for the FIELD IN ('A', 'B') type of constraints. =item *** TABLE ATTRIBUTE METHODS The following methods return the given attribute of a given named table. The table name is case insensitive, unless it is enclosed in double quotes. If the table does not exist, an SQL error is triggered. =item avg_row_len ($tableName) =item avg_space ($tableName) =item backed_up ($tableName) =item blocks ($tableName) =item cache ($tableName) =item chain_cnt ($tableName) =item cluster_name ($tableName) =item degree ($tableName) =item empty_blocks ($tableName) =item freelists ($tableName) =item freelist_groups ($tableName) =item ini_trans ($tableName) =item initial_extent ($tableName) =item instances ($tableName) =item max_extents ($tableName) =item max_trans ($tableName) =item min_extents ($tableName) =item next_extent ($tableName) =item num_rows ($tableName) =item pct_free ($tableName) =item pct_used ($tableName) =item pct_increase ($tableName) =item table_lock ($tableName) =item tablespace_name ($tableName) =item *** COLUMN ATTRIBUTE METHODS The following methods return the given attribute of a given named column in given named table. The table name and column name are case insensitive. If the table or column do not exist, an SQL error is triggered. =item column_id ($tableName, $columnName) =item data_default ($tableName, $columnName) =item data_length ($tableName, $columnName) =item data_precision ($tableName, $columnName) =item data_scale ($tableName, $columnName) =item data_type ($tableName, $columnName) For databases accessed through a gateway (such as RDB), this method returns the Oracle type corresponding to the underlying data type of the foreign database. See data_type_native() to obtain the underlying native data type. =item default_length ($tableName, $columnName) =item density ($tableName, $columnName) =item high_value ($tableName, $columnName) =item last_analyzed ($tableName, $columnName) =item low_value ($tableName, $columnName) =item num_buckets ($tableName, $columnName) =item num_distinct ($tableName, $columnName) =item num_nulls ($tableName, $columnName) =item sample_size ($tableName, $columnName) =item data_type_native ($tableName, $columnName) For databases accessed through a gateway (such as RDB), this method returns the native data type of the column in the underlying foreign database. See data_type() to obtain the corresponding Oracle data type. =item *** MULTI-EXECUTION QUERIES =item execMulti ($query) Take an SQL query, prepare it, execute it, and return its statement handle. The returned statement handle can be re-executed without another prepare() call, by calling reExec(). You MUST (eventually) call finish() on the returned statement handle. If either the prepare or execute fails, perform fatal processing. =item reExec ($sth) Re-execute a statement prepared earlier using the statement handle returned by an early exec() invocation. Returns the statement handle for uniformity with exec(). If the execute fails, perform fatal processing. =item finish ($sth) Finish the statement and free the associated resources. If the finish fails, perform fatal processing. =item *** SINGLE-EXECUTION QUERIES =item exec ($statement) Once-only execution of a statement. Useful for SQL INSERT, UPDATE, etc type of queries. On failure, perform fatal processing. =item insertLong ($statement, $marker, $bigValue) =item insertLongRaw ($statement, $marker, $bigValue) Insert a row with a single LONG or LONG RAW field value. A field of type LONG is available in Oracle 7 and later for handling up to 2 gigabytes of character data. LONG RAW is used for up to 2 gigabytes of binary data. The statement must be of the form: INSERT INTO (field1, field2, ..., longField) values ('val1', 'val2', ..., :MARKER) where the field of type LONG or LONG RAW is named last and :MARKER is a token which MUST begin with a colon character. The call to insertLong() or insertLongRaw() inserts a single record. The value for the LONG or LONG RAW field is supplied as a single perl string. For example: $stmt = "INSERT INTO mytable (key, longField) " . "values ('a', :MyMarker)"; $dbc->insertLong ($stmt, ":MyMarker", $reallyReallyLongValue); These insertLong() and insertLongRaw() methods are currently the only way to set a LONG or LONG RAW field. Large objects in an RDB database cannot be set in this manner. NOTE: Use of these methods requires at least version 1.06 of the DBI module and 0.61 of DBD::Oracle. NO CHECK IS MADE that these version are being used and these methods may well HANG on earlier versions of the DBI and DBD::Oracle. =item execStoredProcedure ($procedureInvocation) Convenience routine to execute a stored procedure call once. Tacks on the obligatory BEGIN and END around the procedure call itself. For example, you pass in "Foo (123, '20-Dec-98')". In this case, the actual executed SQL would be "BEGIN; Foo (123, '20-Dec-98'); END;". On failure, perform fatal processing. =item fetchAll ($query) Once-only execution of a query. Returns the entire result set of a query as an array reference. The array contains zero or more array references, each of which represents one row of the result. Each result array/row holds the field values. For example, if the resulting rows of "SELECT name, consort FROM KINGS" is: henry, joan henry, marie-gallant the resulting anonymous hash would be: [ [ "henry", "joan" ], [ "henry", "marie-gallant" ] ] As a convenience, this routine returns the count of records/rows returned. For example, the following will fetch a ref to a list (and count) of the tables in the database. my ($rows, $rowCount) = $connection->fetchAll("SELECT * FROM user_tables"); This method is potentially a huge memory hog. "Hello Sun? Yea, we need summore of those reeeely big servers" =item fetchRange ($query, $firstRow, $lastRow) Similar to fetchAll(), but returns only those rows within the range specified. It is a way to guard against the potentially unlimited data returned by fetchAll(). It is particularly well suited to the Web style of fetching a "page" of data, then having "NEXT" and "PREV" page links. The $firstRow and $lastRow are the 0-based indices of the first and last result row to return. If $firstRow is undef or less than 0, it assumed to be 0. If $lastRow is undef, all rows from $firstRow to the end are returned. This routine returns the same array reference as the first returned element of fetchAll(), except that the returned arrayref has the first $firstRow elements missing, and never has more than $lastRow-$firstRow+1 elements. This routine does not return the total $rowCount (as does fetchAll()). Use the rowCountOfQuery() method to get the total row count, if needed. Note that while this routine avoids wasting space on the client side, the speed of execution of the query on the database server is (apparantly) not improved by using fetchRange() rather than fetchAll(). To improve the speed of query execution, you can add a WHERE clause of the form "rownum <= " . $dbcontext->quote ($lastRow+1) (Note that the SQL rownum is 1-based and the fetchRange() method takes 0-based arguments.) This technique is valid (according to Chandra Kala) even in the presence of ORDER BY clauses, since Oracle "extract the rownum <= WHERE clause and applies it after any ORDER BY clauses". Of course, adding an ORDER BY clause may, in itself, slow down the query. =item fetchSingle ($query [, $noComplainMissing [, $noComplainMulti]]) Once-only execution of a query which should yield exactly one result row. Returns a reference to an anonymous array which holds the fields values of the single result row. If you don't get exactly one row, returns undef. If there are no matching rows, a warning is issued, unless noComplainMissing is defined. If there are multiple matching rows, a warning is issued, unless noComplainMulti is defined. =item rowCount ($tableName) Return the number of rows in a given table. =item matchingRowCount ($tableName, $fld1, $val1, $fld2, $val2, ...) Return the number of rows in a given table where the given field(s) $fld1, $fld2, ... match the given value(s) $val1, $val2, .... Returns the count of matching rows. =item rowCountOfQuery ($query) Returns the number of which will match a given SELECT query. The $query MUST begin with the form: "SELECT field1 {, fieldN} FROM ..." Note that the "SELECT" and "FROM" MUST BE ALL CAPITALS. Also note that, if the second "FROM" appears later in the query (eg. in a subquery subordinated in a WHERE clause), then this routine will NOT work properly - it will mangle the query and cause an SQL parse error. This method basically issues a query of the form: "SELECT count(*) FROM ..." Returns the count of matching rows. =item currval ($sequenceName) Returns the current value of a given named sequence number in the database. =item nextval ($sequenceName) Return the next value of a given named sequence number in the database, AND INCREMENT THE SEQUENCE. =item minValue ($sequenceName) Return the defined minimum value for the sequence. =item maxValue ($sequenceName) Return the defined maximum value for the sequence. =item incrementBy ($sequenceName) Return the increment_by setting for the sequence. =item table_owner_of_synonym ($synonymName) Return the table_owner of a given named synonym number in the database. =item table_name_of_synonym ($synonymName) Return the table_name of a given named synonym number in the database. =item get ($tableName, $resultField, $fld1, $val1, $fld2, $val2, ...) Fetch the value of the column named $resultField from a record whose field(s) $fld1, $fld2, ... match the given value(s) $val1, $val2, .... No check is made as to how many matching result rows exist. If there is more than one result row, you get an result field value from an arbitrary one of the matching rows. Use of ROWID will avoid this problem. For example: $result = $dbc->get ("MY_TABLE", "RESULT", "ROWID", $theRowID); The arguments after $resultField are fieldName/value pairs which must be matched by the column values. A value of undef or "IS_NULL" for a value will generate an "is NULL" check in the corresponding column. The resultField argument can name a field of data type LONG or LONG RAW. in this case, the entire field value is returned in a single perl string object. This get() method is currently the only way to read LONG and LONG RAW fields from an Oracle database. Large objects cannot be accessed from an RDB database in this manner. =item dumpTable ($filename, $tableName, $optionalWhereClause, $maxRowCount, $fld1, $fld2, ...) Siphon a given table from a given (other) OraConnect object into a given table in this database, mapping the column names. NOTE: all tab characters are removed from field values! =item *** ERROR HANDLING =item warn ($arg1, $arg2) Issue a database warning. Several call formats are supported: warn "Can't do what I want"; # Issue complaint with DBI:: data warn $dbh, "Can't do what I want"; # Issue complaint with $dbh-> data =item fatal ($arg1, $arg2) Fatal Error (see the ERRORS section). Same arguments as warn(). =item sqlError ($arg1, $arg2) SQL Error (see the ERRORS section). Same arguments as warn(). =item systemError ($arg1, $arg2) System Error (see the ERRORS section). Same arguments as warn(). =back =head1 WARNING The fetchAll() method can potentially return a huge amount of data. =head1 NOTES This module has not yet been set up for "installation" in your local Perl. =head1 BUGS The rowCountOfQuery() method does not properly handle complex SQL SELECT statements. If more than one "FROM" token appears in the query, (eg. in a subquery subordinated in a WHERE clause), then this routine will NOT work properly - it will mangle the query and cause an SQL parse error. =head1 EXAMPLES Here's a sample script which prints a count of the rows in each of the tables in a database. #!/somewhere/perl BEGIN { ... $ENV{'ORACLE_HOME'} = ...location of your Oracle Home...; } use OraConnection; # Connect to the database my ($myDb) = new OraConnection; $myDb->connect ("myDb", "mylogin", "mypassword"); # Fetch a ref to a list of the table names my ($myTableNames) = $myDb->tableNames (); # Count the tables printf "%30s %s\n", "Table", "Count"; printf "%30s %s\n", "-----", "-----"; my ($myTableName); foreach $myTableName (@$myTableNames) { my ($colNames) = $myDb->columnNames ($myTableName); printf "%30s %5d\n", $myTableName, $myDb->rowCount ($myTableName); } exit; =head1 SEE ALSO B and B man pages. =head1 AUTHOR Clint Goss , August 1997 - April 1999 =cut