# Target.pm: Class Used to Interface Collection Targets

package RDA::Object::Target;

# $Id: Target.pm,v 1.35 2015/05/08 18:18:14 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/Object/Target.pm,v 1.35 2015/05/08 18:18:14 RDA Exp $
#
# Change History
# 20150508  MSC  Improve the documentation.

=head1 NAME

RDA::Object::Target - Class Used to Interface Collection Targets

=head1 SYNOPSIS

 require RDA::Object::Target;

=head1 DESCRIPTION

The objects of the C<RDA::Object::Target> class are used to interface
collection targets. It is a subclass of L<RDA::Object|RDA::Object>.

The following methods are available:

=cut

use strict;

BEGIN
{ use Exporter;
  use RDA::Text qw(debug get_string);
  use RDA::Agent qw($INTERRUPT);
  use RDA::Object;
  use RDA::Object::Item;
  use RDA::Object::Rda;
}

# Define the global public variables
use vars qw($STRINGS $VERSION @DUMP @EXPORT_OK @ISA %SDCL);
$VERSION = sprintf('%d.%02d', q$Revision: 1.35 $ =~ /(\d+)\.(\d+)/);
@DUMP    = (
  hsh => {
    'RDA::Object::Target'   => 1,
    '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,
    },
  str => {par => 0},
  );
@ISA     = qw(RDA::Object Exporter);
%SDCL    = (
  als => {
    ## no critic (Interpolation)
    'addSymbol'    => ['${CUR.O_TARGET}', 'add_symbol'],
    'addTarget'    => ['$[TGT]',          'add_target'],
    'catSymbol'    => ['${CUR.O_TARGET}', 'cat_symbol'],
    'defineTarget' => ['$[TGT]',          'define_target'],
    'endTarget'    => ['$[TGT]',          'end_target'],
    'findTarget'   => ['$[TGT]',          'find_target'],
    'getBase'      => ['${CUR.O_TARGET}', 'get_base'],
    'getCommon'    => ['${CUR.O_TARGET}', 'get_common'],
    'getDomain'    => ['${CUR.O_TARGET}', 'get_domain'],
    'getFocus'     => ['${CUR.O_TARGET}', 'get_focus'],
    'getHome'      => ['${CUR.O_TARGET}', 'get_home'],
    'getInstance'  => ['${CUR.O_TARGET}', 'get_instance'],
    'getMwHome'    => ['${CUR.O_TARGET}', 'get_mw_home'],
    'getSymbols'   => ['${CUR.O_TARGET}', 'get_symbols'],
    'getTarget'    => ['$[TGT]',          'get_target'],
    'getWlHome'    => ['${CUR.O_TARGET}', 'get_wl_home'],
    'initTargets'  => ['$[TGT]',          'init'],
    'listTargets'  => ['$[TGT]',          'list_targets'],
    'setCurrent'   => ['$[TGT]',          'set_current'],
    'setFocus'     => ['${CUR.O_TARGET}', 'set_focus'],
    'setSymbol'    => ['${CUR.O_TARGET}', 'set_symbol'],
    },
  beg => \&_begin_control,
  dep => [qw(RDA::Target::Base
             RDA::Target::Common
             RDA::Target::Database
             RDA::Target::Db
             RDA::Target::Dbi
             RDA::Target::Domain
             RDA::Target::Home
             RDA::Target::Instance
             RDA::Target::MwHome
             RDA::Target::System
             RDA::Target::WlHome)],
  end => \&_end_control,
  flg => 1,
  inc => [qw(RDA::Object)],
  met => {
    'add_symbol'      => {ret => 0},
    'add_target'      => {ret => 0},
    'cat_symbol'      => {ret => 0},
    'define_target'   => {ret => 0, blk => 1},
    'end_target'      => {ret => 0},
    'find_command'    => {ret => 0},
    'find_target'     => {ret => 0},
    'get_base'        => {ret => 0},
    'get_common'      => {ret => 0},
    'get_current'     => {ret => 0},
    'get_default'     => {ret => 0},
    'get_definition'  => {ret => 0},
    'get_detail'      => {ret => 0},
    'get_domain'      => {ret => 0},
    'get_env'         => {ret => 0},
    'get_focus'       => {ret => 1},
    'get_home'        => {ret => 0},
    'get_info'        => {ret => 0},
    'get_instance'    => {ret => 0},
    'get_jdk_version' => {ret => 0},
    'get_mw_home'     => {ret => 0},
    'get_sqlplus'     => {ret => 1},
    'get_symbols'     => {ret => 1},
    'get_target'      => {ret => 0},
    'get_top'         => {ret => 0},
    'get_type'        => {ret => 0},
    'get_wl_home'     => {ret => 0},
    'init'            => {ret => 0},
    'list_targets'    => {ret => 1},
    'reset_symbols'   => {ret => 0},
    'set_current'     => {ret => 0},
    'set_focus'       => {ret => 0},
    'set_info'        => {ret => 0},
    'set_symbol'      => {ret => 0},
    },
  top => 'TGT',
  );

# Define the global private constants
my $RE_OID = qr/^([A-Z]+)(_[A-Z]\w*(\$\$)?)?$/;

# Define the global private variables
my %tb_bad = (
  DQ  => 'DQ_ERROR$$',  ## no critic (Interpolation)
  SQ  => 'SQ_ERROR$$',  ## no critic (Interpolation)
  );
my %tb_cln = map {$_ => 1} qw(oid par);
my %tb_cls = (
  CH  => 'RDA::Target::Common',
  DB  => 'RDA::Target::Database',
  DOM => 'RDA::Target::Domain',
  DQ  => 'RDA::Target::Dbi',
  MH  => 'RDA::Target::MwHome',
  OB  => 'RDA::Target::Base',
  OH  => 'RDA::Target::Home',
  OI  => 'RDA::Target::Instance',
  SQ  => 'RDA::Target::Db',
  SYS => 'RDA::Target::System',
  WH  => 'RDA::Target::WlHome',
  );

# Report the package version
sub Version
{ return $VERSION;
}

=head2 S<$h = RDA::Object::Target-E<gt>new($collector)>

The object constructor. This method takes the collector reference as an
argument.

It is represented by a blessed hash reference. The following special keys are
used:

=over 12

=item S<    B<'acc' > > Database access error flag (T)

=item S<    B<'agt' > > Reference to the RDA agent object (C)

=item S<    B<'bas' > > Oracle base directory (T)

=item S<    B<'cch' > > Common Components home directory (T)

=item S<    B<'cfg' > > Reference to the RDA software configuration (C)

=item S<    B<'col' > > Reference to the collector object (C,T)

=item S<    B<'dba' > > SYSDBA indicator (T)

=item S<    B<'dom' > > Domain home directory (T)

=item S<    B<'dsn' > > Data source name (T)

=item S<    B<'err' > > SQL error flag (T)

=item S<    B<'hom' > > Oracle home directory (T)

=item S<    B<'ins' > > Instance home directory (T)

=item S<    B<'jdk' > > JDK directory (T)

=item S<    B<'loc' > > Local database indicator (T)

=item S<    B<'lvl' > > Trace level (C,T)

=item S<    B<'max' > > Maximum number of connection issues (T)

=item S<    B<'mwh' > > Middleware home directory (T)

=item S<    B<'nam' > > Domain name (T)

=item S<    B<'not' > > Feedback note hash (T)

=item S<    B<'oid' > > Object identifier (C,T)

=item S<    B<'par' > > Reference to the parent target (T)

=item S<    B<'pre' > > PRELIM indicator (T)

=item S<    B<'pwd' > > User password (T)

=item S<    B<'raw' > > Raw value indicator (T)

=item S<    B<'sid' > > System identifier (T)

=item S<    B<'sql' > > SQL*Plus specifications (C,T)

=item S<    B<'sys' > > Reference to the system view object (C)

=item S<    B<'tns' > > TNS_ADMIN specification (T)

=item S<    B<'top' > > Domain root directory (T)

=item S<    B<'try' > > Number of SQL script failures (T)

=item S<    B<'typ' > > Data source type (T)

=item S<    B<'usr' > > User name (T)

=item S<    B<'wlh' > > Oracle WebLogic Server home directory (T)

=item S<    B<'_abr'> > Symbol definition hash (T)

=item S<    B<'_bas'> > Reference to the Oracle base target (C)

=item S<    B<'_bkp'> > Backup of environment variables (T)

=item S<    B<'_cch'> > Reference to the Common Components home target (T)

=item S<    B<'_chg'> > Symbol change hash (T)

=item S<    B<'_chl'> > List of the child keys (C,T)

=item S<    B<'_cur'> > Reference to the current target (C)

=item S<    B<'_def'> > Target definition (C,T)

=item S<    B<'_det'> > Detected home directories (T)

=item S<    B<'_dft'> > Reference to the default target (C)

=item S<    B<'_dom'> > Domain attribute hash (T)

=item S<    B<'_env'> > Environment specifications (T)

=item S<    B<'_fcs'> > Focus hash (T)

=item S<    B<'_hom'> > Reference to the Oracle home target (C,T)

=item S<    B<'_inv'> > Inventory object (T)

=item S<    B<'_itm'> > Reference to the internal definition item (C)

=item S<    B<'_ldb'> > Reference to the local database target (T)

=item S<    B<'_mod'> > Reference to the module target (C)

=item S<    B<'_mwh'> > Reference to the Middleware home target (T)

=item S<    B<'_off'> > Current definition offset (C)

=item S<    B<'_prd'> > OCM product list (T)

=item S<    B<'_prs'> > Symbol detection parse tree (T)

=item S<    B<'_seq'> > Object identifier sequencers (C)

=item S<    B<'_shr'> > Share indicator (T)

=item S<    B<'_srv'> > Server hash (T)

=item S<    B<'_prs'> > Symbol detection parse tree (T)

=item S<    B<'_tgt'> > Sub target hash (C)

=item S<    B<'_trc'> > Trace prompt (C)

=item S<    B<'_typ'> > Target type (C,T)

=item S<    B<'_wlh'> > Reference to the Oracle WebLogic Server home target (T)

=back

Internal keys are prefixed by an underscore.

=cut

sub new
{ my ($cls, $col) = @_;
  my ($agt, $ini, $lib);

  # Create the target control object and return its reference
  $agt = $col->get_agent;
  return init(bless {
    agt  => $agt,
    cfg  => $agt->get_config,
    col  => $col,
    lvl  => $col->get_level,
    oid  => 'TGT',
    sys  => $agt->get_system,
    _chl => [],
    _def => undef,
    _ini => $ini,
    _itm => RDA::Object::Item->new($agt, 'TGT', 'Target Definition'),
    _off => 0,
    _seq => {map {$_ => 0} keys(%tb_cls)},
    _tgt => {},
    _trc => $col->get_trace('TARGET') ? 'TGT]' : q{},
    _typ => 'TGT',
    }, ref($cls) || $cls);
}

=head2 S<$h-E<gt>end>

This method deletes the target control object.

=cut

sub end
{ my ($slf) = @_;

  # Stop all target activities when deleting the target control object
  if (exists($slf->{'_dft'}))
  { _reset_target($slf, delete($slf->{'_cur'})) if exists($slf->{'_cur'});
    _reset_target($slf, delete($slf->{'_dft'}));
    $slf->end_target;
  }

  # Delete the object
  $_[0]->SUPER::delete_object;
  return;
}

=head2 S<$h-E<gt>init>

This method initializes the default target.

=cut

sub init
{ my ($slf) = @_;
  my ($def, $val);

  $slf = $slf->get_top;

  # Delete all targets
  _reset_target($slf, delete($slf->{'_cur'})) if exists($slf->{'_cur'});
  _reset_target($slf, delete($slf->{'_dft'})) if exists($slf->{'_dft'});
  $slf->end_target;

  # Delete the SQL*Plus context to force a new detection
  delete($slf->{'sql'});

  # Create the default target
  $def = $slf->{'col'}->find('SETUP.RDA.BEGIN', 1);
  _set_target($slf, $slf->{'_dft'} =
    length($val = $def->get_first('D_ORACLE_HOME', q{}))
      ? $slf->add_target('OH_default',
          {D_ORACLE_HOME => $val,
           T_ORACLE_HOME => $def->get_first('T_ORACLE_HOME'),
           T_OH_ABBR     => '$OH'}) :  ## no critic (Interpolation)
    $slf->add_target('SYS', {B_DEFAULT => 1}));

  # Return the object reference
  return $slf;
}

=head2 S<$h-E<gt>resume($bkp)>

This method resumes some target activities. It returns a list containing the
object reference and the previous values of the restored attributes.

=cut

sub resume
{ my ($slf, $rec) = @_;

  die get_string('BAD_RESUME') unless ref($rec) eq 'HASH';
  $slf = $slf->get_top;

  # End targets
  $slf->end_target;

  # Restore the system view
  $slf->{'sys'}->resume(delete($rec->{'_sys'}));

  # Restore the attributes and return the previous values
  return _switch($slf, {}, $rec);
}

sub _switch
{ my ($slf, $bkp, $rec) = @_;

  # Restore saved attributes
  foreach my $key (keys(%{$rec}))
  { $slf->{$key} = $bkp->{$key} if exists($bkp->{$key});
    if (defined($rec->{$key}))
    { ($slf->{$key}, $bkp->{$key}) = ($rec->{$key}, $slf->{$key});
    }
    else
    { $bkp->{$key} = delete($slf->{$key});
    }
  }

  # Return the value of the modified attributes
  return $bkp;
}

=head2 S<$h-E<gt>suspend>

This method suspends some target activities for the specified job. It returns
previous attributes.

=cut

sub suspend
{ my ($slf) = @_;
  my ($bkp);

  $slf = $slf->get_top;

  # Switch object attributes
  $bkp = _switch($slf, {}, {
    _chl => [],
    _def => undef,
    _itm => RDA::Object::Item->new($slf->{'col'}->get_agent, 'TGT',
                                   'Target Definition'),
    _off => 0,
    _seq => {map {$_ => 0} keys(%tb_cls)},
    _tgt => {},
    });

  # Suspend the system view
  $bkp->{'_sys'} = $slf->{'sys'}->suspend;

  # Return previous attributes
  return $bkp;
}

=head1 TARGET DEFINITION METHODS

=head2 S<$h-E<gt>define_target($block,$class,$hash[,$flag])>

This method defines a target using the class definition module. It suppresses
all dialogues unless the flag is set. It returns the target definition object.

=head2 S<$h-E<gt>define_target($block,$target,$hash[,$flag])>

This method edits the specified target using its class definition module,
instead of creating a new one.

=cut

sub define_target
{ my ($slf, $blk, $typ, $var, $flg) = @_;
  my ($bkp, $col, $def, $dir, $lng, $nam, $obj, $ref, $tgt, $val);

  # Determine the target type
  if ($ref = ref($typ))
  { $tgt = $typ;
    return unless $ref eq 'RDA::Object::Item';
    $typ = $tgt->get_first('W_CLASS');
    $val = $tgt->get_path;
  }
  return unless defined($typ);
  $nam = 'TG'.lc($typ);

  # Find the target definition package
  if (ref($blk) eq 'RDA::Agent')
  { $lng = $blk->get_lang('SDSL');
    $obj = $lng->search_package(['RDA'], $nam);
  }
  else
  { $blk = $blk->get_package;
    $lng = $blk->get_agent->get_lang('SDSL');
    $obj = defined($dir = $blk->get_info('dir'))
      ? $lng->load_file($nam, $dir)
      : $lng->search_package($blk->get_info('grp'), $nam);
  }
  return unless $obj;
  $lng->add_usage($obj);

  # Define the target
  $col = $blk->get_collector;
  $tgt = $col->find($val = $col->get_next($typ), 1) unless $ref;
  if (ref($var) eq 'HASH')
  { foreach my $key (keys(%{$var}))
    { $tgt->set_temp($key, $var->{$key});
    }
  }
  $def = $col->get_info('run')->find('CLASS', 1);
  $bkp = $def->backup;
  $def->set_temp('B_ADMIN_END',     0);
  $def->set_temp('B_ADMIN_VISIBLE', undef);
  $def->set_temp('K_ADMIN_PARENT',  undef);
  $def->set_temp('T_ADMIN_ALL',     undef);
  $def->set_temp('T_ADMIN_INPUT',   undef);
  $def->set_temp('T_ADMIN_VALUE',   'COL/'.$val);
  $def->set_temp('W_ADMIN_COMMAND', 'define');
  $obj->set_info('dpt', 1);
  $obj->set_info('shr', $blk->get_top);
  $obj->isolate unless $flg;
  $obj->request($def, $col->get_trace('CLASS'));
  $obj->delete_object;
  $def->restore($bkp);
  $def->clear if ($def = $def->find($typ));
  return $tgt;
}

=head1 TARGET MANAGEMENT METHODS

=head2 S<$h-E<gt>add_bad($oid,$type,$error)>

This method creates a sub target corresponding to an error and returns its
reference to the new target.

=cut

sub add_bad
{ my ($slf, $typ, $err) = @_;
  my ($cls, $def, $oid);

  # Validate the arguments
  $slf = $slf->get_top;
  die get_string('BAD_TYPE', $typ)
    unless exists($tb_bad{$typ = uc($typ)}) && exists($tb_cls{$typ});
  $cls = $tb_cls{$typ};
  $oid = $slf->get_unique($tb_bad{$typ});

  # Generate the definition
  $def = $slf->{'_itm'}->find(sprintf('%s_TMP%04d', $typ, ++$slf->{'_off'}),
    1);
  $def->set_value('W_CLASS', $typ);
  $def->set_value('T_TEST',  $err);

  # Create the sub target object
  eval "require $cls";
  die get_string('BAD_CLASS', $cls, $oid, $@) if $@;
  debug($slf->{'_trc'}." Add target $oid") if $slf->{'_trc'};
  return $slf->{'_tgt'}->{$oid} =
    $cls->new_bad($oid, $slf->{'col'}, $def, $slf);
}

=head2 S<$h-E<gt>add_target($item)>

This method creates a sub target based on the specified item object and extra
attributes unless it exists already. It returns a reference to the new target.

=head2 S<$h-E<gt>add_target($oid,$definition[,key=E<gt>value...])>

This method creates a sub target using the specified definition and extra
attributes. The definition is a hash reference, a setup target definition, or a
target reference.

When the target identifier starts with C<$$>, this method replaces that string
by a type-specific sequence number.

It returns a reference to the new target.

=cut

sub add_target  ## no critic (Complex)
{ my ($slf, $def, @arg) = @_;
  my ($cls, $edt, $flg, $key, $oid, $ref, $tgt, $tmp, $typ, $val);

  # Validate the arguments
  $slf = $slf->get_top;
  if (ref($def) eq 'RDA::Object::Item')
  { # Determine the target type
    $oid = $def->get_oid;
    return $slf->{'_tgt'}->{$oid} if exists($slf->{'_tgt'}->{$oid});
    $typ = $def->get_first('W_CLASS', q{});
    die get_string('BAD_NAME', $oid) unless exists($tb_cls{$typ});
    $cls = $tb_cls{$typ};
    $flg = 1;
  }
  elsif (defined($def))
  { # Validate the object identifier
    $oid = uc($def);
    die get_string('BAD_NAME', $oid)
      unless $oid =~ $RE_OID && exists($tb_cls{$1});
    $cls = $tb_cls{$typ = $1};
    $flg = $3;

    # Clone attributes when a target is provided as definition
    $ref = ref($tmp = shift(@arg));
    if ($ref =~ m/^RDA::Target::\w+$/)
    { $def = $tmp->get_definition;
      foreach my $key (keys(%{$tmp}))
      { next if $key !~ /^[a-z]{3}$/ || exists($tb_cln{$key});
        $edt = {} unless defined($edt);
        $edt->{$key} = $tmp->{$key};
      }
    }
    elsif ($ref eq 'HASH')
    { $def = $slf->{'_itm'}->find(sprintf('%s_TMP%04d', $typ, ++$slf->{'_off'}),
        1);
      $def->set_value('W_CLASS', $typ);
      foreach my $key (keys(%{$tmp}))
      { eval {$def->set_raw($key, $tmp->{$key})};
      }
    }
    else
    { die get_string('NO_DEFINITION');
    }

    # Treat the extra arguments
    while (($key, $val) = splice(@arg, 0, 2))
    { next unless defined($key) && defined($val);
      if ($key =~ m/^[a-z]{3}$/)
      { $edt = {} unless defined($edt);
        $edt->{$key} = $val;
      }
      elsif ($key =~ m/^[A-Z]_\w+$/)
      { eval {$def->set_temp($key, $val)};
      }
    }
  }
  else
  { die get_string('NO_NAME');
  }

  # Stop a previous target with the same name before adding the sub target
  $slf->end_target($oid) unless $flg;

  # Create the sub target object
  eval "require $cls";
  die get_string('BAD_CLASS', $cls, $oid, $@) if $@;
  debug($slf->{'_trc'}." Add target $oid") if $slf->{'_trc'};
  $tgt = $cls->new($oid, $slf->{'col'}, $def, $slf, $edt);
  return $slf->{'_tgt'}->{$tgt->{'oid'}} = $tgt;
}

=head2 S<$h-E<gt>end_target([$target...])>

This method ends the corresponding targets. You can specify a target by its
object reference or its object identifier. When no targets are specified, it
ends all sub targets.

It returns the number of deleted targets.

=cut

sub end_target
{ my ($slf, @arg) = @_;
  my ($cnt, $dft, $oid, $trc);

  # Initialization
  $cnt = 0;
  $slf = $slf->get_top;
  $dft = exists($slf->{'_dft'}) ? $slf->{'_dft'} : $slf;
  $trc = $slf->{'_trc'};

  # Delete the module target
  delete($slf->{'_mod'});

  # End targets
  if (@arg)
  { foreach my $arg (@arg)
    { $oid = ref($arg) ? $arg->get_oid : uc($arg);
      $cnt += _end_target($slf, delete($slf->{'_tgt'}->{$oid}), $trc)
        if exists($slf->{'_tgt'}->{$oid}) && $slf->{'_tgt'}->{$oid} != $dft;
    }
  }
  else
  { foreach my $oid (keys(%{$slf->{'_tgt'}}))
    { $cnt += _end_target($slf, delete($slf->{'_tgt'}->{$oid}), $trc)
        if exists($slf->{'_tgt'}->{$oid}) && $slf->{'_tgt'}->{$oid} != $dft;
    }

    # Restore the initial abbreviations
    reset_symbols($dft) unless $dft == $slf;

    # Reset the environment
    $slf->{'sys'}->reset;
  }

  # Indicate the number of delete targets
  return $cnt;
}

sub _end_target
{ my ($slf, $tgt, $trc) = @_;
  my ($cnt, $obj);

  # End all targets referencing it
  $cnt = 1;
  foreach my $oid (keys(%{$slf->{'_tgt'}}))
  { $obj = $slf->{'_tgt'}->{$oid};
    $cnt += _end_target($slf, delete($slf->{'_tgt'}->{$oid}), $trc)
      if grep {$obj->{$_} == $tgt} @{$obj->{'_chl'}};
  }

  # Restore the default target
  if (exists($tgt->{'_bkp'}))
  { _reset_target($slf, $tgt);
    delete($slf->{'_cur'});
  }

  # Delete the target
  debug("$trc Delete target ".$tgt->{'oid'}) if $trc;
  $tgt->delete_object;

  # Indicate the number of delete targets
  return $cnt;
}

=head2 S<$h-E<gt>find_target($type,$attr,$value)>

This method returns the first target of the specified type where the specified
attribute has the specified value.

=cut

sub find_target
{ my ($slf, $typ, $key, $val) = @_;

  foreach my $tgt (values(%{$slf->get_top('_tgt')}))
  { return $tgt if $tgt->{'_typ'} eq $typ && $tgt->{'_shr'}
      && exists($tgt->{$key}) && $tgt->{$key} eq $val;
  }
  return;
}

=head2 S<$h-E<gt>get_current>

This method returns a reference to the current target.

=cut

sub get_current
{ my ($slf) = @_;

  $slf = $slf->get_top;
  return exists($slf->{'_cur'}) ? $slf->{'_cur'} : $slf->{'_dft'};
}

=head2 S<$h-E<gt>get_default>

This method returns a reference to the default target.

=cut

sub get_default
{ return shift->get_top('_dft');
}

=head2 S<$h-E<gt>get_target($oid[,$default])>

This method returns the specified target if it exists. Otherwise, it returns
the default value.

=cut

sub get_target
{ my ($slf, $oid, $dft) = @_;
  my ($tgt);

  # Validate the arguments
  die get_string('NO_NAME')        unless defined($oid);
  die get_string('BAD_NAME', $oid) unless $oid =~ m/^[A-Z]\w*$/i;
  $tgt = uc($oid);

  # Find the target
  $slf = $slf->get_top;
  return
    ($tgt eq $slf->{'oid'})        ? $slf :
    exists($slf->{'_tgt'}->{$tgt}) ? $slf->{'_tgt'}->{$tgt} :
                                     $dft;
}

=head2 S<$h-E<gt>get_unique($oid)>

This method replaces the C<$$> string in the object identifier by a
type-specific sequence number. It takes care that the resulting identifier is
not currently used.

=cut

sub get_unique
{ my ($slf, $oid) = @_;
  my ($pat, $seq, $typ, $uid);

  # Detect a variable name
  $pat = uc($oid);
  die get_string('BAD_NAME', $pat)
    unless $pat =~ $RE_OID && exists($tb_cls{$typ = $1});
  return $pat unless $3;

  # Make it unique
  $slf = $slf->get_top;
  do
  { $uid = $pat;
    $seq = ++$slf->{'_seq'}->{$typ};
    $uid =~ s/\$\$/$seq/;
  } while exists($slf->{'_tgt'}->{$uid});
  return $uid;
}

=head2 S<$h-E<gt>list_targets([$type])>

This method returns the list of sub targets. You can restrict the list to the
targets corresponding to a specified type.

=cut

sub list_targets
{ my ($slf, $typ) = @_;
  my ($tbl);

  $slf = $slf->get_top;
  $tbl = $slf->{'_tgt'};
  return (sort keys(%{$tbl})) unless defined($typ);
  return (sort grep {$tbl->{$_}->{'_typ'} eq $typ} keys(%{$tbl}));
}

=head2 S<$h-E<gt>set_current([$tgt])>

This method assigns the specified target as the current target. By default, it
restores the default target as current target. It returns the previous target.

=cut

sub set_current
{ my ($slf, $tgt) = @_;
  my ($bkp, $old, $ref, $val);

  $slf = $slf->get_top;

  # Restore the environment
  if (exists($slf->{'_cur'}))
  { return $tgt if ref($tgt) && $tgt == $slf->{'_cur'};
    _reset_target($slf, $old = delete($slf->{'_cur'}));
  }
  else
  { $old = $slf->{'_dft'};
  }

  # Adapt the environment
  if ($ref = ref($tgt))
  { $tgt = $slf->add_target($tgt) if $ref eq 'RDA::Object::Item';
    _set_target($slf, $slf->{'_cur'} = $tgt)
      unless $tgt == $slf->{'_dft'};
  }

  # Return a reference to the previous target
  return $old;
}

# Restore the previous target environment
sub _reset_target
{ my ($slf, $tgt) = @_;

  $slf->{'sys'}->restore_context(delete($tgt->{'_bkp'}), $slf->{'_trc'})
    if exists($tgt->{'_bkp'});
  return;
}

# Adapt the environment for the current target
sub _set_target
{ my ($slf, $tgt) = @_;
  my ($trc);

  $trc = $slf->{'_trc'};
  debug("$trc New current target: ".$tgt->{'oid'}) if $trc;
  return $tgt->{'_bkp'} = $slf->{'sys'}->set_context($tgt->get_env, $trc);
}

=head2 S<$h-E<gt>switch_target($target,$function[,$arg...])>

This method switches the current target for executing the specified function. It
returns the function value.

=cut

sub switch_target
{ my ($slf, $tgt, $fct, @arg) = @_;
  my ($bkp, $err, $ret, $uid);

  $slf = $slf->get_top;
  $slf->{'agt'}->trace(get_string('T_Switch',
    ($tgt || $slf->get_default)->get_oid))
    unless $slf->{'lvl'} < 50;  ## no critic (Unless)
  $bkp = $slf->set_current($tgt);
  eval {$ret = &$fct(@arg)};
  $err = $@;
  $slf->{'agt'}->trace(get_string('T_Revert',
    ($bkp || $slf->get_default)->get_oid))
    unless $slf->{'lvl'} < 50;  ## no critic (Unless)
  $slf->set_current($bkp);
  if ($err)
  { die $err if $err =~ m/^$INTERRUPT/;
    $slf->{'agt'}->abort($err);
  }
  return $ret;
}

=head1 ORACLE CONTEXT METHODS

=head2 S<$h-E<gt>find_jars>

This method returns an empty list of C<jar> files required to connect to the
specified database.

=cut

sub find_jars
{ return;
}

=head2 S<$h-E<gt>find_jdbc>

This method returns a reference to the JDBC context.

=cut

sub find_jdbc
{ my ($slf) = @_;
  my (%ctx);

  # Use the JDBC-specific context when available
  return $slf->{'jdb'} if exists($slf->{'jdb'});

  # Determine specific JDK directory
  $ctx{'HOME'} = $slf->{'jdk'} if exists($slf->{'jdk'});

  # Return a default JDBC-specific context
  return {ctx => {%ctx},
          env => {},
          jar => exists($slf->{'jar'}) ? $slf->{'jar'} : []};
}

=head2 S<$h-E<gt>find_sqlplus>

This method returns a reference to the SQL*Plus context.

=cut

sub find_sqlplus
{ my ($slf) = @_;
  my ($sql, $tgt);

  return $slf->{'sql'} if exists($slf->{'sql'});
  foreach my $key (@{$slf->{'_chl'}})
  { return $sql if ($sql = $slf->{$key}->find_sqlplus);
  }
  return (ref($tgt = $slf->get_top('_mod')) && $tgt != $slf)
    ? $tgt->find_sqlplus
    : undef;
}

=head2 S<$h-E<gt>get_jdk_version($jdk)>

This method returns a list containing the two most significant elements of the
Java Development Kit (JDK) version.

=cut

sub get_jdk_version
{ my ($slf, $jdk) = @_;
  my ($pgm);

  if (defined($jdk))
  { if (-f ($pgm = RDA::Object::Rda->cat_file($jdk, 'bin',
                     RDA::Object::Rda->as_exe('java'))))
    { for (`$pgm -version 2>&1`)
      { return ($1, $2) if m/^java\sversion.*?(\d+)\.(\d+)\./;
      }
    }
    return ($1, $2) if $jdk =~ m/\bjdk(\d+)\.?(\d+)/i;
  }
  return;
}

=head2 S<$h-E<gt>get_sqlplus([$flag])>

This method returns a list containing the command and the associated
environment specifications. When the flag is true, it forces a new detection.

=cut

sub get_sqlplus
{ my ($slf, $flg) = @_;
  my ($sql);

  delete($slf->{'sql'}) if $flg;
  $sql = $slf->find_sqlplus || $slf->search_sqlplus;
  return ($sql->{'cmd'}, $sql->{'env'}, $sql->{'typ'});
}

=head2 S<$h-E<gt>reset_sqlplus($backup)>

This method resets the previous context.

=cut

sub reset_sqlplus
{ my ($slf, $bkp) = @_;

  $slf = $slf->get_top;
  return $slf->{'sys'}->restore_context($bkp, $slf->{'_trc'});
}

=head2 S<$h-E<gt>search_sqlplus>

This method searches a SQL*Plus context.

=cut

sub search_sqlplus  ## no critic (Complex)
{ my ($slf) = @_;
  my ($cmd, $dft, $dir, $env, $lib, $sep, $sys, $val);

  $slf = $slf->get_top;
  $sys = $slf->{'sys'};

  # Return the result of a previous detection
  return $slf->{'sql'} if exists($slf->{'sql'});

  # Determine how to execute SQL*Plus on first use
  $dft = $slf->{'col'}->get_info('def');
  $lib = RDA::Object::Rda->get_shlib;
  $sep = RDA::Object::Rda->get_separator;

  if (defined($val = $dft->get_first('D_SQL_HOME')))
  { $slf->{'sql'} = {cmd => $dft->get_first('T_SQL_COMMAND'),
                     env => $env = {},
                     typ => 'SET'};
    unless (RDA::Object::Rda->is_vms)
    { $env->{'ORACLE_HOME'} = $val;
      $dir = $sys->is_restricted(RDA::Object::Rda->cat_dir($val, 'bin'));
      $env->{'PATH'} = join($sep, $dir, $sys->get_list('pth'))
        if defined($dir);
      $env->{$lib} = join($sep, RDA::Object::Rda->cat_dir($val, 'lib'),
                                $sys->get_list('shl'))
        if defined($lib);
    }
    return $slf->{'sql'};
  }

  if (RDA::Object::Rda->is_vms)
  { return $slf->{'sql'} = {cmd => 'PIPE SQLPLUS',
                            env => {},
                            typ => 'VMS'};
  }

  # Scan the Oracle home targets
  foreach my $tgt ($slf->{'col'}->get_items('OH'))
  { next unless defined($val = $tgt->get_first('D_ORACLE_HOME'));
    if (RDA::Object::Rda->is_unix)
    { if (-f ($cmd = RDA::Object::Rda->cat_file($val, 'bin', 'sqlplus')))
      { $slf->{'sql'} = {cmd => $cmd,
                         env => $env = {},
                         typ => 'TGT'};
        $env->{'ORACLE_HOME'} = $val;
        $dir = $sys->is_restricted(RDA::Object::Rda->cat_dir($val, 'bin'));
        $env->{'PATH'} = join($sep, $dir, $sys->get_list('pth'))
          if defined($dir);
        $env->{$lib} = join($sep, RDA::Object::Rda->cat_dir($val, 'lib'),
                                  $sys->get_list('shl'))
          if defined($lib);
        $env->{'INITIAL_HOME'} = $dft->{'_env'}->{'INITIAL_HOME'}
          if exists($dft->{'_env'}->{'INITIAL_HOME'});
        return $slf->{'sql'};
      }
    }
    elsif (-f ($cmd = RDA::Object::Rda->cat_file($val, 'bin', 'PLUS80.exe')) ||
           -f ($cmd = RDA::Object::Rda->cat_file($val, 'bin', 'sqlplus.exe')))
    { $slf->{'sql'} = {cmd => $cmd,
                       env => $env = {},
                       typ => 'TGT'};
      $env->{'ORACLE_HOME'} = $val;
      $env->{'PATH'} = join($sep, RDA::Object::Rda->cat_dir($val, 'bin'),
                                  $sys->get_list('pth'));
      return $slf->{'sql'};
    }
  }

  # Assume that SQL*Plus could be available in calling context
  $slf->{'sql'} = {cmd => $cmd = $dft->get_first('T_SQL_COMMAND','sqlplus'),
                   env => $env = {},
                   typ => 'INI'};
  if (defined($val = $sys->get_init('HOM')))
  { $env->{'ORACLE_HOME'} = $val = RDA::Object::Rda->native($val);
    $dir = $sys->is_restricted(RDA::Object::Rda->cat_dir($val, 'bin'));
    if (defined($dir))
    { $env->{'PATH'} = join($sep, $dir, $sys->get_list('pth'));
    }
    elsif (!RDA::Object::Rda->is_absolute($cmd))
    { $slf->{'sql'}->{'cmd'} = RDA::Object::Rda->cat_file($val, 'bin', $cmd);
    }
    $env->{$lib} = join($sep, RDA::Object::Rda->cat_dir($val, 'lib'),
                              $sys->get_list('shl'))
      if defined($lib);
    return $slf->{'sql'};
  }

  # Adjust when SQL*Plus can be derived from settings
  if (exists($dft->{'hom'}))
  { $dft = $slf->{'_dft'};
    $val = $dft->{'hom'};
    if ((RDA::Object::Rda->is_unix &&
          -f ($cmd = RDA::Object::Rda->cat_file($val, 'bin', 'sqlplus')))
    || (RDA::Object::Rda->is_windows || RDA::Object::Rda->is_cygwin) &&
        (-f ($cmd = RDA::Object::Rda->cat_file($val, 'bin', 'PLUS80.exe')) ||
         -f ($cmd = RDA::Object::Rda->cat_file($val, 'bin', 'sqlplus.exe'))))
    { $slf->{'sql'}->{'cmd'} = $cmd;
      $env->{'INITIAL_HOME'} = $dft->{'_env'}->{'INITIAL_HOME'}
        if exists($dft->{'_env'}->{'INITIAL_HOME'})
        && RDA::Object::Rda->is_unix;
      $env->{'ORACLE_HOME'}  = $dft->{'_env'}->{'ORACLE_HOME'};
      $env->{'PATH'}         = $dft->{'_env'}->{'PATH'};
      $env->{$lib}           = $dft->{'_env'}->{$lib}
        if defined($lib);
    }
  }

  # Return the detection results
  return $slf->{'sql'};
}

=head2 S<$h-E<gt>set_sqlplus>

This method sets the SQL*Plus context. It returns the command and the changes
done in the environment.

=cut

sub set_sqlplus
{ my ($slf) = @_;
  my ($sql, $trc);

  $sql = $slf->find_sqlplus || $slf->search_sqlplus;
  $slf = $slf->get_top;
  $trc = $slf->{'_trc'};
  debug(qq{$trc Switch to SQL*Plus context (}.$sql->{'typ'}.q{)}) if $trc;
  return ($sql->{'cmd'}, $slf->{'sys'}->set_context($sql->{'env'}, $trc));
}

=head1 COMMON TARGET METHODS

=head2 S<$h-E<gt>find_command($command[,$flag])>

This method explores the path to find where a command is located. When found,
it returns the full path name. Otherwise, it returns an undefined variable. It
only considers files or symbolic links in its search. If the flag is set, the
file path is quoted as required by a command shell.

=cut

sub find_command
{ my ($slf, @arg) = @_;
  my ($env);

  $env = $slf->get_env;
  return exists($env->{'PATH'})
    ? RDA::Object::Rda->find_path($env->{'PATH'}, @arg)
    : $slf->get_top('cfg')->find(@arg);
}

=head2 S<$h-E<gt>get_definition>

This method returns a reference to the target definition hash.

=cut

sub get_definition
{ return shift->{'_def'};
}

=head2 S<$h-E<gt>get_detail($ref[,$key[,$default]])>

This method returns the first target from the target tree where the referenced
attribute is defined. When an attribute name is also specified as argument, it
returns its value. When the attribute is not found, it returns the default
value.

You can specify a C<.> to get the value of the reference attribute.

=cut

sub get_detail
{ my ($slf, $ref, $key, $dft) = @_;
  my ($tgt);

  if (ref($tgt = _get_detail($slf, $ref)))
  { return $tgt unless defined($key);
    $key = $ref if $key eq q{.};
    return $tgt->{$key} if exists($tgt->{$key});
  }
  return $dft;
}

sub _get_detail
{ my ($slf, $ref) = @_;
  my ($tgt);

  return $slf if exists($slf->{$ref});
  foreach my $key (@{$slf->{'_chl'}})
  { return $tgt if ref($tgt = _get_detail($slf->{$key}, $ref));
  }
  return;
}

=head2 S<$h-E<gt>get_env>

This method returns the environment variable specifications as a hash
reference.

=cut

sub get_env
{ my ($slf) = @_;

  return (ref($slf->{'_env'}) eq 'HASH')
    ? $slf->{'_env'}
    : {};
}

=head2 S<$h-E<gt>get_focus([$name[,$list]])>

This method returns the list of all identifiers associated to the specified
focus area name. By default, it returns all identifiers.

=cut

sub get_focus
{ my ($slf, $nam, $src) = @_;
  my ($fcs, $tbl, @dst, @src);

  if (exists($slf->{'_fcs'}))
  { $tbl = $slf->{'_fcs'};

    # Determine the candidates
    if (ref($src) eq 'ARRAY')
    { foreach my $uid (@{$src})
      { push(@src, $uid) if exists($tbl->{$uid});
      }
    }
    else
    { @src = keys(%{$tbl});
    }

    # Select the identifiers
    return @src unless defined($nam);
    foreach my $uid (@src)
    { if (ref($fcs = $tbl->{$uid}))
      { push(@dst, $uid) if exists($fcs->{$nam});
      }
      else
      { push(@dst, $uid);
      }
    }
  }
  return @dst;
}

=head2 S<$h-E<gt>get_type>

This method returns the target type.

=cut

sub get_type
{ return shift->{'_typ'};
}

=head2 S<$h-E<gt>set_focus($name[,$list])>

When the target supports focus, this method associates a comma-separated list
of focus area names to the specified identifier. It discards focus area names
that contain characters other than alphanumeric characters or underscores
(_). When the list is undefined, the C<get_focus> method will select the
identifier for any focus area.

It returns the number of focus area names associated to the identifier.

=cut

sub set_focus
{ my ($slf, $uid, $str) = @_;
  my ($col, $cnt, $tbl, @tbl);

  # Validate the argument
  die get_string('BAD_FOCUS') unless defined($uid) && $uid =~ m/^\w+$/;
  die get_string('NO_FOCUS', $slf->{'oid'}) unless exists($slf->{'_fcs'});

  # Associate focus areas to the identifier
  return $slf->{'_fcs'}->{$uid} = undef unless defined($str);

  $col = $slf->{'col'};
  $cnt = 0;
  $slf->{'_fcs'}->{$uid} = $tbl = {};
  foreach my $nam (split(/,/, $str))
  { $tbl->{$6} = ++$cnt
      if $nam =~ m/^(((\w+)\/)?((\w+\.)*\w+)\?)?(\w+)$/
      && (!$1 || ($2 ? $col->get_item($3)->get_first($4)
                     : $col->get_info('set')->get_first($4)));
  }
  return $cnt;
}

=head1 SYMBOL MANAGEMENT METHODS

The symbol management is disabled for VMS.

=head2 S<$h-E<gt>add_symbol($dir)>

This method detects when a base directory matches a defined symbol. It returns
the resulting directory string.

=cut

sub add_symbol
{ my ($slf, $dir) = @_;
  my ($abr, $flg, $hsh, $str, $sub, $tbl, @dir, @prv);

  # Check symbol availability
  return RDA::Object::Rda->native($dir)
    unless exists($slf->{'_prs'}) && defined($dir) && length($dir);

  # Detect when a symbol is applicable
  $dir = RDA::Object::Rda->native($dir);
  $flg = RDA::Object::Rda->is_unix;
  $tbl = $slf->{'_prs'};
  @dir = RDA::Object::Rda->split_dir($dir);
  while (defined($sub = shift(@dir)))
  { $hsh = $tbl->[0];
    $str = $flg ? $sub : lc($sub);
    ($abr, @prv) = ($tbl->[1]) if defined($tbl->[1]);
    return $abr
      ? RDA::Object::Rda->cat_native($abr, @prv, $sub, @dir, q{})
      : $dir
      unless exists($hsh->{$str});
    push(@prv, $sub) if $abr;
    $tbl = $hsh->{$str};
  }
  return
    defined($tbl->[1]) ? $tbl->[1] :
    $abr               ? RDA::Object::Rda->cat_native($abr, @prv, q{}) :
                         $dir;
}

=head2 S<$h-E<gt>cat_symbol($file)>

This method detects when a base directory matches a defined symbol. It returns
the resulting path string.

=cut

sub cat_symbol
{ my ($slf, $pth) = @_;
  my ($dir, $fil);

  ($dir, $fil) = RDA::Object::Rda->parse_path($pth);
  return RDA::Object::Rda->cat_native($slf->add_symbol($dir), $fil)
}

=head2 S<$h-E<gt>get_symbols([$hash])>

This method returns a hash containing the symbol definitions applicable to the
target.

=cut

sub get_symbols
{ my ($slf, $def) = @_;

  $def = {} unless ref($def) eq 'HASH';
  _get_symbols($slf, $def);
  return (map {$_ => RDA::Object::Rda->cat_native(
                       (map {ref($_) ? $_->[0] : $_} @{$def->{$_}->[0]}), q{})}
              sort keys(%{$def}));
}

sub _get_symbols
{ my ($slf, $def) = @_;

  foreach my $key (@{$slf->{'_chl'}})
  { _get_symbols($slf->{$key}, $def);
  }
  if (exists($slf->{'_abr'}))
  { foreach my $key (keys(%{$slf->{'_abr'}}))
    { $def->{$key} = $slf->{'_abr'}->{$key};
    }
  }
  return;
}

=head2 S<$h-E<gt>init_symbol>

This method updates the symbol parse tree.

=cut

sub init_symbols
{ my ($slf) = @_;

  _init_symbols($slf) if exists($slf->{'_abr'});
  return $slf;
}

sub _init_symbols
{ my ($slf) = @_;
  my ($flg, $hsh, $str, $tbl, @abr, @dir, %def);

  _get_symbols($slf, \%def);
  if (@abr = keys(%def))
  { $slf->{'_prs'} = [{}];
    $flg = RDA::Object::Rda->is_unix;
    foreach my $key (sort @abr)
    { foreach my $abr (@{$def{$key}})
      { $tbl = $slf->{'_prs'};
        @dir = @{$abr};
        while (defined($str = shift(@dir)))
        { $hsh = $tbl->[0];
          if (ref($str))
          { my (@syn);

            $tbl = [{}];
            foreach my $syn (@{$str})
            { $syn = lc($syn) unless $flg;
              if (exists($hsh->{$syn}))
              { $tbl = $hsh->{$syn};
              }
              else
              { push(@syn, $syn);
              }
            }
            foreach my $syn (@syn)
            { $hsh->{$syn} = $tbl;
            }
          }
          else
          { $str = lc($str) unless $flg;
            $hsh->{$str} = [{}] unless exists($hsh->{$str});
            $tbl = $hsh->{$str};
          }
        }
        $tbl->[1] = $key;
      }
    }
  }
  else
  { delete($slf->{'_prs'});
  }
  return;
}

=head2 S<$h-E<gt>reset_symbol>

This method restore the original symbols.

=cut

sub reset_symbols
{ my ($slf) = @_;
  my ($abr, $chg, $val);

  if ($chg = delete($slf->{'_chg'}))
  { # Undo the abbreviation changes
    $abr = $slf->{'_abr'};
    foreach my $key (keys(%{$chg}))
    { if (defined($val = $chg->{$key}))
      { $abr->{$key} = $val;
      }
      else
      { delete($abr->{$key});
      }
    }

    # Update the parse tree
    _init_symbols($slf);
  }
  return $slf;
}

=head2 S<$h-E<gt>set_symbol($abbr[,$dir])>

This method manages the symbol definitions. It deletes the symbol when a
directory is not specified. It returns the previous definition.

=cut

sub set_symbol
{ my ($slf, $abr, $dir) = @_;
  my ($old);

  return unless exists($slf->{'_abr'});

  # Determine the default abbreviation
  if (defined($abr))
  { return unless length($abr);
  }
  else
  { $abr = q{$}.$slf->{'oid'};
    $abr = $1.$2 if $abr =~ m/^(\$[A-Z]+)_T0*(\d+)$/;
  }

  # Get the previous directory
  $old = delete($slf->{'_abr'}->{$abr});
  $slf->{'_chg'}->{$abr} = $old unless exists($slf->{'_chg'}->{$abr});
  $old = RDA::Object::Rda->cat_native(
    (map {ref($_) ? $_->[0] : $_} @{$old->[0]}), q{}) if defined($old);

  # Define the symbol
  (RDA::Object::Rda->is_windows || RDA::Object::Rda->is_cygwin)
    ? _set_short($slf, $abr, $dir)
    : _set_symbol($slf, $abr, $dir)
    if defined($dir) && length($dir);

  # Update the parse tree
  _init_symbols($slf);

  # Return the previous definition
  return $old;
}

sub _set_short
{ my ($slf, $abr, $dir) = @_;
  my ($alt, $rec, @alt, @tbl);

  $dir = RDA::Object::Rda->clean_native([$dir, q{}], 1);
  @alt = RDA::Object::Rda->split_dir($slf->get_top('cfg')->short($dir));
  @tbl = RDA::Object::Rda->split_dir($dir);
  if ((scalar @alt) == (scalar @tbl))
  { $slf->{'_abr'}->{$abr} = [$rec = []];
    foreach my $itm (@tbl)
    { $alt = shift(@alt);
      push(@{$rec}, (lc($itm) eq lc($alt)) ? $itm : [$itm, $alt]);
    }
  }
  else
  { $slf->{'_abr'}->{$abr} = [[@tbl], [@alt]];
  }
  return;
}

sub _set_symbol
{ my ($slf, $abr, $dir) = @_;

  return $slf->{'_abr'}->{$abr} =
    [[RDA::Object::Rda->split_dir(RDA::Object::Rda->native($dir))]];
}

=head1 DOMAIN, ORACLE HOME AND INSTANCE METHODS

=head2 S<$h-E<gt>get_base([$key[,$default]])>

This method returns the associated Oracle instance target object. When an
attribute name is specified, it returns its value. When the attribute is not
found, it returns the default value.

You can specify a C<.> to get the base directory.

=cut

sub get_base
{ my $slf = shift;

  return $slf->get_detail('bas', @_);
}

=head2 S<$h-E<gt>get_common([$key[,$default]])>

This method returns the associated Common Components home target object. When
an attribute name is specified, it returns its value. When the attribute is not
found, it returns the default value.

You can specify a C<.> to get the Common Components home directory.

=cut

sub get_common
{ my $slf = shift;

  return $slf->get_detail('cch', @_);
}

=head2 S<$h-E<gt>get_domain([$key[,$default]])>

This method returns the associated Oracle WebLogic Server domain target
object. When an attribute name is specified, it returns its value. When the
attribute is not found, it returns the default value.

You can specify a C<.> to get the domain home directory.

=cut

sub get_domain
{ my $slf = shift;

  return $slf->get_detail('dom', @_);
}

=head2 S<$h-E<gt>get_home([$key[,$default]])>

This method returns the associated Oracle home target object. When an attribute
name is specified, it returns its value. When the attribute is not found, it
returns the default value.

You can specify a C<.> to get the Oracle home directory.

=cut

sub get_home
{ my $slf = shift;

  return $slf->get_detail('hom', @_);
}

=head2 S<$h-E<gt>get_instance([$key[,$default]])>

This method returns the associated Oracle instance target object. When an
attribute name is specified, it returns its value. When the attribute is not
found, it returns the default value.

You can specify a C<.> to get the instance home directory.

=cut

sub get_instance
{ my $slf = shift;

  return $slf->get_detail('ins', @_);
}

=head2 S<$h-E<gt>get_mw_home([$key[,$default]])>

This method returns the associated Oracle Middleware home target object. When
an attribute name is specified, it returns its value. When the attribute is not
found, it returns the default value.

You can specify a C<.> to get the Oracle Middleware home directory.

=cut

sub get_mw_home
{ my $slf = shift;

  return $slf->get_detail('mwh', @_);
}

=head2 S<$h-E<gt>get_wl_home([$key[,$default]])>

This method returns the associated Oracle WebLogic Server home target
object. When an attribute name is specified, it returns its value. When the
attribute is not found, it returns the default value.

You can specify a C<.> to get the Oracle WebLogic Server home directory.

=cut

sub get_wl_home
{ my $slf = shift;

  return $slf->get_detail('wlh', @_);
}

=head2 S<$h-E<gt>is_enabled>

This method indicates that the target can not execute SQL statements.

=cut

sub is_enabled
{ return 0;
}

=head2 S<$h-E<gt>is_fatal>

This method indicates that SQL errors are fatal.

=cut

sub is_fatal
{ return 1;
}

=head2 S<$h-E<gt>is_tested>

This method indicates that RDA can not test connection with such a target.

=cut

sub is_tested
{ return get_string('CANNOT_TEST');
}

# --- SDCL extensions ---------------------------------------------------------

# Initialize the module target
sub _begin_control
{ my ($pkg) = @_;
  my ($col, $ctl, $obj);

  $col = $pkg->get_collector;
  $ctl = $col->get_target;
  $ctl->{'_mod'} = $ctl->set_current($obj)
    if defined($obj = $pkg->get_top('nam'))
    && defined($obj = $col->get_first("STATUS.$obj.I_TGT"));
  $pkg->set_top('TGT', $ctl);
  return;
}

# Close all package targets
sub _end_control
{ shift->get_collector->get_target->end_target;
  return;
}

1;

__END__

=head1 SEE ALSO

L<RDA::Agent|RDA::Agent>,
L<RDA::Object|RDA::Object>,
L<RDA::Object::Collect|RDA::Object::Collect>,
L<RDA::Object::Rda|Item::Object::Item>,
L<RDA::Object::Rda|RDA::Object::Rda>,
L<RDA::Target::Base|RDA::Target::Base>,
L<RDA::Target::Common|RDA::Target::Common>,
L<RDA::Target::Database|RDA::Target::Database>,
L<RDA::Target::Db|RDA::Target::Db>,
L<RDA::Target::Dbi|RDA::Target::Dbi>,
L<RDA::Target::Domain|RDA::Target::Domain>,
L<RDA::Target::Home|RDA::Target::Home>,
L<RDA::Target::Instance|RDA::Target::Instance>,
L<RDA::Target::MwHome|RDA::Target::MwHome>,
L<RDA::Target::System|RDA::Target::System>,
L<RDA::Target::WlHome|RDA::Target::WlHome>,
L<RDA::Text|RDA::Text>

=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