# MwHome.pm: Class Used to Interface the Middleware Homes

package RDA::Target::MwHome;

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

=head1 NAME

RDA::Target::MwHome - Class Used to Interface the Middleware Homes

=head1 SYNOPSIS

 require RDA::Target::MwHome;

=head1 DESCRIPTION

The objects of the C<RDA::Target::MwHome> class are used to interface with the
Middleware homes. It is a subclass of
L<RDA::Object::Target|RDA::Object::Target>.

The following methods are available:

=cut

use strict;

BEGIN
{ use Exporter;
  use IO::File;
  use RDA::Text qw(get_string);
  use RDA::Driver::Product;
  use RDA::Object;
  use RDA::Object::Rda;
  use RDA::Object::Target;
  use RDA::Object::Xml;
}

# Define the global public variables
use vars qw($STRINGS $VERSION @DUMP @ISA %SDCL);
$VERSION = sprintf('%d.%02d', q$Revision: 1.16 $ =~ /(\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 RDA::Driver::Product Exporter);
%SDCL    = (
  inc => [qw(RDA::Object::Target RDA::Object)],
  met => {
    'get_location'  => {ret => 0},
    'get_product'   => {ret => 0},
    'get_products'  => {ret => 1},
    'get_version'   => {ret => 0},
    'has_inventory' => {ret => 0},
    },
  );

# Define the global private constants

# Define the global private variables

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

=head2 S<$h = RDA::Target::MwHome-E<gt>new($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
L<RDA::Object::Target|RDA::Object::Target> methods.

C<RDA::Target::MwHome> is represented by a blessed hash reference. The
following special keys are used:

=over 12

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

=item S<    B<'col' > > Reference to the collector object

=item S<    B<'jdk' > > JDK directory

=item S<    B<'oid' > > Object identifier

=item S<    B<'mwh' > > Middleware home directory

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

=item S<    B<'raw' > > Raw value indicator

=item S<    B<'_abr'> > Symbol definition hash

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

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

=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<'_inv'> > Inventory object

=item S<    B<'_prd'> > OCM product list

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

=item S<    B<'_shr'> > Share indicator

=item S<    B<'_src'> > Inventory source

=item S<    B<'_typ'> > Target type

=back

Internal keys are prefixed by an underscore.  Defined inventory sources are:

=over 12

=item S<    B<'INV'> > Oracle home inventory

=item S<    B<'OCM'> > OCM configuration information

=back

An empty string indicates that no inventory has been found.

=cut

sub new
{ my ($cls, $oid, $col, $def, $par, $edt) = @_;
  my ($flg, $key, $raw, $slf, $tgt, $val);

  # Create the system object
  $raw = $def->get_first('B_RAW', 0);
  $slf = bless {
    cfg  => $col->get_config,
    col  => $col,
    oid  => $par->get_unique($oid),
    par  => $par,
    raw  => $raw,
    _chl => [],
    _def => $def,
    _fcs => {},
    _shr => $def->get_first(['B_DEDICATED_MW_HOME','B_DEDICATED']) ? 0 : 1,
    _typ => 'WH',
    }, ref($cls) || $cls;

  # Load the target definition
  $slf->{'mwh'} = $val
    if defined($val = $def->get_first('D_MW_HOME', undef, $raw));

  # Add the initial attributes
  if ($edt)
  { foreach my $key (keys(%{$edt}))
    { $slf->{$key} = $edt->{$key};
    }
  }

  # Validate the configuration
  die get_string('NO_HOME', $oid) unless exists($slf->{'mwh'});

  # Load the associated Common Components home target
  unless ($def->get_first('B_MISSING_COMMON'))
  { if (defined($val = $def->get_first('I_COMMON_HOME')))
    { $slf->{'_cch'} = $slf->add_target($val);
      push(@{$slf->{'_chl'}}, '_cch');
    }
    elsif (defined($val = $def->get_first('W_COMMON_HOME')))
    { $slf->{'_cch'} = $slf->get_target($val);
      push(@{$slf->{'_chl'}}, '_cch');
    }
    elsif (defined($val = _find_common($slf, $def, $raw)))
    { if (($flg = $def->get_prime('B_DEDICATED_COMMON'))
        || !($tgt = $par->find_target('CH',
                                      cch => RDA::Object::Rda->native($val))))
      { $oid =~ s/^MH_/CH_/i;
        $tgt = $slf->add_target($oid,
          {B_DEDICATED_COMMON => $flg,
           B_RAW              => $raw,
           D_COMMON_HOME      => $val,
           T_CH_ABBR          => $def->get_prime('T_CH_ABBR'),
          });
      }
      $slf->{'_cch'} = $tgt;
      push(@{$slf->{'_chl'}}, '_cch');
    }
  }

  # Get the Java home
  $slf->{'jdk'} = $val if defined($val = _find_java_home($slf, $def));

  # Initiate the symbol management when applicable
  unless (RDA::Object::Rda->is_vms)
  { $slf->{'_abr'} = {};
    $slf->set_symbol($def->get_first('T_MH_ABBR'), $slf->{'mwh'});
    delete($slf->{'_chg'});

    $slf->get_top('cfg')->short(
      RDA::Object::Rda->clean_native([$slf->{'mwh'}, 'user_projects', q{}]))
      unless RDA::Object::Rda->is_unix;
  }

  # Return the object reference
  return $slf;
}

=head2 S<$h-E<gt>adjust_env($env)>

This method adjusts environment variable specifications for the Oracle WebLogic
Server home.

=cut

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

  # Apply Oracle common specifications
  $slf->{'_cch'}->adjust_env($env)
    if exists($slf->{'_cch'});

  # Add the target specifications
  return $env->{'BEA_HOME'} =
         $env->{'MW_HOME'}  = RDA::Object::Rda->native($slf->{'mwh'});
}

=head2 S<$h-E<gt>find_jars($typ,$src,$jdk)>

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

=cut

sub find_jars
{ my ($slf, $typ, $src, $jdk) = @_;

  return $slf->{'_cch'}->find_jars($typ, $src, $jdk) if exists($slf->{'_cch'});
  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) = @_;

  # Determine the environment specifications on first usage
  adjust_env($slf, $slf->{'_env'} = {%{$slf->get_default->get_env}})
    unless exists($slf->{'_env'});

  # Return the environment specifications
  return $slf->{'_env'};
}

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

This method initializes the inventory search.

=cut

sub init_inventory
{ my ($slf) = @_;
  my ($fil);

  # Examine the Oracle home inventory
  $slf->{'_src'} = q{};
  unless ($slf->{'col'}->get_first('DEFAULT.B_NO_INVENTORY'))
  { if (-r ($fil = RDA::Object::Rda->cat_file($slf->{'mwh'},
                    'inventory', 'ContentsXML', 'comps.xml')) ||
        -r ($fil = RDA::Object::Rda->cat_file($slf->{'mwh'}, 'oracle_common',
                    'inventory', 'ContentsXML', 'comps.xml')))
    { $slf->{'_inv'} = RDA::Object::Xml->new->parse_file($fil);
      $slf->{'_src'} = 'INV';
    }
  }

  # Return the object reference
  return $slf;
}

# --- Internal routines -------------------------------------------------------

# Find the Common Components home directory
sub _find_common
{ my ($slf, $def, $raw) = @_;
  my ($dir);

  # Check the definition
  return $dir
    if defined($dir = $def->get_prime('D_COMMON_HOME', undef, $raw));

  # Try to detect the common components home directory
  $dir = RDA::Object::Rda->cat_dir($slf->{'mwh'}, 'oracle_common');
  return ($raw || -d $dir) ? $dir : undef;
}

# Find the Java home directory
sub _find_java_home
{ my ($slf, $def) = @_;

  return $def->get_prime('D_JAVA_HOME', undef, $slf->{'raw'})
    || _get_item($slf, 'jdk');
}

# Detect the Oracle WebLogic Server-associated homes
sub _get_homes
{ my ($slf) = @_;
  my ($det, $ifh);

  # Return the detection result when already available
  return $slf->{'_det'} if exists($slf->{'_det'});

  # Detect the associated home directories on first use
  $slf->{'_det'} = $det = {};
  _get_homes_prop($slf, $det) unless $slf->{'_def'}->{'B_NO_DETECT'};
  return $det;
}

sub _get_homes_prop
{ my ($slf, $det) = @_;
  my ($ifh, $val);

  $ifh = IO::File->new;
  if ($ifh->open('<'.RDA::Object::Rda->cat_file($slf->{'mwh'}, 'oui',
    '.globalEnv.properties')))
  { while (<$ifh>)
    { if (m/^[^\043]*\bJAVA_HOME=(.*)$/)
      { if (length($val = $1))
        { $val =~ s/(\w+)\\:/$1:/;
          $det->{'jdk'} = RDA::Object::Rda->cat_dir($val);
        }
        last;
      }
    }
    $ifh->close;
  }
  return;
}

# Get a detected item
sub _get_item
{ my ($slf, $key, $dft) = @_;
  my ($det);

  $det = _get_homes($slf);
  return exists($det->{$key}) ? $det->{$key} : $dft;
}

1;

__END__

=head1 SEE ALSO

L<RDA::Agent|RDA::Agent>,
L<RDA::Driver::Product|RDA::Driver::Product>,
L<RDA::Object|RDA::Object>,
L<RDA::Object::Collect|RDA::Object::Collect>,
L<RDA::Object::Item|RDA::Object::Item>,
L<RDA::Object::Rda|RDA::Object::Rda>,
L<RDA::Object::Target|RDA::Object::Target>,
L<RDA::Object::Xml|RDA::Object::Xml>,
L<RDA::Target::Common|RDA::Target::Common>,
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