# Diaglet.pm: Diaglet Command Package

package RDA::UI::Diaglet;

# $Id: Diaglet.pm,v 1.14 2015/08/30 23:49:31 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/UI/Diaglet.pm,v 1.14 2015/08/30 23:49:31 RDA Exp $
#
# Change History
# 20150830  MSC  Improve the list command.

=head1 NAME

RDA::UI::Diaglet - Diaglet Command Package

=head1 SYNOPSIS

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

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

=head1 DESCRIPTION

The following commands are available:

=cut

use strict;

BEGIN
{ use Exporter;
  use RDA::Text qw(get_string);
  use RDA::Agent;
  use RDA::Handle::Data;
  use RDA::Object::Message;
  use RDA::Object::Rda;
  use RDA::Object::Xml;
  use RDA::Options;
}

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

# Define the global private constants

# Define the global private variables
my %tb_lst = (
  diaglet  => 'D',
  diaglets => 'D',
  pre      => 'A',
  post     => 'P',
  test     => 'T',
  tests    => 'T',
  );

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

=for stopwords iw

=head2 S<check [-iw] [-g grp,...] [-p prd,...] [-t typ,...] [-a|set ...]>

This command checks rule sets.

=head2 S<check [-iw] -d dir [-p prd,...] [-t typ,...] [-a|file ...]>

This command checks diaglets from the specified directory.

It supports the following switches and arguments:

=over 14

=item B<  -a>

Disables any restriction based on the operating system, the product codes, and
types. By default, it considers the rule sets or diaglets applicable to the
current operating system.

=item B<  -d dir>

Specifies the directory containing the diaglets.

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

Restricts the rule set search to the specified groups.

=item B<  -i>

Selects a rule set or a diaglet interactively.

=item B<  -w>

Reports warnings.

=item B<  file>

Specifies the name or the path of the diaglet to check.

=item B<  set>

Specifies the name or the path of the rule set to check.

=back

=cut

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

  # Treat the options
  $opt = RDA::Options::getopts('ad:g*ip*t*w', \@arg);
  $dsp = $agt->is_verbose;

  # Get the diaglet list
  unless (@arg)
  { $dsp->dsp_line($opt->{'d'}
      ? get_string('V_ScanDir', $opt->{'d'})
      : get_string('V_ScanSet'))
      if $dsp;
    $rsp = $agt->submit(q{.}, 'DIAGLET.LIST',
      all         => $opt->{'a'},
      description => $opt->{'i'},
      directory   => $opt->{'d'},
      groups      => $opt->{'g'},
      products    => $opt->{'p'},
      types       => $opt->{'t'},
      uid         => 1);
    $agt->abort if $rsp->is_error($agt, get_string('ERR_LIST'));
    @arg = _get_diaglet($agt, $rsp, $opt->{'i'}, 'NO_RULESET');
  }  # Text:NO_RULESET

  # Check the diaglet
  $cnt = 0;
  foreach my $arg (@arg)
  { $dsp->dsp_line(get_string('V_Check', $arg)) if $dsp;
    ++$cnt if $agt->submit(q{.}, 'DIAGLET.CHECK',
      diaglet   => $arg,
      directory => $opt->{'d'},
      groups    => $opt->{'g'},
      warnings  => $opt->{'w'})->is_error($agt, get_string('ERR_CHECK', $arg));
  }
  return 2 if $cnt;
  $dsp->dsp_line(get_string('V_NoIssues')) if $dsp;

  # Indicate a successful check
  return 0;
}

=head2 S<execute [-i] [-g grp,...] [-p prd,...] [-t typ,...] [-a|set ...]>

This command executes rule sets. You can restrict the interactive rule set
selection by specifying product codes and rule set types.

=cut

sub execute
{ my ($agt, @arg) = @_;
  my ($dsp, $opt, $rsp);

  # Treat the options
  $opt = RDA::Options::getopts('fg*ip*t*', \@arg);
  $dsp = $agt->is_verbose;

  # Get the diaglet list
  unless (@arg)
  { $dsp->dsp_line(get_string('V_ScanSet')) if $dsp;
    $rsp = $agt->submit(q{.}, 'DIAGLET.LIST',
      all         => $opt->{'a'},
      description => $opt->{'i'},
      groups      => $opt->{'g'},
      products    => $opt->{'p'},
      types       => $opt->{'t'},
      uid         => 1);
    $agt->abort if $rsp->is_error($agt, get_string('ERR_LIST'));
    @arg = _get_diaglet($agt, $rsp, $opt->{'i'}, 'NO_RULESET');
  }

  # Treat the diaglet files
  foreach my $arg (@arg)
  { $dsp->dsp_line(get_string('V_RuleSet', $arg)) if $dsp;
    $rsp = $agt->submit(q{.}, RDA::Object::Message->new('DIAGLET.RUN',
      diaglet => $arg,
      force   => $opt->{'f'},
      keep    => 1));
    $agt->abort if $rsp->is_error($agt, get_string('ERR_DIAGLET', "$arg.xml"));
  }

  # Indicate a successful completion
  return 0;
}

=head2 S<examine [-i] [-g grp,..] [-p prd,..] [-r tgt] [-t typ,..] [-a|set ...]>

This command executes rule sets. You can restrict the interactive rule set
selection by specifying product codes, rule set types, and a target type.

=cut

sub examine
{ my ($agt, @arg) = @_;
  my ($dsp, $opt, $rsp);

  # Treat the options
  $opt = RDA::Options::getopts('fg*ip*r:t*', \@arg);
  $dsp = $agt->is_verbose;

  # Get the diaglet list
  unless (@arg)
  { $dsp->dsp_line(get_string('V_ScanSet')) if $dsp;
    $rsp = $agt->submit(q{.}, 'DIAGLET.LIST',
      all         => $opt->{'a'},
      compliance  => 1,
      description => $opt->{'i'},
      groups      => $opt->{'g'},
      products    => $opt->{'p'},
      target      => $opt->{'r'},
      types       => $opt->{'t'},
      uid         => 1);
    $agt->abort if $rsp->is_error($agt, get_string('ERR_LIST'));
    @arg = _get_diaglet($agt, $rsp, $opt->{'i'}, 'NO_RULESET');
  }

  # Treat the diaglet files
  foreach my $arg (@arg)
  { $dsp->dsp_line(get_string('V_RuleSet', $arg)) if $dsp;
    $rsp = $agt->submit(q{.}, RDA::Object::Message->new('DIAGLET.RUN',
      diaglet => $arg,
      force   => $opt->{'f'},
      keep    => 1,
      target  => $opt->{'r'}));
    $agt->abort if $rsp->is_error($agt, get_string('ERR_DIAGLET', "$arg.xml"));
  }

  # Indicate a successful completion
  return 0;
}

=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<list [-c|-r typ] [-g grp,...] [-ADPT] [set ...]>

This command lists the available rule sets.

You can restrict the list by specifying following switches:

=over 7

=item B<  -A > Lists the pre-installation rule sets.

=item B<  -D > Lists the diaglets.

=item B<  -P > Lists the post-installation rule sets.

=item B<  -T > Lists the test rule sets.

=back

or following keywords:

=over 12

=item B<  pre>

Lists the pre-installation rule sets.

=item B<  diaglets>

Lists the diaglets.

=item B<  post>

Lists the post-installation rule sets.

=item B<  test>

Lists the test rule sets.

=back

=head2 S<list -d dir [-c|-r typ] -a>

This command lists all available diaglets.

=head2 S<list -d dir [-c|-r typ] [-p prd,...] [-t typ,...]>

This command lists the available diaglets for the current operating system. It
can be restricted to the specified products and/or types.

=cut

sub list
{ my ($agt, @arg) = @_;
  my ($all, $buf, $cnt, $grp, $oem, $opt, $rsp, $sep, $tgt);

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

  # Report the diaglet list
  if ($opt->{'d'})
  { # Get the diaglet list
    $rsp = $agt->submit(q{.}, 'DIAGLET.LIST',
      all         => $opt->{'a'},
      compliance  => $opt->{'c'},
      description => 1,
      directory   => $opt->{'d'},
      products    => $opt->{'p'},
      target      => $opt->{'r'},
      types       => $opt->{'t'});
    $agt->abort if $rsp->is_error($agt, get_string('ERR_LIST'));

    # Display the report and indicate the completion status
    return $agt->submit(q{.}, RDA::Object::Message->new('DISPLAY.DSP_REPORT',
      page => 1)->add_data(($buf = $rsp->get_data)
        ? q{.M 2 '}.get_string('Diaglets').qq{'\n}.$buf.qq{\n}
        : q{.T'}.get_string('NoDiaglets').qq{'\n}));
  }

  # Determine the list types
  $all = $opt->{'a'};
  $grp = $opt->{'g'};
  $oem = ($tgt = $opt->{'r'}) ? 1 : $opt->{'c'};
  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 = qq{.N1\n};
  $cnt = $agt->get_content;
  foreach my $typ (qw(A D P T))
  { $buf .= _list($cnt, $typ, $grp, $all, $oem, $tgt, $buf ? $sep : q{})
      if exists($opt->{$typ});
  }

  # Produce default lists
  unless ($buf)
  { foreach my $typ (qw(A P))
    { $buf .= _list($cnt, $typ, $grp, $all, $oem, $tgt, $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 rule set lists
sub _list
{ my ($cnt, $typ, $grp, $all, $oem, $tgt, $sep) = @_;
  my ($buf, $ctl);

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

  # Generate the report
  $buf = q{};
  foreach my $nam (sort {$ctl->{$a}->[0] cmp $ctl->{$b}->[0]} keys(%{$ctl}))
  { next if $ctl->{$nam}->[2] && !$all;
    if ($oem)
    { next unless defined($ctl->{$nam}->[3]);
      next if $tgt && $ctl->{$nam}->[3] ne $tgt;
    }
    $buf .= $ctl->{$nam}->[0].q{|}.$ctl->{$nam}->[1].qq{\n};
  }
  return $buf
    ? $sep.q{.M 2 '}.get_string('Ttl'.$typ).qq{'\n}.$buf.qq{\n}
    : $sep._no_list('No'.$typ);
}

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

  return q{.T'}.get_string($txt).qq{'\n};
}

=head2 S<man [-i] [-g grp,...] [-p prd,...] [-t typ,...] [-a|set ...]>

This command generates a report containing the rule set documentation.

=head2 S<man [-i] [-d dir] [-p prd,...] [-t typ,...] [-a|file ...]>

This command generates a report containing the diaglet documentation.

You can restrict the interactive diaglet selection by specifying product codes
and rule set types.

=cut

sub man
{ my ($agt, @arg) = @_;
  my ($dsp, $opt, $pth, $rsp);

  # Treat the options
  $opt = RDA::Options::getopts('ad:g*ip*t*', \@arg);
  $dsp = $agt->is_verbose;

  # Get the diaglet list
  unless (@arg)
  { $dsp->dsp_line($opt->{'d'}
      ? get_string('V_ScanDir', $opt->{'d'})
      : get_string('V_ScanSet'))
      if $dsp;
    $rsp = $agt->submit(q{.}, 'DIAGLET.LIST',
      all         => $opt->{'a'},
      description => $opt->{'i'},
      directory   => $opt->{'d'},
      groups      => $opt->{'g'},
      products    => $opt->{'p'},
      types       => $opt->{'t'},
      uid         => 1);
    $agt->abort if $rsp->is_error($agt, get_string('ERR_LIST'));
    @arg = _get_diaglet($agt, $rsp, $opt->{'i'}, 'NO_RULESET');
  }

  # Generate the documentation
  foreach my $arg (@arg)
  { $dsp->dsp_line(get_string('V_Man', $arg)) if $dsp;
    $rsp = $agt->submit(q{.}, 'DIAGLET.MAN',
      diaglet   => $arg,
      directory => $opt->{'d'},
      keep      => 1);
    $agt->abort if $rsp->is_error($agt, get_string('ERR_DIAGLET', $arg));
    $dsp->dsp_line(get_string('V_ManPage', $pth))
      if $dsp && defined($pth = $rsp->get_first('man'));
  }

  # Indicate a successful completion
  return 0;
}

=head2 S<meta [-i] [-g grp,...] [-p prd,...] [-r tgt] [-t typ,...] [-a|set ...]>

This command generates a report containing the rule set compliance metadata.

=head2 S<meta [-i] [-d dir] [-p prd,...] [-r tgt] [-t typ,...] [-a|file ...]>

This command generates a report containing the diaglet compliance metadata.

You can restrict the interactive diaglet selection by specifying product codes,
rule set types, and target type.

=cut

sub meta
{ my ($agt, @arg) = @_;
  my ($dsp, $opt, $pth, $rsp);

  # Treat the options
  $opt = RDA::Options::getopts('ad:g*ip*r:t*', \@arg);
  $dsp = $agt->is_verbose;

  # Get the diaglet list
  unless (@arg)
  { $dsp->dsp_line($opt->{'d'}
      ? get_string('V_ScanDir', $opt->{'d'})
      : get_string('V_ScanSet'))
      if $dsp;
    $rsp = $agt->submit(q{.}, 'DIAGLET.LIST',
      all         => $opt->{'a'},
      compliance  => 1,
      description => $opt->{'i'},
      directory   => $opt->{'d'},
      groups      => $opt->{'g'},
      products    => $opt->{'p'},
      target      => $opt->{'r'},
      types       => $opt->{'t'},
      uid         => 1);
    $agt->abort if $rsp->is_error($agt, get_string('ERR_LIST'));
    @arg = _get_diaglet($agt, $rsp, $opt->{'i'}, 'NO_RULESET');
  }

  # Generate the documentation
  foreach my $arg (@arg)
  { $dsp->dsp_line(get_string('V_Man', $arg)) if $dsp;
    $rsp = $agt->submit(q{.}, 'DIAGLET.META',
      diaglet   => $arg,
      directory => $opt->{'d'},
      target    => $opt->{'r'},
      keep      => 1);
    $agt->abort if $rsp->is_error($agt, get_string('ERR_DIAGLET', $arg));
    $dsp->dsp_line(get_string('V_ManPage', $pth))
      if $dsp && defined($pth = $rsp->get_first('man'));
  }

  # Indicate a successful completion
  return 0;
}

=head2 S<run [-d dir] [-p prd,...] [-t typ,...] [-a|file ...]>

This command executes diaglet files.

=cut

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

  # Treat the options
  $opt = RDA::Options::getopts('ad:fip*t*', \@arg);
  $dir = exists($opt->{'d'}) ? $opt->{'d'} : RDA::Object::Rda->current_dir;
  $dsp = $agt->is_verbose;

  # Get the diaglet list
  unless (@arg)
  { $dsp->dsp_line(get_string('V_ScanDir', $dir)) if $dsp;
    $rsp =  $agt->submit(q{.}, 'DIAGLET.LIST',
      all         => $opt->{'a'},
      description => $opt->{'i'},
      directory   => $dir,
      product     => $opt->{'p'},
      type        => $opt->{'t'},
      uid         => 1);
    $agt->abort if $rsp->is_error($agt, get_string('ERR_LIST'));
    @arg = _get_diaglet($agt, $rsp, $opt->{'i'}, 'NO_RULESET');
  }

  # Treat the diaglet files
  foreach my $arg (@arg)
  { $dsp->dsp_line(get_string('V_Diaglet', $arg)) if $dsp;
    $rsp = $agt->submit(q{.}, 'DIAGLET.RUN',
      diaglet   => $arg,
      directory => $dir,
      force     => $opt->{'f'});
    $agt->abort if $rsp->is_error($agt, get_string('ERR_DIAGLET', $arg));
  }

  # Indicate a successful completion
  return 0;
}

=head2 S<version [-i] [-g grp,...] [-p prd,...] [-t typ,...] [-a|set ...]>

This command displays the version information contained in the rule set.

=head2 S<version [-i] [-d dir] [-p prd,...] [-t typ,...] [-a|file ...]>

This command displays the version information contained in the diaglet.

You can restrict the interactive diaglet selection by specifying product codes
and rule set types.

=cut

sub version
{ my ($agt, @arg) = @_;
  my ($dat, $dsp, $opt, $rsp, @tbl);

  # Treat the options
  $opt = RDA::Options::getopts('ad:g*ip*t*', \@arg);
  $dsp = $agt->is_verbose;

  # Get the diaglet list
  unless (@arg)
  { $dsp->dsp_line($opt->{'d'}
      ? get_string('V_ScanDir', $opt->{'d'})
      : get_string('V_ScanSet'))
      if $dsp;
    $rsp =  $agt->submit(q{.}, 'DIAGLET.LIST',
      all         => $opt->{'a'},
      description => $opt->{'i'},
      directory   => $opt->{'d'},
      groups      => $opt->{'g'},
      products    => $opt->{'p'},
      types       => $opt->{'t'},
      uid         => 1);
    $agt->abort if $rsp->is_error($agt, get_string('ERR_LIST'));
    @arg = _get_diaglet($agt, $rsp, $opt->{'i'}, 'NO_RULESET');
  }

  # Extract the versions
  foreach my $arg (@arg)
  { $dsp->dsp_line(get_string('V_Version', $arg)) if $dsp;
    $rsp = $agt->submit(q{.}, 'DIAGLET.VERSION',
      diaglet   => $arg,
      directory => $opt->{'d'});
    if (@{$dat = $rsp->is_error($agt) ? [] : $rsp->get_data})
    { push(@tbl, @{$dat});
    }
    else
    { push(@tbl, "$arg.xml");
    }
  }

  # Display the versions
  return $agt->submit(q{.}, RDA::Object::Message->new('DISPLAY.DSP_DATA',
    page => 1)->add_data([@tbl])) if @tbl;

  # Indicate a successful completion
  return 0;
}

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

# Select a diaglet
sub _get_diaglet
{ my ($agt, $rsp, $ask, $err) = @_;
  my ($ifh, @tbl);

  # Return all diaglets when not in interactive mode
  return ($rsp->get_value('sets')) unless $ask;

  # Abort when no list is available
  if ($ifh = RDA::Handle::Data->new($rsp))
  { @tbl = $ifh->getlines;
    $ifh->close;
  }
  die get_string($err) unless @tbl;

  # Select the diaglet
  return ($agt->submit(q{.}, 'ASK.SELECT',
    items     => [@tbl],
    separator => q{\|},
    title     => get_string('SelectDiaglet'),
    )->get_value('item'));
}

1;

__END__

=head1 SEE ALSO

L<RDA::Agent|RDA::Agent>,
L<RDA::Handle::Data|RDA::Handle::Data>,
L<RDA::Object::Content|RDA::Object::Content>,
L<RDA::Object::Message|RDA::Object::Message>,
L<RDA::Object::Rda|RDA::Object::Rda>,
L<RDA::Object::Xml|RDA::Object::Xml>,
L<RDA::Options|RDA::Options>,
L<RDA::Request::ASK|RDA::Request::ASK>,
L<RDA::Request::DIAGLET|RDA::Request::DIAGLET>,
L<RDA::Request::DISPLAY|RDA::Request::DISPLAY>,
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