# EXPLORER.pm: Oracle Explorer Command Library

package RDA::Request::EXPLORER;

# $Id: EXPLORER.pm,v 1.30 2015/12/17 23:52:23 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/Request/EXPLORER.pm,v 1.30 2015/12/17 23:52:23 RDA Exp $
#
# Change History
# 20151217  MSC  Improve the GMT time reporting.

=head1 NAME

RDA::Request::EXPLORER - Oracle Explorer Command Library

=head1 SYNOPSIS

 require RDA::Request::EXPLORER;

=head1 DESCRIPTION

The objects of the C<RDA::Request::EXPLORER> class are used to perform Oracle
Explorer-related tasks.

The following methods are available:

=cut

use strict;

BEGIN
{ use Exporter;
  use IO::File;
  use RDA::Text qw(get_string);
  use RDA::Handle::Block;
  use RDA::Object;
  use RDA::Object::Message;
  use RDA::Object::Mrc;
  use RDA::Object::Output;
  use RDA::Object::Rda qw($APPEND $CREATE $DIR_PERMS $FIL_PERMS);
  use RDA::SDCL::Block;
}

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

# Define the global private constants
my $OUTPUT = 'XPLR';
my $PREFIX = 'EXPLORER/';
my $TARGET = 'explorer';

# Define the global private variables
my @tb_bit = qw(
  --- --x -w- -wx r-- r-x rw- rwx
  --S --s -wS -ws r-S r-s rwS rws);
my %tb_clr = (
  globalzone => {'B_GLOBAL' => 0},
  localzones => {},
  zones      => {'B_LOCAL'  => 0},
  );
my %tb_cmd = (
  'EXPLORER.CAN'     => \&_do_can,
  'EXPLORER.CONVERT' => \&_do_convert,
  'EXPLORER.LIST'    => \&_do_list,
  'EXPLORER.REPORT'  => \&_do_report,
  'EXPLORER.RUN'     => \&_do_run,
  );
my %tb_mrc = (
  cygwin  => 'EXPLORER.xplr_cyg',
  linux   => 'EXPLORER.xplr_lin',
  solaris => 'EXPLORER.xplr_sol',
  sunos   => 'EXPLORER.xplr_sol',
  );
my %tb_run = (
  ARC   => 'W_ARC',
  BLD   => 'W_BLD',
  OSN   => 'W_OSN',
  OSV   => 'N_OSV',
  OUT   => 'D_OUT',
  SUB   => 'W_SUB',
  TGT   => 'T_TGT',
  TMP   => 'D_TMP',
  TOP   => 'D_TOP',
  ZONES => 'T_ZONES',
  );
my %tb_set = (
  globalzone => {'B_GLOBAL' => 1},
  localzones => {'B_LOCAL'  => 1},
  zones      => {},
  );
my %tb_wrn = (
  DB  => 'DB_PENDING',  # Text:DB_PENDING
  DBI => 'DBI_PENDING', # Text:DBI_PENDING
  OS  => 'OS_PENDING',  # Text:OS_PENDING
  REM => 'REM_PENDING', # Text:REM_PENDING
  XML => 'XML_PENDING', # Text:XML_PENDING
  );

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

=head2 S<$h = RDA::Request::EXPLORER-E<gt>new($agt)>

The object constructor. This method enables you to specify the agent reference
as an argument.

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

=over 10

=item S<  B<'_agt'> > Reference to the agent object

=item S<  B<'_dsp'> > Reference to the display control object when verbose

=item S<  B<'_lvl'> > Trace level

=back

Internal keys are prefixed by an underscore.

=cut

sub new
{ my ($cls, $agt) = @_;
  my ($cfg);

  # Create the library object and return the object reference
  $cfg = $agt->get_config;
  return bless {
    _agt => $agt,
    _dsp => $agt->is_verbose,
    _lvl => $agt->get_level,
    }, ref($cls) || $cls;
}

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

This method deletes the library object.

=cut

sub delete_object
{ RDA::Object::dump_caller($_[0], 'Commands') if $RDA::Object::DELETE;
  undef %{$_[0]};
  undef $_[0];
  return;
}

=head2 S<$h-E<gt>exec_command($req)>

This method executes the command specified in the message.

=cut

sub exec_command
{ my ($slf, $req) = @_;

  my $cmd = $req->{'msg'};
  return exists($tb_cmd{$cmd})
    ? &{$tb_cmd{$cmd}}($slf, $req)
    : $req->error('NotImplemented', get_string('BAD_COMMAND', $cmd));
}

=head2 EXPLORER.CAN - Can command

This command indicates whether RDA covers all Oracle Explorer tools that are
specified in the request. Without a tool list, it lists the Oracle Explorer
collections that can be performed by RDA.

It supports the following attributes:

=over 9

=item B<  beta>

When true, considers beta tools.

=item B<  set>

Specifies a collection set (derived by default from the operating system).

=item B<  tools>

When specified, lists the Oracle Explorer tools to check.

=back

=cut

sub _do_can
{ my ($slf, $req) = @_;
  my ($agt, $cfg, $col, $mrc, $set, @req);

  $agt = $slf->{'_agt'};
  $cfg = $agt->get_config;
  $col = $agt->get_collector;
  $mrc = $col->get_mrc->new($col);
  $set = _get_set($mrc, $req->get_first('set'));

  # Return the list of existing tool when no tools are provided
  unless (@req = $req->get_value('tools'))
  { my ($def, $exp, $map, $obj, %tbl);

    # Determine whether experimental tools must be included
    $exp = $req->get_first('beta') ? '(beta )?module' : '(module)';

    # List existing tools
    $def = $mrc->get_collections($set);
    foreach my $nam (sort keys(%{$def}))
    { $obj = $def->{$nam};
      next unless $obj->get_title("$set:$nam", q{}) =~
        m/^Oracle Explorer $exp ($nam)$/i;
      $nam = $2;  # Get the right capitalization
      foreach my $mod (keys(%{$map = $obj->get_mapping}))
      { $tbl{$mod} = $nam
          if -r $cfg->get_file('D_RDA_COL', $map->{$mod}, '.ctl');
      }
    }
    return $req->new('OK.Can', tools => [
      $mrc->get_collections($set.'_obs'),
      map {$tbl{$_}} grep {exists($tbl{$_})} $mrc->get_members($set, 'all')]);
  }

  # Validate the tool list
  foreach my $nam (@req)
  { my ($map, $obj, @mod);

    # Check for the group existence
    return $req->error('NoGroup', {name => $nam})
      unless ($obj = $mrc->get_collection("$set:$nam"));

    # Validate the group members
    foreach my $mod (keys(%{$map = $obj->get_mapping}))
    { push(@mod, $mod)
        unless -r $cfg->get_file('D_RDA_COL', $map->{$mod}, '.ctl');
    }
    return $req->error('BadMember', {name => [@mod]}) if @mod;
  }

  # Indicate the completion status
  return $req->new('OK.Can');
}

=head2 EXPLORER.CONVERT - Convert command

This command extracts Oracle Explorer results from RDA reports using the Oracle
Explorer catalog.

It supports the following attributes:

=over 13

=item B<  directory>

Specifies the Oracle Explorer result directory (F<explorer> by default).

=item B<  maximum>

Specifies the highest customer level to accept (C<3> by default).

=item B<  native>

When true, does not adjust file attributes (false by default).

=item B<  sets>

When specified, restricts the conversion to the specified Oracle Explorer
collection sets (all by default).

=back

=cut

sub _do_convert
{ my ($slf, $req) = @_;
  my ($agt, $dir);

  # Convert the Oracle Explorer sets
  eval {
    $agt = $slf->{'_agt'};
    defined($dir = $agt->get_config->is_path($req->get_first('directory')))
      ? _convert($agt, $req->get_first('native'), $dir,
                 RDA::Object::Rda->cat_dir($dir, 'rda'),
                 $req->get_first('maximum'), $req->get_value('sets'))
      : _convert($agt, $req->get_first('native'), $TARGET,
                 $OUTPUT,
                 $req->get_first('maximum'), $req->get_value('sets'))};

  # Indicate a successful completion
  return $req->reply($@, 'Convert');
}

sub _convert  ## no critic (Complex)
{ my ($agt, $non, $dst, $src, $max, @req) = @_;
  my ($cfg, $col, $dir, $dsp, $flt, $ifh, $nam, $sfh, $sta, $top, @sta);

  # Validate the result directory
  $cfg = $agt->get_config;
  $col = $agt->get_collector;
  die get_string('ERR_DIR', $dst) if -e $dst && ! -d $dst;

  # Treat all Oracle Explorer catalog files
  $flt = {map {$_ => 1} @req} if @req;
  $max = 3 unless defined($max) && $max =~ m/^\d$/;
  $dsp = $agt->is_verbose;
  $ifh = IO::File->new;
  $sfh = IO::File->new;
  $sta = {};
  if (opendir(DIR, $top = $col->get_data))
  { my ($cat, %all, %map, %sta, %tbl);

    foreach my $fil (readdir(DIR))
    { next unless $fil =~ m/^([A-Z][A-Z\d]*_[A-Z][A-Z\d]*_E.fil)$/i
        && $ifh->open('<'.($cat = RDA::Object::Rda->cat_file($top, $1)));

      # Load the related file information
      unless ($non)
      { $sta = {};
        $cat =~ s/_E.fil$/_D.fil/;
        if ($sfh->open("<$cat"))
        { $dsp->dsp_line(get_string('V_Load', $fil)) if $dsp;
          while (<$sfh>)
          { ($nam, @sta) = split(/\|/, $_);
            $nam = RDA::Object::decode($1) if $nam =~ m/^"([^"]*)"$/;
            pop(@sta);
            $sta->{$nam} = [@sta] if @sta;
          }
          $sfh->close;
        }
      }

      # Treat the Oracle Explorer catalog
      $dsp->dsp_line(get_string('V_Treat', $fil)) if $dsp;
      while (<$ifh>)
      { my ($alt, $blk, $pth, $typ, @alt);

        ($typ, undef, $blk, $nam, @alt) = split(/\|/, $_);
        next unless $nam =~ m/^([\/\+\-\=\#\@\.\,\:\w]+)$/;
        $nam = $1;
        next if $flt && $nam =~ m/^([^\/]+)/ && !exists($flt->{$1});
        pop(@alt);
        if ($typ eq 'T')
        { next unless $blk;
          $blk = [split(/\//, $blk, 6)];
          next if (defined($blk->[4]) ? $blk->[4] : 2) > $max;
          push(@{$tbl{$nam}}, $blk);
        }
        elsif ($typ eq 'G')
        { $dsp->dsp_line(get_string('VI_AddDir', $nam)) if $dsp;
          $pth = RDA::Object::Rda->cat_dir($dst, $nam);
          RDA::Object::Rda->create_dir($pth, $DIR_PERMS)
            unless -d $pth;
        }
        elsif ($typ eq 'L')
        { next unless defined($alt = shift(@alt));
          next unless $alt =~ m/^([\/\+\-\=\#\@\.\,\:\w]+)$/;
          $alt = $1;
          $dsp->dsp_line(get_string('VI_Link', $alt, $nam)) if $dsp;
          $pth = RDA::Object::Rda->cat_dir($dst, $nam);
          RDA::Object::Rda->create_dir($blk, $DIR_PERMS)
            unless -d ($blk = RDA::Object::Rda->dirname($pth));
          eval {symlink($alt, $pth)};
        }
        else
        { $dsp->dsp_line(get_string('VI_Extract', $nam, $typ)) if $dsp;
          $blk = [split(/\//, $blk, 6)];
          next if (defined($blk->[4]) ? $blk->[4] : 2) > $max;
          if (defined($pth = shift(@alt)))
          { $pth = RDA::Object::decode($1) if $pth =~ m/^"([^"]*)"$/;
            $dir = _extract_file($col, $dst, $nam, _get_stat($sta, $pth), $blk);
            $map{$dir}->{RDA::Object::Rda->dirname($pth)} = 1
              if _is_link($sta, $pth);
          }
          else
          { _extract_file($col, $dst, $nam, undef, $blk);
          }
        }
      }
      $ifh->close;

      # Structure the file information
      foreach my $pth (keys(%{$sta}))
      { $sta{RDA::Object::Rda->dirname($pth)}->{$pth} = $all{$pth} =
          $sta->{$pth};
      }
    }
    closedir(DIR);

    # Produce the symbolic links reports
    foreach my $dir (keys(%map))
    { my ($pth, $tbl, %dup, %rpt);

      $dsp->dsp_line(get_string('VI_Symlink', $dir)) if $dsp;
      $pth = RDA::Object::Rda->cat_file($dir, 'symlink_list');
      $sfh->open($pth, $CREATE, $FIL_PERMS)
        or die get_string('ERR_CREATE', $pth, $!);

      # Treat mapped directories
      foreach my $top (keys(%{$map{$dir}}))
      { next unless ref($tbl = $sta{$top});
        foreach my $pth (keys(%{$tbl}))
        { next unless _is_link($tbl, $pth);
          $sta = $tbl->{$pth};
          %dup = ($pth => $sta);
          while (defined($pth = $sta->[14]))
          { $pth = RDA::Object::decode($1) if $pth =~ m/^"([^"]*)"$/;
            if (exists($dup{$pth}) || !exists($all{$pth}))
            { foreach my $rec (values(%dup))
              { $rec->[2] &= 07777;  ## no critic (Bit,Number,Zero)
              }
              last;
            }
            $dup{$pth} = $sta = $all{$pth};
          }
          foreach my $pth (keys(%dup))
          { $rpt{RDA::Object::Rda->dirname($pth)}->{
                 RDA::Object::Rda->basename($pth)} = $dup{$pth};
          }
        }
      }

      # Report mapped directories
      foreach my $top (sort keys(%{$map{$dir}}))
      { _report_files($sfh, $top, delete($rpt{$top})) if exists($rpt{$top});
      }

      # Add redirections
      foreach my $sub (sort keys(%rpt))
      { _report_files($sfh, $sub, $rpt{$sub});
      }

      # Close the report
      $sfh->close;
    }

    # Treat fragments
    foreach my $key (keys(%tbl))
    { $dsp->dsp_line(get_string('VI_Assemble', $key)) if $dsp;
      _extract_file($col, $dst, $key, undef, @{$tbl{$key}});
    }
  }
  return;
}

sub _extract_file
{ my ($col, $dst, $nam, $sta, @blk) = @_;
  my ($buf, $dir, $ifh, $lgt, $ofh, $pth, $src, @sta);

  # Create the directory
  $pth = RDA::Object::Rda->cat_file($dst, $nam);
  RDA::Object::Rda->create_dir($dir, $DIR_PERMS)
    unless -d ($dir = RDA::Object::Rda->dirname($pth));

  # Create the target file
  @sta = ();
  $ofh = IO::File->new;
  $ofh->open($pth, $CREATE, $FIL_PERMS)
    or die get_string('ERR_CREATE', $pth, $!);
  binmode($ofh);
  foreach my $blk (@blk)
  { $src = RDA::Object::Rda->cat_file($col->get_dir($blk->[2]), $blk->[3]);
    $ifh = RDA::Handle::Block->new($src, $blk->[0], $blk->[1])
      or die get_string('ERR_OPEN', $src, $!);
    binmode($ifh);
    $ofh->syswrite($buf, $lgt) while ($lgt = $ifh->sysread($buf, 8192));
    @sta = stat($src) unless $sta;
    $ifh->close;
  }
  $ofh->close;

  # Adjust the file information
  if ($sta)
  { utime(_val_stat($sta->[8]), _val_stat($sta->[9]), $pth);
    chmod(_val_stat($sta->[2]) & 07777, $pth);  ## no critic (Bit,Number,Zero)
    chown(_val_stat($sta->[4]), _val_stat($sta->[5]), $pth);
  }
  elsif (@sta)
  { utime(_val_stat($sta[8]), _val_stat($sta[9]), $pth);
  }
  return $dir;
}

sub _fmt_bits
{ my ($val, $flg) = @_;

  $val += 8 if $flg;
  return $tb_bit[$val];
}

sub _fmt_date
{ my ($str) = @_;

  return q{} unless $str;
  $str = gmtime($str);
  return q{ }.substr($str, 4, 12).q{ }.substr($str, 20, 4);
}

sub _fmt_mode
{ my ($mod) = @_;

  ## no critic (Bit,Number,Zero)
  return substr("Lpc?d?b?-?l?s?w?", ($mod >> 12) & 017, 1)
    ._fmt_bits(($mod >> 6) & 07, $mod & 04000)
    ._fmt_bits(($mod >> 3) & 07, $mod & 02000)
    ._fmt_bits($mod & 07,        $mod & 01000);
}

sub _get_stat
{ my ($tbl, $pth) = @_;
  my ($sta);

  if (defined($pth) && exists($tbl->{$pth}))
  { $sta = $tbl->{$pth};
    while (defined($pth = $sta->[14]))
    { $pth = RDA::Object::decode($1) if $pth =~ m/^"([^"]*)"$/;
      $sta = $tbl->{$pth};
    }
  }
  return $sta;
}

sub _is_link
{ my ($tbl, $pth) = @_;

  return defined($pth)
    && exists($tbl->{$pth})
    && ($tbl->{$pth}->[2] & 0170000) == 0120000;  ## no critic (Bit,Number,Zero)
}

sub _report_files
{ my ($ofh, $dir, $tbl) = @_;
  my ($buf, $lnk, $nam, $rec, @max);

  eval {
    # Determine the column sizes
    @max = (1, -1, -1, 0);
    foreach my $rec (values(%{$tbl}))
    { $max[0] = $rec->[3] if $rec->[3] > $max[0];
      $max[1] = $rec->[4] if $rec->[4] > $max[1];
      $max[2] = $rec->[5] if $rec->[5] > $max[2];
      $max[3] = $rec->[7] if $rec->[7] > $max[3];
    }
    $max[0] = length(sprintf(' %d', $max[0]));
    $max[1] = length(sprintf(' %d', $max[1]));
    $max[2] = length(sprintf(' %d', $max[2]));
    $max[3] = length(sprintf(' %d', $max[3]));

    # Display the file information
    $buf = "$dir:\n";
    foreach my $fil (sort keys(%{$tbl}))
    { $rec = $tbl->{$nam = $fil};
      if (defined($lnk = $rec->[13]))
      { $lnk = RDA::Object::decode($1) if $lnk =~ m/^"([^"]*)"$/;
        $nam .= q{ -> }.$lnk;
      }
      $nam =~ s/[\000-\037]/?/g;
      $buf .= sprintf("%s%*d%*d%*d%*d%18s %s\n", _fmt_mode($rec->[2]),
        $max[0], $rec->[3],
        $max[1], $rec->[4],
        $max[2], $rec->[5],
        $max[3], $rec->[7],
        _fmt_date($rec->[9]),
        $nam);
    }
    $buf .= qq{\n};
    syswrite($ofh, $buf, length($buf));
    };
  return;
}

sub _val_stat
{ my ($str) = @_;

  return ($str =~ m/^(\d+)$/) ? $1 : undef;
}

=head2 EXPLORER.LIST - List command

This command lists the Oracle Explorer tool names, aliases, or groups. It
supports the following attributes:

=over 15

=item B<  beta>

When true, includes the beta tools,

=item B<  description>

When true, includes the description as data.

=item B<  set>

Specifies a collection set (derived by default from the operating system).

=item B<  type>

Specified the list type: C<aliases>, C<groups>, C<mappings>, or C<names>

=back

=cut

sub _do_list  ## no critic (Complex)
{ my ($slf, $req) = @_;
  my ($agt, $buf, $cfg, $cnt, $col, $def, $exp, $map, $mrc, $set, $ttl, $typ,
      @tbl, %grp, %mod, %syn, %tbl);

  # Extract the list
  eval {
    $agt = $slf->{'_agt'};
    $cfg = $agt->get_config;
    $cnt = $agt->get_content;
    $col = $agt->get_collector;
    $mrc = $col->get_mrc->new($col);
    $set = _get_set($mrc, $req->get_first('set'));

    # Determine whether experimental tools must be included
    $exp = $req->get_first('beta') ? '(beta )?module' : '(module)';

    # List existing tools
    $def = $mrc->get_collections($set);
    foreach my $nam (sort keys(%{$def}))
    { $ttl = $def->{$nam}->get_title("$set:$nam", q{});
      if ($ttl =~ m/^Oracle Explorer $exp ($nam)$/i)
      { $map = $def->{$nam}->get_mapping;
        $nam = $2;  # Get the right capitalization
        foreach my $mod (keys(%{$map}))
        { $tbl{$mod} = $nam
            if -r $cfg->get_file('D_RDA_COL', $map->{$mod}, '.ctl');
        }
      }
      elsif ($ttl =~ m/(\S+\s+alias)$/i)
      { $syn{$nam} = $1;
      }
      elsif ($ttl !~ m/ beta$/i)
      { $grp{$nam} = [keys(%{$map = $def->{$nam}->get_mapping})];
      }
    }

    # Produce the report
    $buf = q{};
    $typ = $req->get_first('type');
    if ($typ eq 'names')
    { %mod = map {$tbl{$_} => $cnt->get_desc('MC', $_)} keys(%tbl);
      $buf = join(q{}, map {$_.q{|}.$mod{$_}.qq{\n}} @tbl)
        if (@tbl = sort keys(%mod)) && $req->get_first('description');
    }
    elsif ($typ eq 'aliases')
    { $buf = join(q{}, map {$_.q{|}.$syn{$_}.qq{\n}} @tbl)
        if (@tbl = sort keys(%syn)) && $req->get_first('description');
    }
    elsif ($typ eq 'groups')
    { $buf = join(q{},
        map {$_.q{|}.join(', ', sort map {$tbl{$_}} @{$grp{$_}}).qq{\n}} @tbl)
        if (@tbl = sort keys(%grp)) && $req->get_first('description');
    }
    elsif ($typ eq 'mappings')
    { $buf = join(q{},
        map {$tbl{$_}.q{|}.$_.qq{\n}} sort {$tbl{$a} cmp $tbl{$b}} keys(%tbl))
      if (@tbl = reverse %tbl) && $req->get_first('description');
    }
    };
  $req->add_error($@) if $@;

  # Return the completion status
  return $req->has_errors
    ? $req->error('List')
    : $req->new('OK.List', list => [@tbl])->add_data($buf);
}

=head2 EXPLORER.REPORT - Report command

This command reports the Oracle Explorer collections that can be extracted from
RDA reports.

=cut

sub _do_report
{ my ($slf, $req) = @_;
  my ($agt, $dir, $ifh, $nam, %mod);

  # Extract the report list
  $agt = $slf->{'_agt'};
  $ifh = IO::File->new;
  if (opendir(DIR, $dir = $agt->get_collector->get_data))
  { foreach my $fil (readdir(DIR))
    { next unless $fil =~ m/^[A-Z][A-Z\d]*_[A-Z][A-Z\d]*_E.fil$/i
        && $ifh->open('<'.RDA::Object::Rda->cat_file($dir, $fil));
      while (<$ifh>)
      { (undef, undef, undef, $nam) = split(/\|/, $_);
         $mod{$1} = 1 if $nam =~ m/^([^\/]+)/;
      }
      $ifh->close;
    }
    closedir(DIR);
  }

  # Return the completion status
  return $req->has_errors
    ? $req->error('Report')
    : $req->new('OK.Report', collections => [keys(%mod)]);
}

=head2 EXPLORER.RUN - Run command

This command performs data collection for Oracle Explorer.

It supports the following attributes:

=over 9

=item B<  beta>

When true, considers beta tools.

=item B<  tools>

When specified, list the tools to collect. It accepts comma-separated lists
also.

=item B<  save>

When true, saves the setup information.

=item B<  set>

Specifies a collection set (derived by default from the operating system).

=item B<  trace>

When true, activates the trace mode for the Oracle Explorer collections.

=back

=cut

sub _do_run  ## no critic (Complex)
{ my ($slf, $req) = @_;
  my ($agt, $buf, $cfg, $col, $def, $dsp, $env, $exp, $ifh, $inc, $lng, $lvl,
      $mrc, $obj, $out, $run, $sav, $set, $sta, $trc, $val, $yes,
      @mod, @rec, %det, %mod, %nam, %pkg);

  eval {
    # Initialization
    $agt = $slf->{'_agt'};
    $cfg = $agt->get_config;
    $col = $agt->get_collector(1);
    $env = $agt->get_env;
    $lvl = $col->get_level % 10;
    $sav = $req->get_first('save');
    $trc = $req->get_first('trace') || $lvl;
    $dsp = ($env->get_value('XPL_MOD', q{}) eq 'verbose'
      || $env->get_value('EXP_VERBOSE')) ? $agt->get_display : $agt->is_verbose;
    $yes = 1;

    # Determine whether experimental tools must be included
    $exp = $req->get_first('beta') ? '(beta )?module' : 'module';

    # Analyze the available collections
    $mrc = $col->get_mrc->new($col);
    $set = _get_set($mrc, $req->get_first('set'));
    foreach my $nam ($mrc->get_collections($set))
    { @mod = $mrc->get_members($set, $nam, 1);
      $det{$nam} = [@mod];
      $nam{$mod[0]} = $nam if (scalar @mod) == 1
        && $mrc->get_collection("$set:$nam")->get_title("$set:$nam", q{}) =~
             m/^Oracle Explorer $exp $nam$/i;
    }

    # Identify relevant collections
    $agt->trace(get_string('Select')) if $trc;
    $def = $col->find('SETUP.EXPLORER.XPLR', 1);
    $run = $agt->get_run->find('EXPLORER', 1);
    foreach my $arg ($req->get_value('tools', $env->get_value('XPL_COL') ||
                                              $env->get_value('EXP_WHICH') ||
                                              'default'))
    { foreach my $nam (split(/[,\s]+/, lc($arg)))
      { next if $nam =~ m/^$/;  ## no critic (Fixed)
        $agt->trace(get_string('T_Treat', $nam)) if $trc;
        if ($nam =~ m/^\\?\!ipaddr$/)
        { $col->set_temp('FILTER.B_ENABLED', 1);
        }
        elsif ($nam eq 'interactive')
        { $yes = 0;
        }
        elsif ($nam =~ /^\\?\!(\w*)$/)
        { if (exists($tb_clr{$1}))
          { $agt->trace(get_string('T_Clear', $1)) if $trc;
            foreach my $key (keys(%{$val = $tb_clr{$1}}))
            { $def->set_temp($key, $val->{$key});
            }
          }
          elsif (exists($det{$1}))
          { foreach my $mod (@{$det{$1}})
            { $agt->trace(get_string('T_Remove', $mod)) if $trc;
              $mod{$mod} = undef;
            }
          }
        }
        elsif ($nam =~ /^(\w*)$/)
        { if (exists($tb_set{$1}))
          { $agt->trace(get_string('T_Set', $1)) if $trc;
            foreach my $key (keys(%{$val = $tb_set{$1}}))
            { $def->set_temp($key, $val->{$key});
            }
          }
          elsif (exists($det{$nam}))
          { foreach my $mod (@{$det{$1}})
            { next unless exists($nam{$mod});
              if (!exists($mod{$mod}))
              { $agt->trace(get_string('T_Add', $mod)) if $trc;
                $mod{$mod} = $nam{$mod} eq $nam ? 1 : 0;
              }
              elsif ($nam{$mod} eq $nam)
              { $mod{$mod} = 1;
              }
            }
          }
        }
      }
    }

    $run->set_temp('B_INPUT', 1);
    @mod = sort map {$nam{$_}} grep {defined($mod{$_})} keys(%mod);
    $def->set_temp('W_MODULES', $val = [@mod]);
    $agt->trace(get_string('Selected', join(q{|}, @mod))) if $trc;
    @mod = sort map {$nam{$_}} grep {$mod{$_}} keys(%mod);
    $def->set_temp('W_EXPLICIT', $val = [@mod]);
    $agt->trace(get_string('Explicit', join(q{|}, @mod))) if $trc;
    @mod = sort map {$nam{$_}} grep {!defined($mod{$_})} keys(%mod);
    $def->set_temp('W_REJECTED', $val = [@mod]);
    $agt->trace(get_string('Rejected', join(q{|}, @mod))) if $trc;

    # Do minimum setup
    $dsp->dsp_line(get_string('V_Default')) if $dsp;
    $agt->set_info('bkp', 0);
    $col->set_isolated(1);
    $col->set_temp('DEFAULT.B_NO_OCM', 1);
    $col->set_temp('DEFAULT.N_TIMEOUT', $1)
      if defined($val = $env->get_value('XPL_LIM')) && $val =~ m/^(\d+)$/;
    $col->set_temp('SETUP.B_PRF', {'CUS:XPLR' => 1});
    $col->set_temp('SETUP.RDA.LOAD.B_NO_LOAD', 1);
    $run->set_value('D_ETC', $env->get_value('XPL_ETC') ||
                             $env->get_value('EXP_ETC') ||
                             '/etc/opt/SUNWexplo');
    $run->set_temp('F_LOG', $val)
      if (defined($val = $env->get_value('XPL_LOG'))
       || defined($val = $env->get_value('EXP_LOGFILE'))) && -f $val;
    $run->set_value('N_PID',
      $env->get_value('XPL_PID') || $env->get_value('EXP_PID') || $$);
    $run->set_value('K_SET', $set);
    $col->add_setup([], 1, 0, 'RDA:DCbegin');
    $col->end_setup($sav);

    # Add command restrictions
    if (defined($val = $env->get_value('EXP_RESTRICT')))
    { my ($cnt, $nam, %cmd);

      $cnt = 0;
      $nam = $cfg->is_unix
        ? 'SYSTEM.RESTRICT.T_UNIX'
        : 'SYSTEM.RESTRICT.T_WINDOWS';
      %cmd = map {$_ => 0} $col->get_value($nam);
      $val =~ s/\A\s+//s;
      $val =~ s/\s+\z//s;
      foreach my $pth (split(/\s*,\s*/, $val))
      { next if exists($cmd{$pth}) || !$cfg->is_path($pth);
        $cmd{$pth} = 1;
        ++$cnt;
      }
      if ($cnt)
      { $col->set_temp($nam, [sort keys(%cmd)]);
        $agt->get_system->reset_restrictions;
      }
    }

    # Reuse Oracle Explorer information when available
    foreach my $key (qw(ARC BLD OSN OSV OUT SUB TGT TMP TOP))
    { $run->set_value($tb_run{$key}, $val)
        if defined($val = $env->get_value("XPL_$key"));
    }
    foreach my $key (qw(ZONES))
    { if (defined($val = $env->get_value("EXP_$key")))
      { $val =~ s/^\s+//;
        $val =~ s/\s+$//;
        $run->set_value($tb_run{$key}, [split(/\s+/, $val)]) if length($val);
      }
    }

    # Load the incremental mode information
    $ifh = IO::File->new;
    $out = defined($val = RDA::Object::Rda->is_path($env->get_value('XPL_OUT')))
      ? $val
      : RDA::Object::Rda->current_dir;
    $inc = RDA::Object::Rda->cat_file($out, '.explastrda');
    if ($ifh->open("<$inc"))
    { $sta = $col->find('STATUS.EXPLORER.XPLR', 1);
      while (<$ifh>)
      { @rec = split(/\|/, $_);
        eval {$sta->set_temp($rec[1].'.G_LAST_INCR', $rec[2])}
          if (scalar @rec) == 4 && $rec[0] eq 'I';
      }
      $ifh->close;
    }
    $col->set_temp('SETUP.EXPLORER.XPLR.B_INCR_MODE', 1)
      if $env->get_value('EXP_COLLECT_MSGS');

    # Treat the input files
    $dsp->dsp_line(get_string('V_Input')) if $dsp;
    foreach my $mod (keys(%mod))
    { $pkg{$1} = 1 if defined($mod{$mod}) && $mod =~ m/^([^\|\-]+)/;
    }
    if (exists($det{'mandatory'}))
    { foreach my $mod (@{$det{'mandatory'}})
      { $pkg{$1} = 1 if $mod =~ m/^([^\|\-]+)/;
      }
    }
    $lng = $agt->get_lang('SDCL');
    foreach my $pkg (keys(%pkg))
    { $dsp->dsp_line(get_string('VI_Input', "$pkg-input")) if $dsp;
      eval {
        if ($obj = $lng->load_package($pkg))
        { $obj->exec(undef, undef, 'input');
          $lng->remove_package($obj);
        }
        };
      $agt->trace(get_string('ERR_INPUT', "$pkg-input", $@)) if $@ && $trc;
    }

    # Perform the setup
    $dsp->dsp_line(get_string('V_Setup', $yes)) if $dsp;
    $trc = ($req->get_first('trace') && $lvl < 2) ? 'T:' : q{};
    $col->set_isolated($yes);
    $col->add_setup([], 1, 1, $trc.'EXPLORER:DCxplr');
    $col->end_setup($sav);

    # Perform the collections
    $dsp->dsp_line(get_string('V_Collect')) if $dsp;
    $col->add_collect([],'RDA:DCbegin',
                         'RDA:DCconfig',
                         'RDA:DCend',
                         $trc.'EXPLORER:DCxplr');
    $col->end_collect($sav);

    # Save the incremental mode information
    if ($col->get_first('SETUP.EXPLORER.XPLR.B_INCR_MODE')
      && ($sta = $col->find('STATUS.EXPLORER.XPLR'))
      && $ifh->open($inc, $CREATE, $FIL_PERMS))
    { $buf = q{# Generated by RDA }.$cfg->get_version
        .q{ on }.$cfg->get_gmtime.qq{\n};
      foreach my $mod (qw(F15C FMA LOG MSG))
      { $buf .= qq{I|$mod|$val|\n}
          if defined($val = $sta->get_first("$mod.G_LAST_INCR"));
      }
      $ifh->syswrite($buf, length($buf));
      $ifh->close;
    }

    # Save warnings
    $buf = q{};
    $buf .= get_string('ERR_PARTIAL', join(q{, }, @mod))
      if (@mod = $col->get_value('STATUS.K_PARTIAL'));
    foreach my $key (qw(DB DBI OS REM XML))
    { $buf .= get_string($tb_wrn{$key}, $col->get_value("STATUS.N_WARN_$key"),
        join(q{, }, @mod))
        if (@mod = $col->get_value("STATUS.K_WARN_$key"));
    }
    if ($buf && $ifh->open(RDA::Object::Rda->cat_file($out, '.warnings'),
      $APPEND, $FIL_PERMS))
    { $ifh->syswrite($buf, length($buf));
      $ifh->close;
    }
    };

  # Indicate a successful completion
  return $req->reply($@, 'Run');
}

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

# Get the Oracle Explorer set
sub _get_set
{ my ($mrc, $set) = @_;

  return
    defined($set)        ? $mrc->find_set(['EXPLORER'], $set) :
    exists($tb_mrc{$^O}) ? $tb_mrc{$^O} :
                           'EXPLORER.xplr';
}

1;

__END__

=head1 SEE ALSO

L<RDA::Agent|RDA::Agent>,
L<RDA::Handle::Block|RDA::Handle::Block>,
L<RDA::Log|RDA::Log>,
L<RDA::Object|RDA::Object>,
L<RDA::Object::Config|RDA::Object::Config>,
L<RDA::Object::Context|RDA::Object::Context>,
L<RDA::Object::Env|RDA::Object::Env>,
L<RDA::Object::Message|RDA::Object::Message>,
L<RDA::Object::Mrc|RDA::Object::Mrc>,
L<RDA::Object::Output|RDA::Object::Output>,
L<RDA::Object::Rda|RDA::Object::Rda>,
L<RDA::Object::View|RDA::Object::View>,
L<RDA::SDCL::Block|RDA::SDCL::Block>,
L<RDA::SDSL::Module|RDA::SDSL::Module>,
L<RDA::SDSL::Setting|RDA::SDSL::Setting>,
L<RDA::Text|RDA::Text>

=head1 COPYRIGHT NOTICE

Copyright (c) 2002, 2016, Oracle. All rights reserved.

=head1 TRADEMARK NOTICE

Oracle is a registered trademark of Oracle Corporation and/or its
affiliates. Other names may be trademarks of their respective owners.

=cut