PC Professionell 2004 December/PCpro_2004_12.ISO/files/webserver/xampp/xampp-perl-addon-1.4.9-installer.exe/Oracle.pm

Perl POD Document | 2003-07-15 | 4.9 KB | 176 lines

package Class::DBI::Oracle;

=head1 NAME

Class::DBI::Oracle - Extensions to Class::DBI for Oracle

=head1 SYNOPSIS

  package Music::DBI;
  use base 'Class::DBI::Oracle';
  Music::DBI->set_db('Main', 'dbi:Oracle:tnsname', 'username', 'password');

  package Artist;
  use base 'Music::DBI';
  __PACKAGE__->set_up_table('Artist');

  # ... see the Class::DBI documentation for details on Class::DBI usage

=head1 DESCRIPTION

This is an extension to Class::DBI that currently implements:

    * A sequence fix for Oracle databases.

    * Automatic column name discovery.

    * Automatic primary key detection.

    * Sequence name guessing.

    * Proper aliasing of reserved words.

Instead of setting Class::DBI as your base class, use this.

=head1 BUGS

The sequence guessing is just that. If your naming convention follows the
defacto standard of TABLENAME_SEQ, and you only use one sequence per table,
this will work.

The primary and column name detection lowercases all names found. This is
probably what you want. If it's not, don't use set_up_table.

=head1 AUTHOR

Teodor Zlatanov

Dan Sully E<lt>[e-mail]<gt> added initial column, primary key and sequence finding.

Jay Strauss E<lt>[e-mail]<gt> updated column, primary key, and sequence finding. Added aliasing reserved words

=head1 SEE ALSO

L<Class::DBI> L<Class::DBI::mysql> L<Class::DBI::Pg>

=cut

use strict;
use base 'Class::DBI';

use vars qw($VERSION);
$VERSION = '0.51';

# Setup an alias if the tablename is an Oracle reserved word -
# for example if the class name is: user
# make the table_alias q["user"]
#
# Note: actually not all oracle reserved words (v$reserved_words) seem
# to be a problem, but these have been identified

my @problemWords = qw{
    ACCESS ADD ALL ALTER AND ANY AS ASC AUDIT BETWEEN BY CHAR CHECK CLUSTER
    COLUMN COMMENT COMPRESS CONNECT CREATE CROSS CURRENT CURRENT_DATE
    CURRENT_TIMESTAMP CURSOR_SPECIFIC_SEGMENT DATE DBTIMEZONE DECIMAL
    DEFAULT DELETE DESC DISTINCT DROP ELSE ESCAPE EXCLUSIVE EXISTS FALSE
    FILE FLOAT FOR FROM GRANT GROUP HAVING IDENTIFIED IMMEDIATE IN INCREMENT
    INDEX INITIAL INSERT INTEGER INTERSECT INTO IS JOIN LDAP_REG_SYNC_INTERVAL
    LEVEL LIKE LOCALTIMESTAMP LOCK LOGICAL_READS_PER_SESSION LONG MAXEXTENTS
    MINUS MLSLABEL MODE MODIFY NLS_SORT NOAUDIT NOCOMPRESS NOT NOWAIT NULL
    NUMBER OF OFFLINE ON ONLINE OPTION OR ORDER PASSWORD_VERIFY_FUNCTION
    PRIOR PRIVILEGES PUBLIC RAW RENAME RESOURCE REVOKE ROW ROWID ROWNUM ROWS
    SELECT SESSION SESSIONTIMEZONE SET SHARE SIZE SMALLINT START SUCCESSFUL
    SYNONYM SYSDATE SYSTIMESTAMP SYS_OP_BITVEC SYS_OP_ENFORCE_NOT_NULL$ TABLE
    THEN TO TRIGGER UID UNION UNIQUE UPDATE USER VALIDATE VALUES VARCHAR
    VARCHAR2 VIEW WHENEVER WHERE WITH
};

sub _die { require Carp; Carp::croak(@_); }

sub set_up_table {
    my($class, $table) = @_;
    my $dbh = $class->db_Main();

    $class->table($table);

    $table = uc $table;

    # alias the table if needed.
    (my $alias = $class) =~ s/.*:://g;
    $class->table_alias(qq["$alias"]) if grep /$alias/i, @problemWords;

    # find the primary key and column names.
    my $sql = qq[
        select     lower(a.column_name), b.position
        from     user_tab_columns a,
                (
                select     column_name, position
                from       user_constraints a, user_cons_columns b
                where     a.constraint_name = b.constraint_name
                and    a.constraint_type = 'P'
                and    a.table_name = ?
                ) b
        where     a.column_name = b.column_name (+)
        and    a.table_name = ?
        order by position, a.column_name];

    my $sth = $dbh->prepare($sql);
    $sth->execute($table,$table);

    my $col = $sth->fetchall_arrayref;

    $sth->finish();

    # deal with old revisions
    my $msg;
    my @primary = ();

    $msg = qq{has no primary key} unless $col->[0][1];

    # Class::DBI >= 0.93 can use multiple-primary-column keys.
    if ($Class::DBI::VERSION >= 0.93) {

        map { push @primary, $_->[0] if $_->[1] } @$col;

    } else {

        $msg = qq{has a composite primary key} if $col->[1][1];

        push @primary, $col->[0][0];
    }

    _die('The "',$class->table,qq{" table $msg}) if $msg;

    $class->columns(All => map {$_->[0]} @$col);
    $class->columns(Primary => @primary);

    # attempt to guess the sequence from the table name.
    # this won't work if there is inconsistent naming.
    #
    # This is potentially very dangerous code, there could be many
    # sequences with the same table name embedded, probably should
    # only use the sequence if it's the only one that is found with the
    # same tablename

    # Go and get all the sequences where the table name is within the
    # name of the sequence
    $sql = qq[
        select    sequence_name
        from    user_sequences
        where    sequence_name like (?)
    ];

    $sth = $dbh->prepare($sql);
    $sth->execute("\%$table\%");
    my @sequence = map {$_->[0]} @{$sth->fetchall_arrayref};
    $sth->finish();

    $class->sequence($sequence[0]) unless $#sequence;

}

     __PACKAGE__->set_sql('Nextval', <<'');
SELECT %s.NEXTVAL from DUAL

1;