# Input.pm: Discovery Plug-in for Accessing Inputs

package IRDA::CV0200::Input;

# $Id: Input.pm,v 1.7 2013/11/22 11:37:06 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/IRDA/CV0200/Input.pm,v 1.7 2013/11/22 11:37:06 RDA Exp $
#
# Change History
# 20131021  MSC  Make code more strict.

=head1 NAME

IRDA::CV0200::Input - Discovery Plug-in for Accessing Inputs

=head1 SYNOPSIS

 require IRDA::CV0200::Input;

=head1 DESCRIPTION

This package regroups the definition of the discovery mechanisms for getting
values from the environment.

The following methods are available:

=cut

use strict;

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

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

# Define the global private variables
my %tb_run = (
  'get_env'            => \&_get_env,
  'get_merge_period'   => \&_get_merge_period,
  'get_prepare_value'  => \&_get_prepare_value,
  'get_problem_type'   => \&_get_problem_type,
  'get_product_type'   => \&_get_product_type,
  'get_request_dir'    => \&_get_request_dir,
  'get_request_value'  => \&_get_request_value,
  'set_domain_request' => \&_set_domain_request,
  );

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

=head2 S<$h = IRDA::CV0200::Input-E<gt>load($tbl)>

This method loads the mechanism definition in the mechanism table.

=cut

sub load
{ my ($cls, $tbl) = @_;

  foreach my $nam (keys(%tb_run))
  { $tbl->{$nam} = $tb_run{$nam};
  }
  return;
}

=head1 MECHANISM DEFINITIONS

=head2 get_env - Get environment variable value

This discovery mechanism retrieves the value of the specified environment
variable.

=cut

sub _get_env
{ my ($slf, $nam, $arg) = @_;

  $slf->set_change($nam, $slf->get_system->get_value($arg));
  return;
}


=head2 get_merge_period - Get the merge period

This discovery mechanism determines the merge period from the incident creation
time.

It defines the C<LOG_MERGE_BEGIN>, C<LOG_MERGE_END>, C<LOG_MERGE_SET>, and
C<LOG_RUN_MERGE> settings accordingly.

=cut

sub _get_merge_period
{ my ($slf, $nam) = @_;
  my ($beg, $dat, $end, @tbl);

  return q{} unless ($dat = $slf->get_request_value('INCIDENT_CREATION_TIME'))
    && $dat =~ m/^(\d{4})-(\d{2})-(\d{2})\s(\d{2}):(\d{2}):(\d{2})/;
  @tbl = ($6, $5, $4, $3, $2 - 1, $1 - 1900, 0, 0, -1);

  # Derive the time stamps
  eval {
    require POSIX;
    ## no critic qw(Call,Number)
    POSIX::tzset();
    $beg = $end = POSIX::mktime(@tbl);
    $beg -= 3600 * $slf->get_prepare_value('hours_before_incident', 1);
    $end += 3600 * $slf->get_prepare_value('hours_after_incident', 0.5);
    $beg = POSIX::strftime('%d-%b-%Y_%H:%M:%S', localtime($beg));
    $end = POSIX::strftime('%d-%b-%Y_%H:%M:%S', localtime($end));
  };
  die get_string('ERR_TIMESTAMP', $@) if $@;
  $slf->set_change('SETUP.DB.LOG.B_RUN_MERGE',   1);
  $slf->set_change('SETUP.DB.LOG.T_MERGE_BEGIN', $beg);
  $slf->set_change('SETUP.DB.LOG.T_MERGE_END',   $end);
  $slf->set_change('SETUP.DB.LOG.W_MERGE_SET',   'adr');
  return;
}

=head2 get_prepare_value - Get a prepare parameter value

This discovery mechanism retrieves the value of the specified prepare
parameter.

=cut

sub _get_prepare_value
{ my ($slf, $nam, $arg) = @_;

  $slf->set_change($nam, $slf->get_prepare_value($arg, q{}));
  return;
}

=head2 get_problem_type - Get the problem_type rule

This discovery mechanism retrieves the rule corresponding to the problem type.

It sets the C<PROBLEM_CLASS> value. For non-manual C<ofm> collections, it
derives the product from the first word of the problem key using the
C<OFM_PRODUCT> map and performs extra discovery based on its corresponding
value of the C<OFM_REQUIREMENT> hash.

When it does not find required information, all C<ofm> collections are falling
back to the C<ofm.wls> problem type.

=cut

sub _get_problem_type
{ my ($slf, $nam) = @_;
  my ($cls, $key, $tbl, $typ);

  $typ = $slf->get_prepare_value('PRODUCT_TYPE', q{});
  $key = $slf->get_request_value('PROBLEM_KEY', q{});
  if ($key =~ /^\s*(\w+)\s+(\w+)/)
  { $cls = ($slf->get_request_value('INCIDENT_TYPE', q{}) eq 'manual')
             ? 'manual_'.$1 :
           ($typ eq 'ofm')
             ? _discover_product($slf, $1) :
           lc($1.'_'.$2);
    $slf->set_value('PROBLEM_CLASS', $cls);
  }
  else
  { $cls = q{};
  }
  $slf->{'_prp'}->{$nam} = $slf->map_value($nam, join(q{.}, $typ, $cls));
  return;
}


=head2 get_product_type - Get the product_type rule

This discovery mechanism retrieves the rule corresponding to the product type.

For C<ofm> collections, it sets the C<ADR_DOMAIN_ROOT>, C<ADR_DOMAIN_NAME>,
C<ADR_DOMAIN_HOME>, and C<ADR_SERVER_NAME> values.

=cut

sub _get_product_type
{ my ($slf, $nam) = @_;
  my ($dir, $dom, $srv, $tbl, $typ, @dir);

  if ($dir = $slf->get_request_value('ADR_HOME'))
  { $tbl = $slf->{'val'};
    $dir = RDA::Object::Rda->clean_path([$dir, q{}], 1);
    @dir = RDA::Object::Rda->split_dir($dir);
    return q{} if scalar(@dir) < 4;
    ($typ) = splice(@dir, -3);
    if ($typ eq 'ofm')
    { return q{} if scalar(@dir) < 6;
      ($dom, undef, $srv) = splice(@dir, -5);
      $slf->set_value('ADR_DOMAIN_ROOT', RDA::Object::Rda->cat_dir(@dir));
      $slf->set_value('ADR_DOMAIN_NAME', $dom);
      $slf->set_value('ADR_DOMAIN_HOME', RDA::Object::Rda->cat_dir(@dir, $dom));
      $slf->set_value('ADR_SERVER_NAME', $srv);
    }
    $slf->set_value($nam, $slf->map_value($nam, $typ));
  }
  return;
}

=head2 get_request_dir - Get a directory from the request file

This discovery mechanism retrieves the path of the specified request
directory parameter.

=cut

sub _get_request_dir
{ my ($slf, $nam, $arg) = @_;
  my ($val);

  $slf->set_change($nam,
    defined($val = $slf->get_request_value($arg))
    ? RDA::Object::Rda->cat_dir($val)
    : q{});
  return;
}

=head2 get_request_value - Get a request parameter value

This discovery mechanism retrieves the value of the specified request
parameter.

=cut

sub _get_request_value
{ my ($slf, $nam, $arg) = @_;

  $slf->set_change($nam, $slf->get_request_value($arg, q{}));
  return;
}

=head2 set_domain_request - Define an Oracle WebLogic Server domain request

This discovery mechanism defines an Oracle WebLogic Server domain request.

=cut

sub _set_domain_request
{ my ($slf, $nam, $arg) = @_;
  my ($val);

  $slf->set_change('PRF/D_DOMAIN_ROOT',
    $slf->get_prepare_value('ADR_DOMAIN_ROOT'));
  $slf->set_change('PRF/T_DOMAIN',
    $slf->get_prepare_value('ADR_DOMAIN_NAME'));
  $slf->set_change('PRF/T_SERVER',
    $slf->get_prepare_value('ADR_SERVER_NAME'));
  $slf->set_change("$nam.D_ORACLE_HOME", $val)
    if defined($arg) && defined($val = $slf->get_prepare_value($arg));
  return;
}

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

# Discover the product homes
sub _discover_homes
{ my ($slf, $ctl, $req) = @_;
  my ($dir, $dom, $key, %hom);

  # Get the domain target
  $dom = $ctl->add_target('DOM_ADR',
    { D_DOMAIN_HOME     => $slf->get_prepare_value('ADR_DOMAIN_HOME'),
      B_MISSING_COMMON  => 1,
      B_MISSING_HOME    => 1,
      B_MISSING_WL_HOME => 1,
    });

  # Get the required product homes
  foreach my $itm (split(/,/, $req))
  { if ($itm =~ m/^(\w+):(\w+)$/)
    { $key = $1;
      return 1
        unless defined($dir = $dom->get_product($2, 'hom')) && -d $dir;
      $hom{$1} = $dir;
    }
  }

  # Set the required settings
  foreach my $key (keys(%hom))
  { $slf->set_value($key, $hom{$key});
  }

  # Indicate a successful completion
  return 0;
}

# Discover product settings
sub _discover_product
{ my ($slf, $prb) = @_;
  my ($ctl, $prd, $req, @dir);

  # Determine the product name
  $prd = $slf->map_value('OFM_PRODUCT', $prb);

  # Analyze product requirements
  return 'wls' unless defined($prd)
    && defined($req = $slf->get_hash_value('OFM_REQUIREMENT', $prd));
  $ctl = $slf->{'col'}->get_target;
  $prd = 'wls' if _discover_homes($slf, $ctl, $req);
  $ctl->init;

  # Return the collection
  return $prd;
}

1;

__END__

=head1 SEE ALSO

L<RDA::Agent|RDA::Agent>,
L<RDA::Object::Domain|RDA::Object::Domain>,
L<RDA::Object::Rda|RDA::Object::Rda>,
L<RDA::Object::Target|RDA::Object::Target>,
L<IRDA::Prepare|IRDA::Prepare>

=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