# Explorer.pm: Class Used for Interfacing with Oracle Explorer

package RDA::Object::Explorer;

# $Id: Explorer.pm,v 1.15 2015/05/09 14:35:28 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/Object/Explorer.pm,v 1.15 2015/05/09 14:35:28 RDA Exp $
#
# Change History
# 20150509  MSC  Improve the documentation.

=head1 NAME

RDA::Object::Explorer - Class Used for Interfacing with Oracle Explorer

=head1 SYNOPSIS

 require RDA::Object::Explorer;

=head1 DESCRIPTION

The objects of the C<RDA::Object::Explorer> class are used to interface with
Oracle Explorer. It is a subclass of L<RDA::Object|RDA::Object>.

The following methods are available:

=cut

use strict;

BEGIN
{ use Exporter;
  use IO::File;
  use RDA::Text qw(get_string);
  use RDA::Object;
  use RDA::Object::Rda qw($APPEND $FIL_PERMS);
}

# Define the global public variables
use vars qw($STRINGS $VERSION @ISA %SDCL);
$VERSION = sprintf('%d.%02d', q$Revision: 1.15 $ =~ /(\d+)\.(\d+)/);
@ISA     = qw(RDA::Object Exporter);
%SDCL    = (
  beg => \&_begin_explorer,
  inc => [qw(RDA::Object)],
  met => {
    'exec_curl'     => {ret => 0},
    'get_sets'      => {ret => 1, blk => 1},
    'has_curl'      => {ret => 0},
    'has_dmidecode' => {ret => 0},
    'has_ipmitool'  => {ret => 0},
    'log'           => {ret => 0, evl => 'L'},
    'set_curl'      => {ret => 0},
    'set_dmidecode' => {ret => 0},
    'set_ipmitool'  => {ret => 0},
    },
  top => 'XPL',
  );

# Define the global private constants

# Define the global private variables

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

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

The object constructor. It takes the collector object reference as an argument.

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

=over 12

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

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

=item S<    B<'_crl'> > CURL command

=item S<    B<'_dmd'> > DMIDECODE command

=item S<    B<'_ipm'> > IPMITOOL command

=item S<    B<'_log'> > Log file path

=item S<    B<'_ofh'> > Log file handle

=item S<    B<'_pwd'> > Reference to the access control object

=item S<    B<'_run'> > Reference to the Explorer run-time data

=back

Internal keys are prefixed by an underscore.

=cut

sub new
{ my ($cls, $col) = @_;
  my ($log, $run, $slf);

  # Create the object
  $run = $col->get_agent->get_run->find('EXPLORER', 1);
  $slf = bless {
    oid  => 'Explorer',
    _col => $col,
    _pwd => $col->get_access,
    _run => $run,
    }, ref($cls) || $cls;

  # Determine if a log file is provided
  ($slf->{'_log'}, $slf->{'_ofh'}) = ($log, IO::File->new)
    if defined($log = $run->get_first('F_XPLR_LOG'));

  # Return the object reference
  return $slf;
}

=head2 S<$h-E<gt>exec_curl($host,$user,$arg...)>

This method executes a F<curl> request. It returns zero on successful
completion.

=cut

sub exec_curl
{ my ($slf, $hst, $usr, @arg) = @_;
  my ($buf, $pgm, $pwd);

  # Validate the arguments
  return -1 unless has_curl($slf);
  return -2 unless defined($hst) && defined($usr);

  # Perform the curl request
  $pwd = $slf->{'_pwd'}->get_password('host', $hst, $usr,
    "Enter the password for $usr on $hst: ", q{});
  $buf = "user='$usr:$pwd'\n";

  return -1 unless open(EXP,  ## no critic (Handle,Open)
    join(q{ }, q{|}, $slf->{'_crl'}, '-q', '--config', q{-}, @arg,
               '>/dev/null', '2>&1'));
  syswrite(EXP, $buf, length($buf));
  close(EXP);
  return $?;
}

=head2 S<$h-E<gt>get_sets([$prefix])>

This method returns the list of set directories present in the results.

=cut

sub get_sets
{ my ($slf, $blk, $pre) = @_;
  my ($pat, %set);

  # Define the extraction pattern
  if (defined($pre))
  { $pre =~ s/\//\\\//g;
    $pat = qr/^$pre\/([^\/]+)\//;
  }
  else
  { $pat = qr/^([^\/]+)\//;
  }

  # Extract the sets
  foreach my $abr (values(%{$blk->get_output->get_info('exp', {})}))
  { foreach my $dir (values(%{$abr}))
    { foreach my $rpt (values(%{$dir}))
      { foreach my $rec (@{$rpt})
        { my (undef, undef, undef, $nam) = split(/\|/, $rec);
          $set{$1} = 1 if $nam =~ $pat;
        }
      }
    }
  }

  # Return the sets
  return (sort keys(%set));
}

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

This method indicates whether F<curl> is available.

=cut

sub has_curl
{ my ($slf) = @_;
  my ($pgm);

  return $slf->{'_crl'} if exists($slf->{'_crl'});
  return $slf->{'_crl'} =
    ((-f ($pgm = '/bin/curl')         && -x $pgm) ||
     (-f ($pgm = '/usr/bin/curl')     && -x $pgm) ||
     (-f ($pgm = '/usr/sfw/bin/curl') && -x $pgm) ||
     (-f ($pgm = '/opt/sfw/bin/curl') && -x $pgm));
}

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

This method indicates whether F<dmidecode> is available.

=cut

sub has_dmidecode
{ my ($slf) = @_;
  my ($pgm);

  return $slf->{'_dmd'} if exists($slf->{'_dmd'});
  return $slf->{'_dmd'} =
    ((-f ($pgm = '/usr/local/sbin/dmidecode') && -x $pgm) ||
     (-f ($pgm = '/usr/local/bin/dmidecode')  && -x $pgm) ||
     (-f ($pgm = '/usr/sbin/dmidecode')       && -x $pgm) ||
     (-f ($pgm = '/usr/bin/dmidecode')        && -x $pgm) ||
     (-f ($pgm = '/sbin/dmidecode')           && -x $pgm) ||
     (-f ($pgm = '/bin/dmidecode')            && -x $pgm))
    ? $pgm
    : undef;
}

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

This method indicates whether F<ipmitool> is available.

=cut

sub has_ipmitool
{ my ($slf) = @_;
  my ($pgm);

  return $slf->{'_ipm'} if exists($slf->{'_ipm'});
  return $slf->{'_ipm'} =
    ((-f ($pgm = '/opt/ipmitool/sbin/ipmitool') && -x $pgm) ||
     (-f ($pgm = '/opt/ipmitool/bin/ipmitool')  && -x $pgm) ||
     (-f ($pgm = '/usr/sbin/ipmitool')          && -x $pgm) ||
     (-f ($pgm = '/usr/sfw/bin/ipmitool')       && -x $pgm) ||
     (-f ($pgm = '/usr/bin/ipmitool')           && -x $pgm))
    ? $pgm
    : undef;
}

=head2 S<$h-E<gt>log($txt)>

This method adds the specified text at the end of the log file.

=cut

sub log  ## no critic (Builtin)
{ my ($slf, $txt) = @_;

  if (exists($slf->{'_log'})
    && $slf->{'_ofh'}->open($slf->{'_log'}, $APPEND, $FIL_PERMS))
  { $slf->{'_ofh'}->syswrite($txt, length($txt));
    $slf->{'_ofh'}->close;
  }
  return;
}

=head2 S<$h-E<gt>set_curl($path)>

This method specifies to use a specific copy of F<curl>. It requires an
absolute path to an existing file.

=cut

sub set_curl
{ my ($slf, $pth) = @_;

  $slf->{'_crl'} = $pth
    if RDA::Object::Rda->is_absolute($pth) && -f $pth && -x $pth;
  return;
}

=head2 S<$h-E<gt>set_dmidecode($path)>

This method specifies to use a specific copy of F<dmidecode>. It requires an
absolute path to an existing file.

=cut

sub set_dmidecode
{ my ($slf, $pth) = @_;

  $slf->{'_dmd'} = $pth
    if RDA::Object::Rda->is_absolute($pth) && -f $pth && -x $pth;
  return;
}

=head2 S<$h-E<gt>set_ipmitool($path)>

This method specifies to use a specific copy of F<ipmitool>. It requires an
absolute path to an existing file.

=cut

sub set_ipmitool
{ my ($slf, $pth) = @_;

  $slf->{'_ipm'} = $pth
    if RDA::Object::Rda->is_absolute($pth) && -f $pth && -x $pth;
  return;
}

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

# Define a global variable to access the interface object
sub _begin_explorer
{ my ($pkg) = @_;
  my ($col);

  $col = $pkg->get_collector;
  $pkg->set_top('XPL', $col->get_registry('XPL', \&new, __PACKAGE__, $col));
  return;
}

1;

__END__

=head1 SEE ALSO

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