# Product.pm: Class Used for Managing Auto Discovery Aspects

package RDA::Driver::Product;

# $Id: Product.pm,v 1.10 2015/05/08 18:09:24 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/Driver/Product.pm,v 1.10 2015/05/08 18:09:24 RDA Exp $
#
# Change History
# 20150508  MSC  Improve the documentation.

=head1 NAME

RDA::Driver::Product - Class Used for Managing Auto Discovery Aspects

=head1 SYNOPSIS

 require RDA::Driver::Product;

=head1 DESCRIPTION

The objects of the C<RDA::Driver::Product> class are used to manage the auto
discovery aspects.

The following methods are available:

=cut

use strict;

BEGIN
{ use Exporter;
  use RDA::Text qw(get_string);
  use RDA::Object::Rda;
  use RDA::Object::Xml;
}

# Define the global public variables
use vars qw($STRINGS $VERSION @ISA);
$VERSION = sprintf('%d.%02d', q$Revision: 1.10 $ =~ /(\d+)\.(\d+)/);
@ISA     = qw(Exporter);

# Define the global private constants

# Define the global private variables
my %tb_fct = (
  q{a|} => \&_get_bas_any_version,
  q{A|} => \&_get_max_any_version,
  q{c|} => \&_get_bas_cmp_version,
  q{C|} => \&_get_max_cmp_version,
  q{t|} => \&_get_bas_top_version,
  q{T|} => \&_get_max_top_version,
  );

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

=head2 S<$h = RDA::Driver::Product-E<gt>new($oid,$col,$hom)>

The object constructor. It takes the object identifier, the collector object
reference, and the home directory as arguments.

C<RDA::Driver::Product> 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<'oid' > > Object identifier

=item S<    B<'_inv'> > Inventory object

=item S<    B<'_prd'> > Oracle Configuration Manager product list

=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'> > Oracle Configuration Manager configuration information

=back

An empty string indicates that no inventory has been found.

=cut

sub new
{ my ($cls, $col, $hom) = @_;

  return bless {
    cfg  => $col->get_config,
    col  => $col,
    hom  => $hom,
    oid  => $hom,
    _typ => 'OH',
  }, ref($cls) || $cls;
}

=head1 AUTO DISCOVERY METHODS

=head2 S<$h-E<gt>get_location($nam[,$dft])>

This method returns the location of the specified component. It returns the
default value when the specified component is not found in the inventory.

=cut

sub get_location
{ my ($slf, $nam, $dft) = @_;
  my ($res);

  # Validate the parameters
  return $dft unless $nam =~ m/^\w+(\.\w+)*$/;

  # Initialize it on the first call
  $slf->init_inventory unless exists($slf->{'_src'});

  # Find the attribute
  if ($slf->{'_src'} eq 'INV')
  { $nam =~ s/\./\\\./g;
    $res = _get_first($slf->{'_inv'},"PRD_LIST/COMP_LIST/COMP NAME='^$nam\$'");
    return $res->{'INST_LOC'} if $res && exists($res->{'INST_LOC'});
  }
  elsif ($slf->{'_src'} eq 'OCM')
  { foreach my $obj (@{$slf->{'_prd'}})
    { return _get_text($obj, 'INSTALLED_LOCATION', $dft)
        if _get_text($obj, 'NAME', q{}) eq $nam;
    }
  }
  return $dft;
}

=head2 S<$h-E<gt>get_product([$dft])>

This method returns the extended name of the product or the default value when
the extended name is not available.

=cut

sub get_product
{ my ($slf, $dft) = @_;

  # Initialize it on the first call
  $slf->init_inventory unless exists($slf->{'_src'});

  # Get the extended name of the product
  if ($slf->{'_src'} eq 'INV')
  { my ($xml) = $slf->{'_inv'}->find('PRD_LIST/TL_LIST/COMP/EXT_NAME');
    return $xml->get_data if $xml;
  }
  return $dft;
}

=head2 S<$h-E<gt>get_products([$nam...])>

This method returns the list of existing top product names. You can restrict
the names to the provided arguments.

=cut

sub get_products
{ my ($slf, @flt) = @_;
  my ($flt, $nam, %nam);

  # Initialize it on the first call
  $slf->init_inventory unless exists($slf->{'_src'});

  # Create the filter
  $flt = {map {$_ => 1} @flt} if @flt;

  # Get the extended name of the product
  if ($slf->{'_src'} eq 'INV')
  { foreach my $xml ($slf->{'_inv'}->find(
      "PRD_LIST/TL_LIST/COMP NAME='\\S+'"))
    { $nam = $xml->{'NAME'};
      $nam{$nam} = 0 if !$flt || exists($flt->{$nam});
    }
    foreach my $xml ($slf->{'_inv'}->find(
      "PRD_LIST/TL_LIST/PATCHSET NAME='\\S+'"))
    { $nam = $xml->{'NAME'};
      $nam =~ s/\.patchset$//;
      $nam{$nam} = 1 if !$flt || exists($flt->{$nam});
    }
  }
  elsif ($slf->{'_src'} eq 'OCM')
  { foreach my $obj (@{$slf->{'_prd'}})
    { next unless length($nam = _get_text($obj, 'NAME', q{}));
      $nam{$nam} = 0 if !$flt || exists($flt->{$nam});
    }
  }
  return (sort keys(%nam));
}

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

This method returns the version of the product. It returns an undefined value
when there is no inventory information for the product.

=head2 S<$h-E<gt>get_version($nam[,$dft])>

This method returns the version of the specified top product or component. It
returns the default value when there is no corresponding information in the
inventory.

You can prefix the name by:

=over 6

=item C<A|>  For the default search

=item C<a|>  For ignoring patches and patch sets

=item C<C|>  To restrict the search to a component

=item C<c|>  To restrict the search to a component, ignoring patches

=item C<T|>  To restrict the search to a top product

=item C<t|>  To restrict the search to a top product, ignoring patch sets

=back

=cut

sub get_version
{ my ($slf, $nam, $dft) = @_;

  # Initialize it on the first call
  $slf->init_inventory unless exists($slf->{'_src'});

  # Identify a component version
  return _get_version($slf, $nam, $dft) if defined($nam);

  # Identify a product version
  if ($slf->{'_src'} eq 'INV')
  { my ($xml) = $slf->{'_inv'}->find('PRD_LIST/TL_LIST/COMP');
    return $xml->get_value('VER', $dft) if $xml;
  }
  return $dft;
}

sub _get_version
{ my ($slf, $nam, $dft) = @_;
  my ($fct, $res);

  # Validate the parameters
  return $dft unless $nam =~ m/^(\w\|)?(\w+(\.\w+)*)$/;
  $fct = $tb_fct{($1 && exists($tb_fct{$1})) ? $1 : 'A|'};
  $nam = $2;

  # Find the attribute
  if ($slf->{'_src'} eq 'INV')
  { $nam =~ s/\./\\\./g;
    return &{$fct}($slf->{'_inv'}, $nam, $dft);
  }
  if ($slf->{'_src'} eq 'OCM')
  { foreach my $obj (@{$slf->{'_prd'}})
    { return _get_text($obj, 'VERSION')
        if _get_text($obj, 'NAME', q{}) eq $nam;
    }
  }
  return $dft;
}

sub _get_bas_any_version
{ my ($xml, $nam, $dft) = @_;
  my ($ver);

  return defined($ver = _get_bas_cmp_version($xml, $nam))
    ? $ver
    : _get_bas_top_version($xml, $nam, $dft);
}

sub _get_max_any_version
{ my ($xml, $nam, $dft) = @_;
  my ($ver);

  return defined($ver = _get_max_cmp_version($xml, $nam))
    ? $ver
    : _get_max_top_version($xml, $nam, $dft);
}

sub _get_bas_cmp_version
{ my ($xml, $nam, $dft) = @_;
  my ($res);

  $res = _get_first($xml, "PRD_LIST/COMP_LIST/COMP NAME='^$nam\$'");
  return ($res && exists($res->{'VER'})) ? $res->{'VER'} : $dft;
}

sub _get_max_cmp_version
{ my ($xml, $nam, $dft) = @_;
  my ($ver);

  $ver = _get_bas_cmp_version($xml, $nam);
  foreach my $obj ($xml->find("PRD_LIST/COMP_LIST/PATCH NAME='^$nam\$'"))
  { $ver = _max_version($ver, $obj->{'VER'}) if exists($obj->{'VER'});
  }
  return defined($ver) ? $ver : $dft;
}

sub _get_bas_top_version
{ my ($xml, $nam, $dft) = @_;
  my ($res);

  $res = _get_first($xml, "PRD_LIST/TL_LIST/COMP NAME='^$nam\$'");
  return ($res && exists($res->{'VER'})) ? $res->{'VER'} : $dft;
}

sub _get_max_top_version
{ my ($xml, $nam, $dft) = @_;
  my ($ver);

  $ver = _get_bas_top_version($xml, $nam);
  foreach my $obj (
    $xml->find("PRD_LIST/TL_LIST/PATCHSET NAME='^$nam(\\.patchset)?\$'"))
  { $ver = _max_version($ver, $obj->{'VER'}) if exists($obj->{'VER'});
  }
  return defined($ver) ? $ver : $dft;
}

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

This method indicates the type of the inventory used for the auto discovery. It
returns an empty string when no inventory is available.

=cut

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

  # Initialize it on the first call
  $slf->init_inventory unless exists($slf->{'_src'});

  # Return the inventory source
  return $slf->{'_src'};
}

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

This method initializes the inventory search.

=cut

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

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

  # Examine the OCM configuration informantion
  unless ($slf->{'col'}->get_first('DEFAULT.B_NO_OCM'))
  { if (-r ($fil = _get_ocm_inv($slf->{'cfg'}, $slf->{'hom'})))
    { $slf->{'_inv'} = $obj =
        RDA::Object::Xml->new->parse_file($fil);
      $slf->{'_prd'} =
        [$obj->find(q{.../ROWSET TABLE='MGMT_LL_INV_COMPONENT'/ROW})];
      $slf->{'_src'} = 'OCM';
      return $slf;
    }
  }

  # Indicate the initialization completion
  $slf->{'_src'} = q{};

  # Return the object reference
  return $slf;
}

sub _get_ocm_inv
{ my ($cfg, $dir) = @_;
  my ($nam, $pth);

  foreach my $sub ($cfg->cat_dir($dir, 'ccr'),
                   $cfg->cat_dir($dir, 'livelink'),
                   $cfg->cat_dir($dir, $cfg->up_dir, 'oracle_common', 'ccr'),
                   $cfg->cat_dir($dir, $cfg->up_dir, 'utils', 'ccr'))
  { next unless -d $sub;

    # Find the CONFIG_HOME
    if (-d $cfg->cat_dir($sub, 'hosts'))
    { if (defined($pth = $cfg->get_env('ORACLE_CONFIG_HOME')))
      { $sub = $cfg->cat_dir($pth, 'ccr')
      }
      elsif (-d ($pth = $cfg->cat_dir($sub, 'hosts', $cfg->get_host)) ||
             -d ($pth = $cfg->cat_dir($sub, 'hosts', $cfg->get_node)))
      { $sub = $pth
      }
      else
      { next;
      }
    }

    # Check the presence of the Oracle home target
    if (-d ($pth = $cfg->cat_dir($sub, 'state', 'review')))
    { if (opendir(DIR, $pth))
      { ($nam) = grep {/-oracle_home_config\.xml$/i} readdir(DIR);
        closedir(DIR);
        return $pth
          if $nam && -r ($pth = $cfg->cat_file($pth, $nam));
      }
      last;
    }
  }
  return q{};
}

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

# Get the first element from a query result
sub _get_first
{ my ($xml, $qry, $nod) = @_;

  ($nod) = $xml->find($qry);
  return $nod;
}

# Get the text of a specific XML element
sub _get_text
{ my ($xml, $tag, $dft) = @_;
  my $nod;

  return ($nod = _get_first($xml, $tag)) ? $nod->get_data : $dft;
}

# Determine the greatest version
sub _max_version
{ my ($old, $new) = @_;

  if (defined($old))
  { my ($n_n, @new);

    @new = split(/\./, $new);
    foreach my $n_o (split(/\./, $old))
    { return $old if !defined($n_n = shift(@new)) || $n_o > $n_n;
      return $new if $n_n > $n_o;
    }
  }
  return $new;
}

1;

__END__

=head1 SEE ALSO

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