# Rda.pm: RDA Command Package

package RDA::UI::Rda;

# $Id: Rda.pm,v 1.37 2015/10/02 14:12:32 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/UI/Rda.pm,v 1.37 2015/10/02 14:12:32 RDA Exp $
#
# Change History
# 20151002  MSC  Extend the check commands.

=head1 NAME

RDA::UI::Rda - RDA Command Package

=head1 SYNOPSIS

 <rda> <options> <command> <switches> <arg> ...

 <rda> <options> -XRda <command> <switches> <arg> ...

 <sdci> <options> <command> <switches> <arg> ...

 <sdci> <options> -XRda <command> <switches> <arg> ...

=head1 DESCRIPTION

The following commands are available:

=cut

use strict;

BEGIN
{ use Exporter;
  use File::Copy;
  use IO::File;
  use RDA::Text qw(get_string);
  use RDA::Agent;
  use RDA::Driver::Archive;
  use RDA::Handle::Data;
  use RDA::Object;
  use RDA::Object::Content qw($RE_TRC %TB_TRC);
  use RDA::Object::Message;
  use RDA::Object::Rda;
  use RDA::Object::View;
  use RDA::Options;
}

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

# Define the global private constants
my $NL  = qq{\n};
my $SEP = qq{.N1\n};

# Define the global private variables
my %tb_itm = (
  A  => 'W_ABR',  # Text:TtlStaA Text:NoStaA
  C  => 'S_RUN',  # Text:TtlStaC Text:NoStaC
  D  => 'B_DFT',  # Text:TtlStaD Text:NoStaD
  M  => 'B_MRC',  # Text:TtlStaM Text:NoStaM
  S  => 'S_CFG',  # Text:TtlStaS Text:NoStaC
  );
my %tb_lib = (
  CB => ['CONVERT.LIST', 'ERR_CB'],  # Text:TtlCB Text:NoCB Text:ERR_CB
  DC => [                        ],  # Text:TtlDC Text:NoDC
  MR => ['MRC.LIST',     'ERR_MR'],  # Text:TtlMR Text:NoMR Text:ERR_MR
  PR => ['PROFILE.LIST', 'ERR_PR'],  # Text:TtlPR Text:NoPR Text:ERR_PR
  SC => [                        ],  # Text:TtlSC Text:NoSC
  TL => [                        ],  # Text:TtlTL Text:NoTL
  TM => [                        ],  # Text:TtlTM Text:NoTM
  );
my %tb_lst = (
  bundle   => 'B',
  bundles  => 'B',
  collect  => 'C',
  convert  => 'B',
  degree   => 'L',
  degrees  => 'L',
  display  => 'C',
  level    => 'L',
  levels   => 'L',
  module   => 'C',
  modules  => 'C',
  mrc      => 'M',
  profile  => 'P',
  profiles => 'P',
  root     => 'M',
  run      => 'R',
  setup    => 'C',
  start    => 'S',
  starts   => 'S',
  test     => 'T',
  tests    => 'T',
  tool     => 'R',
  tools    => 'R',
  );
my %tb_sta = (
  abbreviation  => 'A',
  abbreviations => 'A',
  collect       => 'C',
  default       => 'D',
  defaults      => 'D',
  mrc           => 'M',
  setup         => 'S',
  target        => 'T',
  targets       => 'T',
  );
my %tb_tgt = (
  CH  => 'TtlTgtCH',   # Text:TtlTgtCH
  DB  => 'TtlTgtDB',   # Text:TtlTgtDB
  DOM => 'TtlTgtDOM',  # Text:TtlTgtDOM
  DQ  => 'TtlTgtDQ',   # Text:TtlTgtDQ
  MH  => 'TtlTgtMH',   # Text:TtlTgtMH
  OB  => 'TtlTgtOB',   # Text:TtlTgtOB
  OH  => 'TtlTgtOH',   # Text:TtlTgtOH
  OI  => 'TtlTgtOI',   # Text:TtlTgtOI
  SQ  => 'TtlTgtSQ',   # Text:TtlTgtSQ
  SYS => 'TtlTgtSYS',  # Text:TtlTgtSYS
  WH  => 'TtlTgtWH',   # Text:TtlTgtWH
  );
my %tb_ver = (
  D_RDA     => {ext => qr/\.(cmd|com|pl|sh)$/,
                lvl => 1,
               },
  D_RDA_CHK => {ext => qr/\.(xml)$/,
                lvl => 2,
               },
  D_RDA_COL => {ext => qr/\.(cfg|ctl)$/,
                lvl => 2,
               },
  D_RDA_CSS => {ext => qr/\.css$/,
                lvl => 1,
               },
  D_RDA_DAT => {ext => qr/\.(css|htm|xml)$/,
                inv => 1,
                lvl => 1,
               },
  D_RDA_INC => {dir => [qw(Convert IRDA RDA SDCL SDSL)],
                ext => qr/\.(pm|pod)$/,
                lvl => 9,
               },
  D_RDA_MSG => {ext => qr/\.(dat|txt)$/,
                lvl => 2,
               },
  D_RDA_POD => {ext => qr/\.(pm|pod)$/,
                lvl => 2,
               },
  );


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

=head2 S<authenticate [-t type] user[/password]>

This command adds passwords in the context to enable batch execution of data
collections. Because the passwords are encoded in the file, you cannot enter
them in the file manually.

It supports the following switch:

=over 11

=item B<  -t type>

Specifies the account type. For database authentications, the type includes the
Oracle SID as sub type (C<DB,E<lt>sidE<gt>>).

=back

Typically, you can provide E<lt>usernameE<gt>/E<lt>passwordE<gt> as
arguments. When the password is missing, RDA prompts you to specify it
interactively.

=head2 S<authenticate -d [-t type] user>

This command deletes passwords that has been previously stored in the context.

=cut

sub authenticate
{ my ($agt, @arg) = @_;
  my ($act, $opt, $pwd, $usr, $typ);

  # Treat the options
  $opt = RDA::Options::getopts('dt*v', \@arg);
  $act = $opt->{'d'} ? 'delete' : 'add';
  $typ = $opt->{'t'};

  # Treat the request
  foreach my $usr (@arg)
  { $pwd = ($usr =~ s/^([^\/\@]*)\/([^\/\@]*)/$1/) ? $2 : undef;
    next unless length($usr);
    return 1 if $agt->submit(q{.}, 'RDA.AUTHENTICATE',
      action   => $act,
      password => $pwd,
      type     => $typ,
      user     => $usr)->is_error($agt);
  }

  # Save the changes
  return $agt->submit(q{.}, 'RDA.SAVE');
}

=head2 S<check -A>

This command verifies that RDA build is less than 6 months old. It returns a 0
(zero) exit status on successful verification. Otherwise, it returns a nonzero
exit status.

=head2 S<check -E>

This command verifies that no extra files or directories are present in the RDA
software directory structure. It returns a 0 (zero) exit status on successful
verification. Otherwise, it returns a nonzero exit status.

=head2 S<check -R>

This command verifies that RDA was installed correctly. It verifies file
permissions and check sums. It returns a 0 (zero) exit status when no errors
are detected. Otherwise, it returns a nonzero exit status.

=head2 S<check -U build>

This command verifies that RDA installation could be used and not older than
the specified build. It verifies file permissions and the presence of the
mandatory files. It returns a 0 (zero) exit status when no errors are
detected. Otherwise, it returns a nonzero exit status.

=head2 S<check -V>

This command verifies that engine code is not obsolete. It returns a 0 (zero)
exit status when no errors are detected. Otherwise, it returns a nonzero exit
status.

=head2 S<check arg...>

This command checks the syntax of the configuration and definition files that
are specified as arguments:

=over 17

=item B<  E<lt>convertE<gt>.cfg>

Checks the conversion bundle definitions in the specified group.

=item B<  E<lt>moduleE<gt>.cfg>

Checks the setup specifications for the specified module.

=item B<  E<lt>moduleE<gt>.ctl>

Checks the specified data collection module.

=item B<  E<lt>mrcE<gt>.cfg>

Checks the multi-run collection group definitions in the specified group.

=item B<  E<lt>profileE<gt>.cfg>

Checks the profile definitions in the specified group.

=back

When the argument points to a directory, it checks all known file types content
in that directory and its subdirectories. The recursion is limited to eight
levels.

It skips all other files.

It returns a 0 (zero) exit status when no errors are detected. Otherwise, it
returns a nonzero exit status.

=cut

sub check
{ my ($agt, @arg) = @_;
  my ($dsp, $msg, $opt);

  # Treat the options
  $dsp = $agt->is_verbose;
  $opt = RDA::Options::getopts('fAERU:V', \@arg);
  return _check_age($agt, $dsp)                  if $opt->{'A'};
  return _check_extra($agt)                      if $opt->{'E'};
  return _check_rda($agt, $dsp)                  if $opt->{'R'};
  return _check_use($agt, $dsp, $1, $opt->{'f'}) if exists($opt->{'U'})
                                                 && $opt->{'U'} =~ m/^(\d+)$/;
  return _check_engine($agt, $dsp)               if $opt->{'V'};

  # Check module syntax
  _check_syntax($agt, $dsp, 0, @arg);

  # Return the check result
  return $agt->has_errors ? 1 : 0;
}

sub _check_age
{ my ($agt, $dsp) = @_;
  my ($bld, $ref, @tbl);

  @tbl = gmtime();
  if ($tbl[4] < 6)
  { $tbl[4] += 7;
    $tbl[5] += 1899;
  }
  else
  { $tbl[4] -= 5;
    $tbl[5] += 1900;
  }
  $ref = sprintf('%04d%02d%02d', $tbl[5], $tbl[4], $tbl[3]);
  $bld = $agt->get_config->get_build;
  if ($bld lt $ref)
  { $dsp->dsp_line(get_string('Old', $bld)) if $dsp;
    return 1;
  }
  $dsp->dsp_line(get_string('Recent', $bld)) if $dsp;
  return 0;
}

sub _check_engine
{ my ($agt, $dsp) = @_;
  my ($ver);

  # Check the engine
  eval {$ver = $agt->get_config->check_engine};

  # Indicate the result
  if ($@)
  { $dsp->dsp_line(get_string('Obsolete')) if $dsp;
    return 1;
  }
  $dsp->dsp_line(get_string('Valid', $ver)) if $dsp;
  return 0;
}

sub _check_extra
{ my ($agt) = @_;

  return $agt->submit(q{.}, 'AGENT.EXTRA')->is_error($agt) ? 1 : 0;
}

sub _check_rda
{ my ($agt, $dsp) = @_;
  my ($cnt, @err);

  @err = _check_soft($agt, 0, $dsp);
  $dsp->dsp_line($NL) if $dsp;
  $agt->abort([@err], get_string('ERR_CHECK', $cnt)) if ($cnt = @err);
  $dsp->dsp_line(get_string('V_NoErrors')) if $dsp;
  return 0;
}

sub _check_soft ## no critic (Complex)
{ my ($agt, $flg, $dsp) = @_;
  my ($chk, $cfg, $cnt, $fil, $ifh, $pth, $sep, $sta, $tbl, $top, @err);

  # Load the check sum file if needed
  $dsp->dsp_line(get_string('V_ListLoad')) if $dsp;
  $cfg = $agt->get_config;
  $ifh = IO::File->new;
  $fil = $cfg->get_file('D_RDA_REL', 'rda.dat');
  $ifh->open("<$fil") or die get_string('NO_CHKSUM', $!);
  die get_string('BAD_CHKSUM') if _load_chksum($tbl = {}, $ifh);

  # Check the RDA installation
  $cnt = 0;
  foreach my $grp (sort keys(%{$tbl->{'_chk'}}))
  { next unless ($top = $cfg->get_group($grp));
    foreach my $dir (sort keys(%{$chk = $tbl->{'_chk'}->{$grp}}))
    { $pth = ($dir eq q{.})
        ? $top
        : $cfg->cat_dir($top, split(/\//, $dir));

      # Check the directory content
      $dsp->dsp_line(get_string('V_DirCheck', "\[$grp\] $dir")) if $dsp;
      if (opendir(DIR, $pth))
      { my ($ptr);

        foreach my $nam (sort readdir(DIR))
        { next unless -f ($fil = $cfg->cat_file($pth, $nam))
            && exists($chk->{$dir}->{$nam});
          $ptr = $chk->{$dir}->{$nam};
          $ptr->[2] = 1;
          $sta = q{};
          $sep = get_string('File', $fil);
          if (-r $fil && $ifh->open("<$fil"))
          { unless ($flg || $ptr->[0] == _calc_chksum($ifh))
            { $sta .= get_string('Altered', $sep);
              $sep = q{,};
            }
            unless ($ptr->[1] || $cfg->is_windows || -x $fil)
            { $sta .= get_string('NotExec', $sep);
              $sep = q{,};
            }
          }
          else
          { $sta = get_string('NotRead', $sep);
          }
          push(@err, $sta) if $sta;
        }
        closedir(DIR);

        # Identify missing files
        foreach my $nam (sort keys(%{$chk->{$dir}}))
        { push(@err, get_string('NoFile', $cfg->cat_file($pth, $nam)))
            unless $chk->{$dir}->{$nam}->[2];
        }
      }
      else
      { # Check if that directory contains any mandatory file
        foreach my $ptr (values(%{$chk->{$dir}}))
        { next if $ptr->[2];
          push(@err, get_string('NoAccess', $pth));
          last;
        }
      }
    }
  }
  return @err;
}

sub _check_syntax
{ my ($agt, $dsp, $lvl, @arg) = @_;
  my ($msg, @tbl);

  foreach my $arg (@arg)
  { if ($arg =~ m/\bconvert\.cfg$/i)
    { $msg = RDA::Object::Message->new('CONVERT.CHECK', definition => $arg);
    }
    elsif ($arg =~ m/\bgroup\.cfg$/i)
    { $msg = RDA::Object::Message->new('RDA.CHECK', definition => $arg);
    }
    elsif ($arg =~ m/\bmrc\.cfg$/i)
    { $msg = RDA::Object::Message->new('MRC.CHECK', definition => $arg);
    }
    elsif ($arg =~ m/\bprofile\.cfg$/i)
    { $msg = RDA::Object::Message->new('PROFILE.CHECK', definition => $arg);
    }
    elsif ($arg =~ m/\.cfg$/i)
    { $msg = RDA::Object::Message->new('SDSL.CHECK', package => $arg);
    }
    elsif ($arg =~ m/\.ctl$/i)
    { $msg = RDA::Object::Message->new('SDCL.CHECK', package => $arg);
    }
    else
    { if (-d $arg && $arg !~ m/^(?:\.|CVS$)/ && $lvl < 8 && opendir(CHK, $arg))
      { @tbl = sort map {RDA::Object::Rda->cat_file($arg, $_)}
                    grep {! m/^(?:\.|CVS$)/} readdir(CHK);
        closedir(CHK);
        _check_syntax($agt, $dsp, $lvl + 1, @tbl);
      }
      elsif ($lvl == 0  && $arg !~ m/\.txt$/i)
      { die get_string('NO_CHECK', $arg);
      }
      next;
    }
    $dsp->dsp_line(get_string('V_NoIssues', $arg))
      unless $agt->submit(q{.}, $msg)->is_error($agt) || ## no critic (Unless)
             !$dsp;
  }
  return;
}

sub _check_use
{ my ($agt, $dsp, $bld, $frc) = @_;
  my ($cnt, $ver);

  # Check the engine version
  eval {$ver = $agt->get_config->check_engine};
  if ($@ || $ver < $bld)
  { $dsp->dsp_line(get_string('Obsolete')) if $dsp;
    return $frc ? 0 : 1;
  }

  # Check the installation
  if ($cnt = _check_soft($agt, 1))
  { $dsp->dsp_line(get_string('Issues', $cnt)) if $dsp;
    return $frc ? 0 : 2;
  }

  # Indicate a valid installation
  $dsp->dsp_line(get_string('Valid', $ver)) if $dsp;
  return 0;
}

sub _calc_chksum
{ my ($ifh) = @_;
  my $sum = 0;

  binmode($ifh);
  while (<$ifh>)
  { s/\$(Header|[Ii]d|[Rr]evision):\s.*?\$/\$\u$1\$/;
    $sum += unpack('%32C*', $_);
  }
  $ifh->close;
  return $sum % 65535;
}

sub _load_chksum
{ my ($tbl, $ifh) = @_;
  my ($dir, $grp, $lin, $nam, $sum, $tot, $typ, $vms, $win);

  # Initialization
  $vms = RDA::Object::Rda->is_vms;
  $win = RDA::Object::Rda->is_windows;
  $tbl->{'_chk'} = {};
  $tbl->{'_ver'} = '0.0';
  $tbl->{'_bld'} = '000000';

  # Load the file list
  $tot = 0;
  $grp = q{};
  while (defined($lin = $ifh->getline))
  { $lin =~ s/[\n\r\s]+$//;
    if ($lin =~ m/^\[(\w+)\]$/)
    { $tbl->{'_chk'}->{$1} = $grp = {};
    }
    elsif ($lin =~ m/^#/)
    { ($tbl->{'_ver'}, $tbl->{'_bld'}) = ($1, $2)
        if $lin =~ m/^#\s*\$Build:\s*(\d+\.\d+)\-(\d{6}\w*)\s*\$/;
      next;
    }
    else
    { ($typ, $dir, $sum, $nam) = split(/\s+/, $lin, 4);
      next unless $typ && $dir && $nam;
      $tot += $sum;
      unless ($typ eq q{-})
      { $grp->{$dir}->{$nam} =
          [$sum, $win || lc($typ) eq 'f', $typ eq lc($typ)];
        $grp->{$dir}->{lc($nam)} = $grp->{$dir}->{$nam} if $vms;
      }
    }
  }
  $ifh->close;
  return $tot % 65535;
}

=for stopwords fw

=head2 S<collect [-SRGP] [-fw] [-l lvl] [-g grp,...] [-n|-p nam,...|module...]>

This command collects the diagnostics data for the defined modules. When it
does not find any defined result set, it executes the default scenario.

It supports the following switches and arguments:

=over 14

=item B<  -c lvl>

Specifies the archive compression level (O to 9).

=item B<  -d dir>

Specifies the location of the transport archive.

=item B<  -f>

When true, reruns the setup of modules that are not specified explicitly but
already exist.

=item B<  -g grp,...>

Restricts the module search to the specified groups.

=item B<  -l lvl>

Specifies a new setting level.

=item B<  -n>

When no modules are specified, collects pending modules instead of all modules.

=item B<  -p nam,...>

Specifies a comma-separated list of data collection profiles.

=item B<  -t theme>

Specifies a rendering theme.

=item B<  -w>

Suppresses the display of the packaging text.

=item B<  -G>

Converts the reports to XML.

=item B<  -P>

Packages the result set.

=item B<  -R>

Renders the reports.

=item B<  -S>

Redoes the setup.

=item B<  module>

Data collection module to run.

=back

=cut

sub collect
{ my ($agt, @arg) = @_;
  my ($opt);

  # Treat the options
  $opt = RDA::Options::getopts('GRPSc:d:fg*l:np*t:w', \@arg);

  # Redo the setup
  return 1 if exists($opt->{'S'}) && $agt->submit(q{.}, 'RDA.SETUP',
    degree   => $opt->{'l'},
    display  => 0,
    force    => $opt->{'f'},
    groups   => $opt->{'g'},
    modules  => (scalar @arg) ? [map {split(/\,/, $_)} @arg] : undef,
    profiles => $opt->{'p'})->is_error($agt);

  # Collect the data
  return 2 if $agt->submit(q{.}, 'RDA.COLLECT',
    degree   => $opt->{'l'},
    groups   => $opt->{'g'},
    modules  => (scalar @arg) ? [map {split(/\,/, $_)} @arg] : undef,
    pending  => $opt->{'n'},
    profiles => $opt->{'p'})->is_error($agt);

  # Render the reports
  return 3 if exists($opt->{'R'}) && $agt->submit(q{.},
    'RENDER.GEN_HTML', theme => $opt->{'t'})->is_error($agt);

  # Convert the reports in XML
  return 4 if exists($opt->{'G'}) && $agt->submit(q{.},
    'CONVERT.GEN_XML')->is_error($agt);

  # Package the collection results
  return exists($opt->{'P'})
    ? _package($agt, {c => $opt->{'c'}, d => $opt->{'d'}, w => $opt->{'w'}})
    : 0;
}

=head2 S<convert [-d dir] [-f] [-o dir] [-p prefix] [report...]>

This command converts RDA reports in XML. By default, RDA generates out-dated
and missing reports only. It supports the following switches:

=over 13

=item B<  -d dir>

Specifies the directory containing the files to convert.

=item B<  -f>

Converts all reports.

=item B<  -o dir>

Specifies the output directory (when working on an archive)

=item B<  -p prefix>

Specifies the file prefix (when working on an archive containing multiple
result sets)

=back

=head2 S<convert [-a key=val,...] [-g grp,...] [-o fil] [-p prefix] -b bundle>

This command converts a RDA report bundle. It supports the following switches:

=over 18

=item B<  -a key=val,...>

Specifies C<sdp_bundle> tag attributes as a comma-separated list of key-value
pairs.

=item B<  -b bundle>

Specifies the bundle names.

=item B<  -g grp,...>

Restricts the search to the specified groups.

=item B<  -o file>

Specifies the output file (F<convert.xml> by default).

=item B<  -p prefix>

Specifies the file prefix (when working on an archive containing multiple
result sets)

=back

=cut

sub convert  ## no critic (Complex)
{ my ($agt, @arg) = @_;
  my ($abs, $cfg, $ctl, $cwd, $key, $msg, $opt, $pth, $val, %tbl);

  # Treat the options
  $opt = RDA::Options::getopts('a*b:d:fg*o:p:z:', \@arg);
  if (defined($pth = $agt->get_info('zip', $opt->{'z'})))
  { $cfg = $agt->get_config;
    if ($cfg->is_absolute($pth))
    { if (-d $pth)
      { $ctl = _set_ctl($agt, $abs, $opt->{'p'})
          if -r ($abs = $cfg->cat_dir($pth));
      }
      elsif (-f $pth)
      { $ctl = _set_ctl($agt, $abs, $opt->{'p'})
          if -r ($abs = $cfg->cat_file($pth));
      }
    }
    else
    { $cwd = $cfg->get_group('D_CWD');
      if (-d ($abs = $cfg->cat_dir($cwd, $pth)) ||
          -f ($abs = $cfg->cat_file($cwd, $pth)))
      { $ctl = _set_ctl($agt, $abs, $opt->{'p'})
          if -r $abs;
      }
    }
    die get_string('BAD_ZIP', $pth) unless $ctl;
  }
  if (exists($opt->{'b'}))
  { if (exists($opt->{'a'}))
    { foreach my $str (@{$opt->{'a'}})
      { ($key, $val) = split(/=/, $str, 2);
        $tbl{lc("set_$key")} = RDA::Object::decode($val)
          if $key && defined($val);
      }
    }
    $msg = RDA::Object::Message->new('CONVERT.GEN_BUNDLE',
      groups => $opt->{'g'},
      name   => $opt->{'b'},
      output => $opt->{'o'},
      set    => $ctl ? $ctl->get_oid : undef,
      %tbl);
  }
  elsif (exists($opt->{'d'}))
  { $msg = RDA::Object::Message->new('CONVERT.GEN_XML',
      directory => $opt->{'d'},
      files     => [@arg],
      set       => $ctl ? $ctl->get_oid : undef);
  }
  else
  { $msg = RDA::Object::Message->new('CONVERT.GEN_XML',
      force   => $opt->{'f'},
      output  => $opt->{'o'},
      reports => [@arg],
      set     => $ctl ? $ctl->get_oid : undef);
  }

  # Convert files
  return $agt->submit(q{.}, $msg);
}

sub _set_ctl
{ my ($agt, $pth, $pre) = @_;
  my ($ctl);

  $ctl = $agt->get_registry('WEB.ARC',
      \&RDA::Driver::Archive::new, 'RDA::Driver::Archive',  ## no critic (Call)
      $agt)->add_archive($pth);
  $ctl->select($pre);
  return $ctl->get_current();
}

=head2 S<delete [-f] [-g grp,...] [module ...]>

This command deletes the modules that are specified as arguments. It is only
possible to delete modules that do not have reports. You cannot delete the
modules that are executed at each data collection run.

It supports the following switches and arguments:

=over 14

=item B<  -f>

Removes the associated reports first before deleting the module.

=item B<  -g grp,...>

Restricts the module search to the specified groups.

=item B<  module>

Specifies the module to delete.

=back

=cut

sub delete  ## no critic (Builtin)
{ my ($agt, @arg) = @_;
  my ($cnt, $opt);

  # Treat the options
  $opt = RDA::Options::getopts('afg*', \@arg);

  # Delete the modules and indicate the completion status
  $cnt = $agt->get_content;
  return $agt->submit(q{.}, 'RDA.DELETE',
    force   => $opt->{'f'},
    groups  => $opt->{'g'},
    modules => (scalar @arg)
      ? [map {$cnt->get_module('DC', $opt->{'g'}, $_)} @arg]
      : undef);
}

=head2 S<display [-g grp,...] [-l lvl] module...>

This command displays the setup questions of the specified modules. The
operating system "pager" mechanism must be configured to pause at the end of
the page to support multiple arguments in interactive mode.

It supports the following switches and arguments:

=over 14

=item B<  -g grp,...>

Restricts the module search to the specified groups.

=item B<  -l lvl>

Specifies a setting level.

=item B<  module>

Specifies the module to analyze.

=back

=head2 S<display [-g grp,...] [-l lvl] -p profile,...>

This command displays the setup questions of the modules included in the
specified modules. The operating system "pager" mechanism must be configured
to pause at the end of the page.

It supports the following switches:

=over 20

=item B<    -g grp,...>

Restricts the module search to the specified groups.

=item B<    -l lvl>

Specifies a setting level.

=item B<    -p profile,...>

Provides a comma-separated list of profiles to analyze.

=back

=cut

sub display
{ my ($agt, @arg) = @_;
  my ($cnt, $opt, $rsp, @tbl);

  # Treat the options
  $opt = RDA::Options::getopts('g*l:p*', \@arg);

  # Determine the module list
  if (@arg)
  { @tbl = @arg;
  }
  elsif ($opt->{'p'})
  { ($rsp = $agt->submit(q{.}, 'PROFILE.PREVIEW',
      groups   => $opt->{'g'},
      profiles => $opt->{'p'}))->is_error($agt);
    @tbl = $rsp->get_value('modules')
  }

  # Treat the arguments
  $cnt = $agt->get_content;
  foreach my $mod (@tbl)
  { $agt->submit(q{.}, 'SDSL.DISPLAY',
      degree  => $opt->{'l'},
      groups  => $opt->{'g'},
      package => $cnt->get_module(q{*}, $opt->{'g'}, $mod, '.cfg',
                                  $mod))->is_error($agt);
  }

  # Indicate a successful completion
  return 0;
}

=head2 S<explain [(EXPL|IRDA|OCM|RDA|STB)-]E<lt>nE<gt>...>

This command displays an explanation of the error numbers that are specified as
arguments. It only supports C<EXPL>, C<IRDA>, C<OCM>, C<RDA>, and C<STB>
product codes. It takes C<RDA> as default product code.

=cut

sub explain
{ return shift->submit(q{.}, 'DISPLAY.EXPLAIN', errors => [@_]);
}

=head2 S<halt>

This command halts the background collection.

=cut

sub halt
{ my ($agt, @arg) = @_;

  # Treat the options
  RDA::Options::getopts(q{}, \@arg);

  # Execute the request
  return $agt->submit(q{.}, 'RDA.HALT');
}

=head2 S<help>

This command displays the command syntax and the related explanations.

=cut

sub help
{ return shift->submit(q{.}, 'DISPLAY.DSP_POD', package => __PACKAGE__);
}

=head2 S<index [-f] [-t theme]>

This command regenerates the report index. It supports the following switches:

=over 12

=item B<  -f>

Reloads the cascading style sheet.

=item B<  -t theme>

Specifies the rendering theme.

=back

=cut

sub index  ## no critic (Builtin)
{ my ($agt, @arg) = @_;
  my ($opt);

  # Treat the options
  $opt = RDA::Options::getopts('ft:', \@arg);

  # Generate the report index and indicate the completion status
  return $agt->submit(q{.}, 'RENDER.GEN_INDEX',
    css   => $opt->{'f'},
    theme => $opt->{'t'});
}

=head2 S<kill>

This command kills the background collection.

=cut

sub kill  ## no critic (Builtin)
{ my ($agt, @arg) = @_;

  # Treat the options
  RDA::Options::getopts(q{}, \@arg);

  # Execute the request
  return $agt->submit(q{.}, 'RDA.KILL');
}

=head2 S<list [-g grp,...] [-BCMPRTX] [set...]>

This command lists the available data collection modules, tools or test modules,
setting levels, profiles, and conversion bundles.

You can restrict the list by specifying following switches:

=over 7

=item B<  -B > Lists the XML conversion bundles.

=item B<  -C > Lists the data collection modules.

=item B<  -L > Lists the setting levels.

=item B<  -M > Lists the multi-run collection modules.

=item B<  -P > Lists the profiles.

=item B<  -R > Lists the tools (see C<run> command).

=item B<  -S > Lists the start scenarios.

=item B<  -T > Lists the test modules (see C<test> command).

=back

or following keywords:

=over 12

=item B<  bundles>

Lists the XML conversion bundles.

=item B<  degrees>

Lists the setting levels.

=item B<  levels>

Lists the setting levels.

=item B<  modules>

Lists the data collection modules.

=item B<  mrc>

Lists the multi-run collection modules.

=item B<  profiles>

Lists the profiles.

=item B<  starts>

Lists the start scenarios.

=item B<  tests>

Lists the test modules.

=item B<  tools>

Lists the tools.

=back

=cut

sub list  ## no critic (Complex)
{ my ($agt, @arg) = @_;
  my ($buf, $cfg, $cnt, $grp, $opt, $sep);

  # Determine the list types
  $opt = RDA::Options::getopts('BCLMPRSTg*', \@arg);
  $grp = $opt->{'g'};
  foreach my $typ (@arg)
  { $typ = lc($typ);
    die get_string('BAD_LIST', $typ) unless exists($tb_lst{$typ});
    $opt->{$tb_lst{$typ}} = 1;
  }

  # Produce requested lists
  $buf = q{};
  $sep = $SEP;
  $cfg = $agt->get_config;
  $cnt = $agt->get_content;
  $buf .= _list_mod($cnt, 'DC', $grp, $buf ? $sep : q{}) if exists($opt->{'C'});
  $buf .= _list_mod($cnt, 'SC', $grp, $buf ? $sep : q{}) if exists($opt->{'S'});
  $buf .= _list_mod($cnt, 'TL', $grp, $buf ? $sep : q{}) if exists($opt->{'R'});
  $buf .= _list_mod($cnt, 'TM', $grp, $buf ? $sep : q{}) if exists($opt->{'T'});
  $buf .= _list_lvl($cfg, $buf ? $sep : q{})             if exists($opt->{'L'});
  $buf .= _list_lib($agt, 'MR', $grp, $buf ? $sep : q{}) if exists($opt->{'M'});
  $buf .= _list_lib($agt, 'PR', $grp, $buf ? $sep : q{}) if exists($opt->{'P'});
  $buf .= _list_lib($agt, 'CB', $grp, $buf ? $sep : q{}) if exists($opt->{'B'});

  # Produce default lists
  unless ($buf)
  { $buf .= _list_mod($cnt, 'DC', $grp, $buf ? $sep : q{});
    $buf .= _list_mod($cnt, 'SC', $grp, $buf ? $sep : q{});
    $buf .= _list_mod($cnt, 'TL', $grp, $buf ? $sep : q{});
    $buf .= _list_mod($cnt, 'TM', $grp, $buf ? $sep : q{});
    $buf .= _list_lvl($cfg, $buf ? $sep : q{});
    $buf .= _list_lib($agt, 'MR', $grp, $buf ? $sep : q{});
    $buf .= _list_lib($agt, 'PR', $grp, $buf ? $sep : q{});
    $buf .= _list_lib($agt, 'CB', $grp, $buf ? $sep : q{});
  }

  # Display the report and indicate the completion status
  return $agt->submit(q{.}, RDA::Object::Message->new('DISPLAY.DSP_REPORT',
    page => 1)->add_data($buf));
}

# Produce library-related lists
sub _list_lib
{ my ($agt, $typ, $grp, $sep) = @_;
  my ($buf, $rsp);

  # Get the multi-run collection list
  $rsp = $agt->submit(q{.}, $tb_lib{$typ}->[0],
    description => 1,
    groups      => $grp);
  $agt->abort if $rsp->is_error($agt, get_string($tb_lib{$typ}->[1]));

  # Produce the report
  return ($buf = $rsp->get_data)
    ? $sep.q{.M 2 '}.get_string('Ttl'.$typ).q{'}.$NL.$buf.$NL
    : $sep._no_list('No'.$typ);
}

# Produce setting level lists
sub _list_lvl
{ my ($cfg, $sep) = @_;

  return $sep.q{.T'}.get_string('TtlSL').q{'}.$NL
    .join(q{}, map {qq{.I'  '\n$_\n\n}} $cfg->get_degrees);
}

# Produce data collection module lists
sub _list_mod
{ my ($cnt, $typ, $grp, $sep) = @_;
  my ($buf, $ctl);

  # Get the module list
  $ctl = $cnt->get_modules($typ, $grp, 'abr', 'dsc');

  # Generate the report
  $buf = q{};
  foreach my $nam (sort {$ctl->{$a}->[0] cmp $ctl->{$b}->[0]} keys(%{$ctl}))
  { $buf .= $ctl->{$nam}->[0].q{|}.$ctl->{$nam}->[1].$NL;
  }
  return $buf
    ? $sep.q{.M 2 '}.get_string('Ttl'.$typ).q{'}.$NL.$buf.$NL
    : $sep._no_list('No'.$typ);
}

# Report an empty list
sub _no_list
{ my ($txt) = @_;

  return q{.T'}.get_string($txt).q{'}.$NL;
}

=head2 S<man module ...>

This command displays the manual pages associated with the arguments. By
default, it displays the RDA manual page. The operating system "pager"
mechanism must be configured to pause at the end of the page to support
multiple arguments in interactive mode.

=head2 S<man [-g grp,...] -b nam,...>

This command displays the manual pages associated with the specified XML
conversion bundles. It supports the following switches:

=over 14

=item B<  -g grp,...>

Restricts the search to the specified groups.

=item B<  -b nam,...>

Provides a comma-separated list of XML conversion bundles to display.

=back

The operating system "pager" mechanism must be configured to pause at the end
of the page to support multiple arguments in interactive mode.

=head2 S<man [-g grp,...] -m nam,...>

This command displays the manual pages associated with the specified multi-run
collection groups. It supports the following switches:

=over 14

=item B<  -g grp,...>

Restricts the search to the specified groups.

=item B<  -m nam,...>

Provides a comma-separated list of multi-run collection groups to display.

=back

The operating system "pager" mechanism must be configured to pause at the end
of the page to support multiple arguments in interactive mode.

=head2 S<man [-a] [-g grp,...] -p profile,...>

This command displays the manual pages associated with the specified
profiles. It supports the following switches:

=over 18

=item B<  -a>

Displays setting assignments also.

=item B<  -g grp,...>

Restricts the profile search to the specified groups.

=item B<  -p profile,...>

Provides a comma-separated list of profiles to display.

=back

The operating system "pager" mechanism must be configured to pause at the end
of the page to support multiple arguments in interactive mode.

=cut

sub man
{ my ($agt, @arg) = @_;
  my ($arg, $cfg, $cnt, $dir, $lng, $mod, $opt, $pod, $top);

  # Initialization
  $arg = 0;
  $cfg = $agt->get_config;
  $cnt = $agt->get_content;
  $dir = $cfg->get_group('D_RDA_COL');
  $pod = $cfg->get_group('D_RDA_POD');
  $top = $cfg->get_group('D_RDA_INC');
  ($lng) = split(/\./, $agt->get_info('str', 'en'));

  # Treat the options
  $opt = RDA::Options::getopts('ab*g*m*p*', \@arg);
  if (exists($opt->{'b'}))
  { foreach my $nam (@{$opt->{'b'}})
    { $agt->submit(q{.}, 'CONVERT.DISPLAY',
        groups => $opt->{'g'},
        name   => $nam)->is_error($agt);
      ++$arg;
    }
  }
  if (exists($opt->{'m'}))
  { foreach my $nam (@{$opt->{'m'}})
    { $agt->submit(q{.}, 'MRC.DISPLAY',
        groups => $opt->{'g'},
        name   => $nam)->is_error($agt);
      ++$arg;
    }
  }
  if (exists($opt->{'p'}))
  { foreach my $nam (@{$opt->{'p'}})
    { $agt->submit(q{.}, 'PROFILE.DISPLAY',
        groups   => $opt->{'g'},
        name     => $nam,
        settings => $opt->{'a'})->is_error($agt);
      ++$arg;
    }
  }

  # Treat the arguments
  push(@arg, 'rda.pod') unless $arg || @arg;
  foreach my $arg (@arg)
  { if ($arg =~ m/^([^"]+\.pm)$/i)
    { eval "require \"$1\"";
      $agt->submit(q{.}, 'DISPLAY.DSP_POD', page => 1,
        file => $INC{$arg})->is_error($agt) unless $@;
    }
    elsif ($arg =~ m/^(\w+(::\w+)+)$/)
    { eval "require $1";
      unless ($@)
      { $arg =~ s{::}{/}g;
        $agt->submit(q{.}, 'DISPLAY.DSP_POD', page => 1,
          file => $INC{"$arg.pm"})->is_error($agt) unless $@;
      }
    }
    elsif ($mod = $cnt->get_module(q{*}, $opt->{'g'}, $arg, '.ctl'))
    { $agt->submit(q{.}, 'DISPLAY.DSP_POD', page => 1,
        file => $cfg->cat_file($dir, split(/:/, $mod)))->is_error($agt);
    }
    elsif ($arg =~ m/\.ctl$/i)
    { $agt->submit(q{.}, 'DISPLAY.DSP_POD', page => 1,
        file => $cfg->cat_file($dir, $arg))->is_error($agt);
    }
    elsif ($arg =~ m/^(.*?)(\.pod)?$/i)
    { $agt->submit(q{.}, 'DISPLAY.DSP_POD', page => 1, file => [
        $cfg->cat_file($pod, $lng, "$1.pod"),
        $cfg->cat_file($pod, $lng, "$1.pm"),
        $cfg->cat_file($pod, 'en', "$1.pod"),
        $cfg->cat_file($pod, 'en', "$1.pm"),
        $cfg->cat_file($top, "$1.pod"),
        $cfg->cat_file($top, "$1.pm")])->is_error($agt);
    }
  }

  # Indicate a successful completion
  return 0;
}

=for stopwords tw

=head2 S<package [-tw] [-c lvl] [-d dir] [-n nam]>

This command packages all collection results. It supports the following
switches:

=over 10

=item B<  -c lvl>

Specifies the archive compression level (O to 9).

=item B<  -d dir>

Specifies the transport archive location.

=item B<  -n nam>

Specifies the transport archive name, which can contain alphanumeric
characters, dashes, and underscores.

=item B<  -t>

Includes a time stamp in the transport archive name.

=item B<  -w>

Suppresses the display of the packaging text.

=back

=cut

sub package  ## no critic (Builtin)
{ my ($agt, @arg) = @_;

  return _package($agt, RDA::Options::getopts('c:d:n:tw', \@arg));
}

sub _package
{ my ($agt, $opt) = @_;
  my ($col, $dir, $nam, @tbl);

  # Validate the argument
  $dir = $agt->get_system->test_dir('d', $opt->{'d'}, 1);
  $nam = $1 if exists($opt->{'n'}) && $opt->{'n'} =~ m/^([\-\w]+)$/;

  # Produce the package
  return 10 if $agt->submit(q{.}, 'PACKAGE.RESULTS',
    display     => $opt->{'w'} ? 0 : undef,
    compression => $opt->{'c'},
    location    => $dir,
    name        => $nam,
    timestamp   => $opt->{'t'})->is_error($agt);

  # Check if some finalization tasks are present
  $col = $agt->get_collector;
  return 0 unless (@tbl =
    grep {m/([A-Z][A-Z\d]*:)?DC([a-z][a-z\d]*)(\-\w+)*$/}
    $col->set_value('PACKAGE.T_FINALIZE'));
  $col->find('SETUP.FINAL', 1)->clear->set_temp('T_FINALIZE_PACKAGE', [@tbl]);

  # Perform the finalization treatment
  return
    $agt->submit(q{.}, 'RDA.POST',
      type => 'FINALIZE_PACKAGE')->is_error($agt)   ? 11 :
    $agt->submit(q{.}, 'RENDER.GEN_HTML')->is_error($agt) ? 12 :
    $agt->submit(q{.}, 'PACKAGE.RESULTS',
      compression => $opt->{'c'},
      display     => $opt->{'w'} ? 0 : undef,
      location    => $dir,
      name        => $nam,
      timestamp   => $opt->{'t'})->is_error($agt)     ? 13 :
                                                      0;
}

=head2 S<refresh [-c] [-d dsc] [-l lvl]>

This command refreshes the result set definition using the original start
scenario.

It supports the following switches:

=over 14

=item B<  -c>

Reruns the collection setup.

=item B<  -d dsc>

Specifies a new context description.

=item B<  -l lvl>

Specifies a new setting level.

=back

=cut

sub refresh
{ my ($agt, @arg) = @_;
  my ($opt);

  # Treat the options
  $opt = RDA::Options::getopts('cd:l:', \@arg);

  # Execute a start scenario refresh and indicate the completion status
  return $agt->submit(q{.}, 'RDA.REFRESH',
    collector => $opt->{'c'},
    degree    => $opt->{'l'},
    desc      => $opt->{'d'},
    setup     => 1);
}

=head2 S<render [-d dir] [-f] [-t theme] [report...]>

This command generates the HTML reports. By default, it generates out-dated
and missing reports only. It supports the following switches:

=over 11

=item B<  -d dir>

Specifies the directory containing the files to render.

=item B<  -f>

Generates all reports.

=item B<  -o>

Reads formatting specifications from standard input and transforms them into
HTML code.

=item B<  -t theme>

Uses the specified theme for rendering the reports.

=back

It regenerates the index automatically when reports are produced.

=cut

sub render
{ my ($agt, @arg) = @_;
  my ($opt);

  # Treat the options
  $opt = RDA::Options::getopts('d:fot:', \@arg);

  # Render files and indicate the completion status
  return
    exists($opt->{'o'}) ? $agt->submit(q{.}, 'RENDER.GEN_OUTPUT') :
    exists($opt->{'d'}) ? $agt->submit(q{.}, 'RENDER.GEN_HTML',
                            directory => $opt->{'d'},
                            files     => @arg ? [@arg] : undef,
                            theme     => $opt->{'t'}) :
                          $agt->submit(q{.}, 'RENDER.GEN_HTML',
                            css       => $opt->{'f'},
                            force     => $opt->{'f'},
                            reports   => @arg ? [@arg] : undef,
                            theme     => $opt->{'t'});
}

=head2 S<run [-g grp,...] [-s section,...] module [arg...]>

This command executes a tool. It supports the following switches and arguments:

=over 18

=item B<  -g grp,...>

Restricts the search to the specified groups.

=item B<  -s section,...>

Provides the comma-separated list of sections to execute. By default, it
executes the C<tool> section only.

=item B<  module>

Tool name or abbreviation.

=item B<  arg>

Tool argument.

=back

=cut

sub run
{ my ($agt, @arg) = @_;
  my ($mod, $opt, $ret, $rsp);

  # Treat the options
  $opt = RDA::Options::getopts('g*s*', \@arg);

  # Get the module name
  die get_string('NO_TOOL') unless ($mod = shift(@arg));

  # Execute the test
  $rsp = $agt->submit(q{.}, 'RDA.RUN',
    args      => (scalar @arg) ? [@arg] : undef,
    groups    => $opt->{'g'},
    tool      => $mod,
    sections  => exists($opt->{'s'}) ? $opt->{'s'} : 'tool');

  # Indicate the completion status
  return defined($ret = $rsp->get_first('exit_only')) ? $ret : $rsp;
}

=head2 S<sample [-f] [-o output] [module...]>

This command starts a new background collection. It supports the following
switches and arguments:

=over 13

=item B<  -f>

Forces the scenario execution even when the context already exists.

=item B<  -g grp,...>

Restricts the module search to the specified groups.

=item B<  -o output>

Specifies the output file.

=item B<  module>

Specifies a sample module to execute.

=back

=cut

sub sample
{ my ($agt, @arg) = @_;
  my ($opt);

  # Treat the options
  $opt = RDA::Options::getopts('fg*o:', \@arg);

  # Execute the request
  return $agt->submit(q{.}, 'RDA.SAMPLE',
    force   => $opt->{'f'},
    groups  => $opt->{'g'},
    modules => @arg ? [@arg] : undef,
    output  => $opt->{'o'},
    );
}

=head2 S<setup [-cfw] [-g grp,...] [-l lvl] [-p nam,...|module...]>

This command performs the setup of the specified modules or profiles. It
supports the following switches and arguments:

=over 14

=item B<  -c>

Reruns the collection setup.

=item B<  -f>

Forces the scenario execution even when the context already exists.

=item B<  -g grp,...>

Restricts the search to the specified groups.

=item B<  -l lvl>

Specifies a new setting level.

=item B<  -p nam,...>

Provides a comma-separated list of data collection profiles.

=item B<  -w>

Suppresses the display of the setup text.

=item B<  module>

Specifies a data collection module to configure.

=back

=cut

sub setup
{ my ($agt, @arg) = @_;
  my ($opt);

  # Treat the options
  $opt = RDA::Options::getopts('cfg*l:p*tw', \@arg);

  # Perform the setup
  return $agt->submit(q{.}, 'RDA.SETUP',
    collector => $opt->{'c'},
    degree    => $opt->{'l'},
    display   => $opt->{'w'} ? 0 : undef,
    force     => $opt->{'f'},
    groups    => $opt->{'g'},
    modules   => (scalar @arg) ? [map {split(/\,/, $_)} @arg] : undef,
    profiles  => $opt->{'p'});
}

=head2 S<start [-f] [-d dsc] [-g grp,...] [-l lvl] [-p nam,...]>

This command creates a new context by executing the default start scenario.

=head2 S<start [-f] [-d dsc] [-g grp,...] [-l lvl] [-p nam,...] scn [arg...]>

This command creates a new context by executing the specified start scenario,
with appropriate arguments. Unless forced, it does not execute the scenario
when the context exists.

It supports the following switches:

=over 14

=item B<  -d dsc>

Specifies a context description.

=item B<  -f>

Forces the scenario execution even when the context already exists.

=item B<  -g grp,...>

Restricts the scenario search to the specified groups.

=item B<  -l lvl>

Specifies a setting level.

=item B<  -p nam,...>

Provides a comma-separated list of data collection profiles.

=back

=cut

sub start
{ my ($agt, @arg) = @_;
  my ($mod, $opt);

  # Treat the options
  $opt = RDA::Options::getopts('d:fg*l:p*', \@arg);

  # Get the module name
  $mod = 'DFT' unless (defined($mod = shift(@arg)));
  $mod = $agt->get_content->get_module('SC', $opt->{'g'}, $mod);

  # Execute a start scenario and indicate the completion status
  return $agt->submit(q{.}, 'RDA.START',
    args     => (scalar @arg) ? [@arg] : undef,
    degree   => $opt->{'l'},
    desc     => $opt->{'d'},
    force    => $opt->{'f'},
    groups   => $opt->{'g'},
    package  => $mod,
    profiles => $opt->{'p'},
    setup    => 1);
}

=head2 S<status [-ACDMST] [set...]>

This command extracts statuses from the result set definition.

You can restrict the status list by specifying following switches:

=over 7

=item B<  -A > Lists the abbreviations in use.

=item B<  -C > Lists the collection statuses.

=item B<  -D > Lists the data collection modules executed by default.

=item B<  -M > Lists the multi-run collection modules.

=item B<  -S > Lists the setup statuses.

=item B<  -T > Lists the defined targets.

=back

or following keywords:

=over 17

=item B<  abbreviations>

Lists the abbreviations in use.

=item B<  collect>

Lists the collection statuses.

=item B<  defaults>

Lists the data collection modules executed by default.

=item B<  mrc>

Lists the multi-run collection modules.

=item B<  setup>

Lists the setup statuses.

=item B<  targets>

Lists the defined targets.

=back

=cut

sub status
{ my ($agt, @arg) = @_;
  my ($buf, $col, $opt, $sep, $sta);

  # Determine the list types
  $opt = RDA::Options::getopts('ACDMST', \@arg);
  foreach my $typ (@arg)
  { $typ = lc($typ);
    die get_string('BAD_STATUS', $typ) unless exists($tb_sta{$typ});
    $opt->{$tb_sta{$typ}} = 1;
  }

  # Produce requested lists
  $buf = q{};
  $sep = $SEP;
  $col = $agt->get_collector;
  $sta = $col->get_info('sta');
  $buf .= _stat_v($sta, 'A', $buf ? $sep : q{}) if exists($opt->{'A'});
  $buf .= _stat_s($sta, 'C', $buf ? $sep : q{}) if exists($opt->{'C'});
  $buf .= _stat_b($sta, 'D', $buf ? $sep : q{}) if exists($opt->{'D'});
  $buf .= _stat_b($sta, 'M', $buf ? $sep : q{}) if exists($opt->{'M'});
  $buf .= _stat_s($sta, 'S', $buf ? $sep : q{}) if exists($opt->{'S'});
  $buf .= _stat_t($col,      $buf ? $sep : q{}) if exists($opt->{'T'});

  # Produce default lists
  unless ($buf)
  { $buf .= _stat_s($sta, 'C', $buf ? $sep : q{});
    $buf .= _stat_b($sta, 'D', $buf ? $sep : q{});
    $buf .= _stat_b($sta, 'M', $buf ? $sep : q{});
    $buf .= _stat_t($col,      $buf ? $sep : q{});
  }

  # Display the report and indicate the completion status
  return $agt->submit(q{.}, RDA::Object::Message->new('DISPLAY.DSP_REPORT',
    page => 1)->add_data($buf));
}

# Produce flag-related lists
sub _stat_b
{ my ($sta, $typ, $sep) = @_;
  my ($buf, $nam);

  $buf = q{};
  $nam = $tb_itm{$typ};
  foreach my $mod ($sta->grep($nam, 'or'))
  { $buf .= join(q{|}, $mod, $sta->get_first("$mod.T_DSC", $mod)).$NL;
  }
  return ($buf)
    ? $sep.q{.M 2 '}.get_string('TtlSta'.$typ).q{'}.$NL.$buf.$NL
    : $sep._no_list('NoSta'.$typ);
}

# Produce status-related lists
sub _stat_s
{ my ($sta, $typ, $sep) = @_;
  my ($buf, $nam);

  $buf = q{};
  $nam = $tb_itm{$typ};
  foreach my $mod ($sta->grep($nam, 'or'))
  { $buf .= join(q{|}, $mod, $sta->get_first("$mod.$nam"),
      $sta->get_first("$mod.T_DSC", $mod)).$NL;
  }
  return ($buf)
    ? $sep.q{.M 3 '}.get_string('TtlSta'.$typ).q{'}.$NL.$buf.$NL
    : $sep._no_list('NoSta'.$typ);
}

# Produce target lists
sub _stat_t
{ my ($col, $sep) = @_;
  my ($buf, $def, %tgt);

  # Get all defined targets
  return $sep._no_list('NoStaT')
    unless ($def = $col->find('TARGET'));
  foreach my $tgt ($def->grep('T_TITLE', 'or'))
  { $tgt{$2}->{$1} = $def->get_first("$tgt.T_TITLE")
      if $tgt =~ m/\b(([A-Z]+)_\w+)$/;
  }

  # Produce the reports
  $buf = q{};
  foreach my $typ (sort keys(%tgt))
  { $buf .= $sep.q{.M 2 '}
      .get_string(exists($tb_tgt{$typ}) ? $tb_tgt{$typ} : 'TtlTgt', $typ)
      .q{'}.$NL;
    foreach my $nam (sort keys(%{$tgt{$typ}}))
    { $buf .= join(q{|}, $nam, $tgt{$typ}->{$nam}).$NL;
    }
    $buf .= $NL;
    $sep = $SEP;
  }
  return $buf
    ? $buf
    : $sep._no_list('NoStaT');
}

# Produce value-related lists
sub _stat_v
{ my ($sta, $typ, $sep) = @_;
  my ($buf, $nam);

  $buf = q{};
  $nam = $tb_itm{$typ};
  foreach my $mod ($sta->grep($nam, 'or'))
  { $buf .= join(q{|}, $sta->get_first("$mod.$nam"),
      $sta->get_first("$mod.T_DSC", $mod)).$NL;
  }
  return ($buf)
    ? $sep.q{.M 2 '}.get_string('TtlSta'.$typ).q{'}.$NL.$buf.$NL
    : $sep._no_list('NoSta'.$typ);
}

=head2 S<test [-d|-g grp,...] [-s section,...] module [arg...]>

This command executes a test module. It supports the following switches and
arguments:

=over 18

=item B<  -d>

When set, disables any transformation of the module name.

=item B<  -g grp,...>

Restricts the search to the specified groups.

=item B<  -s section,...>

Provides the comma-separated list of sections to execute. By default, it
executes the C<test> section only.

=item B<  module>

Test module name or abbreviation.

=item B<  arg>

Test module argument.

=back

=cut

sub test
{ my ($agt, @arg) = @_;
  my ($mod, $opt, $ret, $rsp, $trc);

  # Treat the options
  $opt = RDA::Options::getopts('dg*s*', \@arg);

  # Validate the module name
  die get_string('NO_TEST') unless ($mod = shift(@arg));
  unless (exists($opt->{'d'}))
  { ($mod, $trc) = ($2, $1) if $mod =~ $RE_TRC;
    $mod = $agt->get_content->get_module('TM', $opt->{'g'}, $mod)
  }

  # Execute the test
  $rsp = $agt->submit(q{.}, 'SDCL.RUN',
    args     => (scalar @arg) ? [@arg] : undef,
    package  => $mod,
    save     => 0,
    sections => exists($opt->{'s'}) ? $opt->{'s'} : 'test',
    trace    => $trc);

  # Indicate the completion status
  return defined($ret = $rsp->get_first('exit_only')) ? $ret : $rsp;
}

=head2 S<version [-ft] [-cpv|a|s]>

This command displays the version of the RDA components and previously loaded
Perl modules. The Perl module list is not exhaustive, since additional packages
can be loaded dynamically during the execution of other functions.

The following switches control this command:

=over 6

=item B<  -a > Displays all sections.

=item B<  -c > Displays RDA component versions.

=item B<  -f > Forces the load of RDA packages.

=item B<  -p > Displays the versions of the previously loaded Perl packages.

=item B<  -s > Displays the short version (default option).

=item B<  -t > Displays the RDA load errors.

=item B<  -v > Displays the RDA version.

=back

=cut

sub version  ## no critic (Complex)
{ my ($agt, @arg) = @_;
  my ($buf, $cfg, $dir, $frc, $opt, $pth, $trc, $ver);

  # Initialization
  $cfg = $agt->get_config;

  # Determine the list types
  $opt = RDA::Options::getopts('acfpstv', \@arg);
  $frc = 1 if $opt->{'f'};
  $trc = 1 if $opt->{'t'};

  # Extract the RDA version
  $buf = q{};
  if ($opt->{'s'}
    || !($opt->{'a'} || $opt->{'c'} || $opt->{'p'} || $opt->{'v'}))
  { $buf = $cfg->get_version.q{-}.$cfg->get_build.$NL;
    syswrite(STDOUT, $buf, length($buf));
    return 0;
  }
  $buf .= q{.M 2 'RDA }.$cfg->get_version.q{'}.$NL
    .get_string('Build').q{:|}.$cfg->get_build.$NL
    .get_string('Engine').q{:|}.$cfg->get_engine.$NL
    .get_string('Install').q{:|}.$cfg->get_info('typ').$NL
    .get_string('Rda').q{:|}.$cfg->native($cfg->get_group('D_RDA')).$NL
    .get_string('Work').q{:|}.$cfg->native($cfg->get_group('D_CWD')).$NL
    .get_string('Os').qq{:|$^O}.$NL.$NL.$SEP
    if $opt->{'a'} || $opt->{'v'};

  # Extract the version of the RDA components
  if ($opt->{'a'} || $opt->{'c'})
  { my ($ext, $inv, $lvl, $tbl);

    $buf .= q{.T '}.get_string('TtlComp').q{:'}.$NL;
    foreach my $grp (sort keys(%tb_ver))
    { $tbl = $tb_ver{$grp};
      $dir = $cfg->get_group($grp);
      $ext = $tbl->{'ext'};
      $inv = $tbl->{'inv'};
      $lvl = $tbl->{'lvl'};
      if (exists($tbl->{'dir'}))
      { foreach my $sub (@{$tbl->{'dir'}})
        { $buf .= _get_version($cfg, "[$grp]/$sub", $cfg->cat_dir($dir, $sub),
            $lvl, $ext, $inv);
        }
      }
      else
      { $buf .= _get_version($cfg, "[$grp]", $dir, $lvl, $ext, $inv);
      }
    }
    $buf .= $NL.$SEP;
  }

  # Display the version of already loaded Perl modules
  if ($opt->{'a'} || $opt->{'p'})
  { # Force Perl package load
    if ($frc)
    { $dir = $cfg->get_group('D_RDA_INC');
      foreach my $sub (@{$tb_ver{'D_RDA_INC'}->{'dir'}})
      { _load($agt, $cfg, $sub, $cfg->cat_dir($dir, $sub), $trc);
      }
    }

    # Display the package version
    $buf .= q{.M 3 '}.get_string('TtlLoaded').q{:'}.$NL;
    foreach my $mod (sort keys(%INC))
    { next unless defined($pth = $INC{$mod});
      $dir = RDA::Object::Rda->dirname($pth);
      $dir = q{.} unless $dir;
      next unless $mod =~ s/\.(pl|pm)$//;
      next unless $frc ## no critic (Unless)
        || $mod !~ m/^(?:Convert|I?RDA)\b/;
      $mod =~ s/[\\\/]/::/g;
      $ver = eval "\$$mod\::VERSION" || q{?};  ## no critic (Eval)
      $ver = sprintf('%d.%02d', $1, $2 || 0) if $ver =~ m/^(\d+)(?:\.(\d+))?$/;
      $buf .= qq{$mod|$ver|$dir\n};
    }
    $buf .= $NL.$SEP;
  }

  # Display the report and indicate the completion status
  return $agt->submit(q{.}, RDA::Object::Message->new('DISPLAY.DSP_REPORT',
    page => 1)->add_data($buf));
}

sub _get_version
{ my ($cfg, $txt, $dir, $lvl, $ext, $inv) = @_;
  my ($buf, $cnt, $fil, $ifh, @dir);

  $buf = q{};
  if (opendir(DIR, $dir))
  { # Treat current directory
    --$lvl;
    $ifh = IO::File->new;
    foreach my $nam (sort readdir(DIR))
    { next if $nam =~ m/^\./;
      $fil = $cfg->cat_file($dir, $nam);
      if (-d $fil)
      { push(@dir, $nam) if $lvl;
      }
      elsif (-f $fil && ($inv xor $nam =~ $ext) && $ifh->open("<$fil"))
      { $cnt = 20;
        while (<$ifh>)
        { if (m/\$Id\:\s+\S+\s+(\d+)(?:\.(\d+))?\s/)
          { $buf .= sprintf(qq{%s|%d.%02d\n}, $nam, $1, $2 || 0);
            last;
          }
          last unless --$cnt > 0;  ## no critic (Unless)
        }
        $ifh->close;
      }
    }
    closedir(DIR);
    $buf = qq{.M 2 '$txt:'}.$NL.$buf.$NL.$SEP if $buf;

    # Treat subdirectories
    foreach my $sub (@dir)
    { $buf .= _get_version($cfg, "$txt/$sub", $cfg->cat_dir($dir, $sub), $lvl,
        $ext, $inv);
    }
  }
  return $buf;
}

sub _load
{ my ($agt, $cfg, $cls, $dir, $trc) = @_;
  my ($fil, @dir);

  if (opendir(DIR, $dir))
  { # Treat current directory
    foreach my $nam (sort readdir(DIR))
    { next unless defined($nam = $cfg->is_path($nam))  ## no critic (Unless)
               && $nam !~ m/^\./;
      $fil = $cfg->cat_file($dir, $nam);
      if (-d $fil)
      { push(@dir, $nam);
      }
      elsif (-f $fil && $nam =~ s/\.pm$//i)
      { eval "require $cls\::$nam";
        $agt->add_error($@, "$cls\::$nam:") if $@ && $trc;
      }
    }
    closedir(DIR);

    # Treat subdirectories
    foreach my $sub (@dir)
    { _load($agt, $cfg, "$cls\::$sub", $cfg->cat_dir($dir, $sub), $trc);
    }
  }
  return;
}

=head2 S<xref [-a] [-g grp,...] bundles|mrc|profiles>

This command produces a cross-reference of the XML conversion bundle, multi-run
collection group, or setup profile definitions. It supports the following
switches:

=over 14

=item B<  -a>

Considers all bundles, multi-run collections, or profiles.

=item B<  -g grp,...>

Restricts profile analyzes to the specified groups.

=back

=head2 S<xref arg...>

This command produces a cross-reference of the configuration files or specified
packages. It supports the following arguments:

=over 26

=item B<  E<lt>bundlesE<gt>.cfg>

Analyzes the specified group conversion bundle file.

=item B<  E<lt>moduleE<gt>.cfg>

Analyzes the specified setup specifications.

=item B<  E<lt>moduleE<gt>.ctl>

Analyzes the specified data collection module.

=item B<  E<lt>moduleE<gt>.exe>

Analyzes the associated logic from the specified setup specifications.

=item B<  E<lt>mrcE<gt>.cfg>

Analyzes the specified multi-run collection group definition file.

=item B<  E<lt>profileE<gt>.cfg>

Analyzes the specified profile definition file.

=item B<  RDA::Object::E<lt>objectE<gt>>

Analyzes the SDCL interface of the specified RDA object.

=back

=cut

sub xref
{ my ($agt, @arg) = @_;
  my ($msg, $opt, $pth);

  # Treat the options
  $opt = RDA::Options::getopts('ag*', \@arg);

  # Treat the arguments
  foreach my $arg (@arg)
  { if ($arg =~ m/\bconvert.cfg/)
    { $agt->submit(q{.}, 'CONVERT.XREF',
        all        => $opt->{'a'},
        definition => $arg)->is_error($agt);
    }
    elsif ($arg =~ m/\bgroup.cfg/)
    { next
    }
    elsif ($arg =~ m/\bmrc.cfg/)
    { $agt->submit(q{.}, 'MRC.XREF',
        all        => $opt->{'a'},
        definition => $arg)->is_error($agt);
    }
    elsif ($arg =~ m/\bprofile.cfg/)
    { $agt->submit(q{.}, 'PROFILE.XREF',
        all        => $opt->{'a'},
        definition => $arg)->is_error($agt);
    }
    elsif ($arg =~ m/\.cfg$/i)
    { $agt->submit(q{.}, 'SDSL.XREF',
        package => $arg)->is_error($agt);
    }
    elsif ($arg =~ m/\.ctl$/i)
    { $agt->submit(q{.}, 'SDCL.XREF',
        package => $arg)->is_error($agt);
    }
    elsif ($arg =~ m/\.exe$/i)
    { $agt->submit(q{.}, 'SDSL.XREF',
        package => $arg,
        logic   => 1)->is_error($agt);
    }
    elsif ($arg =~ m/^RDA::(Object::|Target::)?[a-z]+$/i )
    { $agt->submit(q{.}, 'DISPLAY.DSP_API',
        package => $arg)->is_error($agt);
    }
    elsif ($arg eq 'bundles')
    { $agt->submit(q{.}, 'CONVERT.XREF',
        all    => $opt->{'a'},
        groups => $opt->{'g'})->is_error($agt);
    }
    elsif ($arg eq 'mrc')
    { $agt->submit(q{.}, 'MRC.XREF',
        all    => $opt->{'a'},
        groups => $opt->{'g'})->is_error($agt);
    }
    elsif ($arg eq 'profiles')
    { $agt->submit(q{.}, 'PROFILE.XREF',
        all    => $opt->{'a'},
        groups => $opt->{'g'})->is_error($agt);
    }
    else
    { die get_string('NO_XREF', $arg);
    }
  }

  # Indicate a successful completion
  return 0;
}

1;

__END__

=head1 SEE ALSO

L<RDA::Agent|RDA::Agent>,
L<RDA::Handle::Data|RDA::Handle::Data>,
L<RDA::Object|RDA::Object>,
L<RDA::Object::Collect|RDA::Object::Collect>,
L<RDA::Object::Content|RDA::Object::Content>,
L<RDA::Object::Display|RDA::Object::Display>,
L<RDA::Object::Extract|RDA::Object::Extract>,
L<RDA::Object::Item|RDA::Object::Item>,
L<RDA::Object::Message|RDA::Object::Message>,
L<RDA::Object::Rda|RDA::Object::Rda>,
L<RDA::Object::View|RDA::Object::View>,
L<RDA::Options|RDA::Options>,
L<RDA::Request::ASK|RDA::Request::ASK>,
L<RDA::Request::CONVERT|RDA::Request::CONVERT>,
L<RDA::Request::DISPLAY|RDA::Request::DISPLAY>,
L<RDA::Request::MRC|RDA::Request::MRC>,
L<RDA::Request::PACKAGE|RDA::Request::PACKAGE>,
L<RDA::Request::PROFILE|RDA::Request::PROFILE>,
L<RDA::Request::RDA|RDA::Request::RDA>,
L<RDA::Request::RENDER|RDA::Request::RENDER>,
L<RDA::Request::SDCL|RDA::Request::SDCL>,
L<RDA::Request::SDSL|RDA::Request::SDSL>,
L<RDA::SDCL::Block|RDA::SDCL::Block>,
L<RDA::SDSL::Module|RDA::SDSL::Module>,
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