# Database.pm: Class Used to Interface Databases package RDA::Target::Database; # $Id: Database.pm,v 1.9 2015/05/05 13:08:42 RDA Exp $ # ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/Target/Database.pm,v 1.9 2015/05/05 13:08:42 RDA Exp $ # # Change History # 20150505 MSC Improve the documentation. =head1 NAME RDA::Target::Database - Class Used to Interface Databases =head1 SYNOPSIS require RDA::Target::Database; =head1 DESCRIPTION The objects of the C class are used to interface with databases. It is a subclass of L. The following methods are available: =cut use strict; BEGIN { use Exporter; use RDA::Text qw(get_string); use RDA::Object; use RDA::Object::Access qw($RE_EXT); use RDA::Object::Rda; use RDA::Object::Target; use RDA::Target::Base; } # Define the global public variables use vars qw($STRINGS $VERSION @DUMP @ISA %SDCL); $VERSION = sprintf('%d.%02d', q$Revision: 1.9 $ =~ /(\d+)\.(\d+)/); @DUMP = ( hsh => {'RDA::Target::Base' => 1, 'RDA::Target::Common' => 1, 'RDA::Target::Database' => 1, 'RDA::Target::Db' => 1, 'RDA::Target::Dbi' => 1, 'RDA::Target::Domain' => 1, 'RDA::Target::Home' => 1, 'RDA::Target::Instance' => 1, 'RDA::Target::MwHome' => 1, 'RDA::Target::System' => 1, 'RDA::Target::WlHome' => 1, }, ); @ISA = qw(RDA::Object::Target RDA::Object Exporter); %SDCL = ( dep => [qw(RDA::Target::Base RDA::Target::Home RDA::Target::System)], inc => [qw(RDA::Object::Target RDA::Object)], met => { 'get_sqlplus' => {ret => 1}, }, ); # Define the global private constants # Define the global private variables # Report the package version sub Version { return $VERSION; } =head2 S<$h = RDA::Target::Database-Enew($oid,$col,$def,$par[,$edt])> The object constructor. It takes the object identifier, the collector object reference, the definition item reference, the parent target reference, and an optional initial attribute hash reference as arguments. Do not use this constructor directly. Create all targets using the L methods. C is represented by a blessed hash reference. The following special keys are used: =over 12 =item S< B<'col' > > Reference to the collector object =item S< B<'oid' > > Object identifier =item S< B<'par' > > Reference to the parent target =item S< B<'raw' > > Raw value indicator =item S< B<'sql' > > SQL*Plus specifications =item S< B<'_abr'> > Symbol definition hash =item S< B<'_bas'> > Reference to the Oracle base target =item S< B<'_bkp'> > Backup of environment variables =item S< B<'_chg'> > Symbol change hash =item S< B<'_chl'> > List of the child keys =item S< B<'_def'> > Reference to the target definition item =item S< B<'_env'> > Environment specifications =item S< B<'_fcs'> > Focus hash =item S< B<'_hom'> > Reference to the Oracle home target =item S< B<'_prs'> > Symbol detection parse tree =item S< B<'_shr'> > Share indicator =item S< B<'_typ'> > Target type =back Internal keys are prefixed by an underscore. =cut sub new { my ($cls, $oid, $col, $def, $par, $edt) = @_; my ($dft, $key, $flg, $raw, $slf, $tgt, $tid, $val); # Create the database object $dft = $col->get_info('dft'); $raw = $def->get_first('B_RAW', 0); $slf = bless { col => $col, oid => $par->get_unique($oid), par => $par, raw => $raw, sid => $def->get_first('T_ORACLE_SID'), _chl => [], _def => $def, _fcs => {}, _shr => $def->get_first(['B_DEDICATED_DATABASE','B_DEDICATED']) ? 0 : 1, _typ => 'DB', }, ref($cls) || $cls; # Add the initial attributes if ($edt) { foreach my $key (keys(%{$edt})) { $slf->{$key} = $edt->{$key}; } } # Load the associated Oracle base target unless ($def->get_first('B_MISSING_BASE')) { if (defined($val = $def->get_first('I_ORACLE_BASE'))) { $slf->{'_bas'} = $slf->add_target($val); push(@{$slf->{'_chl'}}, '_bas'); } elsif (defined($val = $def->get_first('W_ORACLE_BASE'))) { $slf->{'_bas'} = $slf->get_target($val); push(@{$slf->{'_chl'}}, '_bas'); } elsif (defined($val = $def->get_prime('D_ORACLE_BASE', undef, $raw))) { $tid = $oid; $tid =~ s/^DB_/OB_/i; $tgt = ($flg = $def->get_prime('B_DEDICATED_BASE')) ? undef : $par->find_target('OB', bas => RDA::Object::Rda->native($val)); $slf->{'_bas'} = $tgt || $slf->add_target($tid, {B_DEDICATED_BASE => $flg, B_RAW => $raw, D_ORACLE_BASE => $val, T_OB_ABBR => $def->get_prime('T_OB_ABBR'), }); push(@{$slf->{'_chl'}}, '_bas'); } } # Load the associated Oracle home target unless ($def->get_first('B_MISSING_HOME')) { if (defined($val = $def->get_first('I_ORACLE_HOME'))) { $slf->{'_hom'} = $slf->add_target($val); push(@{$slf->{'_chl'}}, '_hom'); } elsif (defined($val = $def->get_first('W_ORACLE_HOME'))) { $slf->{'_hom'} = $slf->get_target($val); push(@{$slf->{'_chl'}}, '_hom'); } elsif (defined($val = $def->get_prime('D_ORACLE_HOME', undef, $raw))) { $tid = $oid; $tid =~ s/^DB_/OH_/i; $tgt = ($flg = $def->get_prime('B_DEDICATED_HOME')) ? undef : $par->find_target('OH', hom => RDA::Object::Rda->native($val)); $slf->{'_hom'} = $tgt || $slf->add_target($tid, {B_DEDICATED_HOME => $flg, B_RAW => $raw, D_ORACLE_HOME => $val, T_OH_ABBR => $def->get_prime('T_OH_ABBR'), }); push(@{$slf->{'_chl'}}, '_hom'); } } # Initiate the symbol management when applicable unless (RDA::Object::Rda->is_vms) { $slf->{'_abr'} = {}; $slf->init_symbols; delete($slf->{'_chg'}); } # Return the object reference return $slf; } =head2 S<$h-Efind_sqlplus> This method returns a reference to the SQL*Plus context. =cut sub find_sqlplus { my ($slf) = @_; my ($env, $sql); # Use the database-specific context when available return $slf->{'sql'} if exists($slf->{'sql'}); # Determine the SQL*Plus context $sql = $slf->SUPER::find_sqlplus || $slf->search_sqlplus; # Examine previous test results return $sql unless $slf->{'_def'}->get_first('B_INITIAL'); # Create a database-specific context $env = {%{$sql->{'env'}}}; $env->{'ORACLE_HOME'} = $env->{'INITIAL_HOME'}; return $slf->{'sql'} = {cmd => $sql->{'cmd'}, env => $env, typ => 'DB'}; } =head2 S<$h-Eget_env([$env])> This method returns the environment variable specifications as a hash reference. =cut sub get_env { my ($slf) = @_; # Determine the environment specifications on first usage unless (exists($slf->{'_env'})) { my ($dft); # Get the default specifications $dft = exists($slf->{'_hom'}) ? $slf->{'_hom'} : $slf->get_default; $slf->{'_env'} = {%{$dft->get_env}}; # Add the database specifications $slf->{'_env'}->{'ORACLE_SID'} = ($slf->{'loc'} && defined($slf->{'sid'}) && $slf->{'sid'} !~ $RE_EXT) ? $slf->{'sid'} : undef; } # Return the environment specifications return $slf->{'_env'}; } 1; __END__ =head1 SEE ALSO L, L, L, L, L, L, L, L, L, L, =head1 COPYRIGHT NOTICE Copyright (c) 2002, 2016, Oracle and/or its affiliates. All rights reserved. =head1 TRADEMARK NOTICE Oracle and Java are registered trademarks of Oracle and/or its affiliates. Other names may be trademarks of their respective owners. =cut