/usr/share/perl5/Rose/DB/Object/Metadata/Auto/Oracle.pm is in librose-db-object-perl 1:0.815-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 | package Rose::DB::Object::Metadata::Auto::Oracle;
use strict;
use Carp();
use Rose::DB::Object::Metadata::UniqueKey;
use Rose::DB::Object::Metadata::Auto;
our @ISA = qw(Rose::DB::Object::Metadata::Auto);
our $VERSION = '0.786';
sub auto_init_primary_key_columns
{
my($self) = shift;
$self->SUPER::auto_init_primary_key_columns(@_);
my $cm = $self->convention_manager;
return if($cm->no_auto_sequences);
my($db, @sequences);
my $table = $self->table;
# Check for sequence(s) for what look like non-null "serial" columns.
foreach my $name ($self->primary_key_columns)
{
my $column = $self->column($name) or next;
next unless ($column->not_null);
my $sequence_name = uc $cm->auto_primary_key_column_sequence_name($table, $name);
$db ||= $self->init_db;
push(@sequences, $db->sequence_exists($sequence_name) ? $sequence_name : undef);
}
$self->primary_key_sequence_names($db, @sequences) if(@sequences);
return;
}
use constant UNIQUE_INDEX_SQL => <<'EOF';
SELECT AI.INDEX_NAME FROM ALL_INDEXES AI, ALL_CONSTRAINTS AC
WHERE AI.INDEX_NAME = AC.CONSTRAINT_NAME AND
AC.CONSTRAINT_TYPE <> 'P' AND
AI.UNIQUENESS = 'UNIQUE' AND AI.TABLE_NAME = ? AND
AI.TABLE_OWNER = ?
EOF
use constant UNIQUE_INDEX_COLUMNS_SQL_STUB => <<'EOF';
SELECT COLUMN_NAME FROM ALL_IND_COLUMNS WHERE INDEX_NAME = ? ORDER BY COLUMN_POSITION
EOF
sub auto_generate_unique_keys
{
my($self) = shift;
unless(defined wantarray)
{
Carp::croak "Useless call to auto_generate_unique_keys() in void context";
}
my($class, @unique_keys, $error);
TRY:
{
local $@;
eval
{
$class = $self->class or die "Missing class!";
my $db = $self->db;
my $dbh = $db->dbh or die $db->error;
local $dbh->{'FetchHashKeyName'} = 'NAME';
my $schema = $self->select_schema($db);
$schema = $db->default_implicit_schema unless(defined $schema);
$schema = uc $schema if(defined $schema);
my $table = uc $self->table;
my $key_name;
my $sth = $dbh->prepare(UNIQUE_INDEX_SQL);
$sth->execute($table, $schema);
$sth->bind_columns(\$key_name);
while($sth->fetch)
{
my $uk = Rose::DB::Object::Metadata::UniqueKey->new(name => $key_name,
parent => $self);
my $col_sth = $dbh->prepare(UNIQUE_INDEX_COLUMNS_SQL_STUB);
my($column, @columns);
$col_sth->execute($key_name);
$col_sth->bind_columns(\$column);
while($col_sth->fetch)
{
push(@columns, $column);
}
unless(@columns)
{
die "No columns found for key $key_name";
}
$uk->columns(\@columns);
push(@unique_keys, $uk);
}
};
$error = $@;
}
if($error)
{
Carp::croak "Could not auto-retrieve unique keys for class $class - $error";
}
# This sort order is part of the API, and is essential to make the
# test suite work.
@unique_keys = sort { lc $a->name cmp lc $b->name } @unique_keys;
return wantarray ? @unique_keys : \@unique_keys;
}
1;
|