# SDCL.pm: SDCL Command Library

package RDA::Request::SDCL;

# $Id: SDCL.pm,v 1.17 2015/07/09 08:14:03 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/Request/SDCL.pm,v 1.17 2015/07/09 08:14:03 RDA Exp $
#
# Change History
# 20150706  MSC  Improve the response handling.

=head1 NAME

RDA::Request::SDCL - SDCL Command Library

=head1 SYNOPSIS

 require RDA::Request::SDCL;

=head1 DESCRIPTION

The objects of the C<RDA::Request::SDCL> class are used to execute Support
Diagnostic Collection Language (SDCL) requests.

The following methods are available:

=cut

use strict;

BEGIN
{ use Exporter;
  use RDA::Text qw(get_string);
  use RDA::Handle::Data;
  use RDA::Object;
  use RDA::Object::Content qw(%TB_TRC);
  use RDA::Object::Message;
  use RDA::Object::Rda;
}

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

# Define the global private constants

# Define the global private variables
my %tb_cmd = (
  'SDCL.CHECK' => \&_do_check,
  'SDCL.RUN'   => \&_do_run,
  'SDCL.XREF'  => \&_do_xref,
  );

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

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

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

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

=for stopwords preload

=over 10

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

=item S<  B<'_cls'> > List of classes to preload

=item S<  B<'_lng'> > Reference to the language control object

=back

Internal keys are prefixed by an underscore.

=cut

sub new
{ my ($slf, $agt) = @_;
  my $cls = ref($slf) || $slf;

  # Create the library object
  $slf = bless {
    _agt => $agt,
    _cls => [qw(RDA::Object::Env
                RDA::Object::View
                RDA::Object::Rda
                RDA::Object::Target
                RDA::Object::Display
                RDA::Object::Pipe
                RDA::Object::Report
                RDA::Object::Toc
                RDA::Object::Collect
                RDA::Object::Windows)],
    _lng => $agt->get_lang('SDCL'),
    }, $cls;

  # Return the object reference
  return $slf;
}

=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));
}

=head1 SDCL COMMANDS

=head2 SDCL.CHECK - Check SDCL package command

This command checks a SDCL package. It supports the following attributes:

=over 11

=item B<  groups>

When present, restricts the package search to the specified groups.

=item B<  name>

Specifies the block name used when the code is provided as message data.

=item B<  package>

Specifies the package name or file to check.

=back

=cut

sub _do_check
{ my ($slf, $req) = @_;
  my ($nam, $obj);

  # Load the package to check it
  eval {
    # Load the package
    $obj = _load($slf, $req);

    # Remove the package
    $slf->{'_lng'}->remove_package($obj->get_oid);
  };

  # Provide the response
  return $req->reply($@, 'Check');
}

=head2 SDCL.RUN - Run SDCL package command

This command executes a SDCL package. It supports the following attributes:

=over 12

=item B<  args>

When present, specifies arguments to pass to the package.

=item B<  groups>

When present, restricts the package search to the specified groups.

=item B<  keep>

When true, makes the package persistent.

=item B<  name>

Specifies the block name used when the code is provided as message data.

=item B<  package>

Specifies the package name or file to execute.

=item B<  sections>

When present, restricts the code execution to the specified sections.

=item B<  save>

When true, saves the result set definition on completion (false by default).

=item B<  trace>

When present, specifies a package-specific trace level.

=back

=cut

sub _do_run
{ my ($slf, $req) = @_;
  my ($obj, $ref, $rsp, $trc);

  # Initialize and execute the test package
  eval {
    # Load the package
    $obj = _load($slf, $req, 1);

    # Adjust its trace level
    $obj->set_info('lvl', $trc)
      if defined($trc = $req->get_first('trace'))
      && ($trc = exists($TB_TRC{$trc})  ? $TB_TRC{$trc} :
                 ($trc =~ m/^\d*(\d)$/) ? $1 :
                                          0);

    # Execute the code
    eval {$obj->exec(get_string('ERR_RUN'),
      {arg => [$req->get_value('args')], req => $req},
      $req->get_value('sections'))};
    unless ($req->move_errors($@, $obj))
    { $ref = ref($rsp = $obj->get_info('val'));
      ($ref, $rsp) = (q{}, $rsp->as_string(q{}))
        if $ref && $ref ne 'RDA::Object::Message';
    }

    # Keep the package when requested
    if ($req->get_first('keep'))
    { $slf->{'_lng'}->keep_package($obj);
    }
    else
    { $slf->{'_lng'}->remove_package($obj);
    }

    # Save the configuration when requested
    $slf->{'_agt'}->get_collector->save if $req->get_first('save');
  };

  # Provide the response
  return
    $req->add_error($@)->has_errors ? $req->error('Run') :
    $ref                            ? $rsp :
                                      $req->new('OK.Run', last => $rsp);
}

=head2 SDCL.XREF - Cross reference command

This command produces a cross-reference of SDCL code. It supports the following
attributes:

=over 11

=item B<  groups>

When present, restricts the package search to the specified groups.

=item B<  name>

Specifies the block name used when the code is provided as message data.

=item B<  package>

Specifies the package name or file to analyze.

=back

=cut

sub _do_xref
{ my ($slf, $req) = @_;
  my ($buf, $obj);

  # Load the package and produce the cross-reference
  eval {
    # Load the package
    $obj = _load($slf, $req);

    # Produce the cross-reference
    $buf = $obj->xref;

    # Remove the package
    $slf->{'_lng'}->remove_package($obj->get_oid);
  };

  # Display the cross-reference
  return $req->add_error($@)->has_errors
    ? $req->error('Xref')
    : _display($slf, $req, 'OK.Xref', $buf);
}

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

# Display the result
sub _display
{ my ($slf, $req, $sta, $buf) = @_;
  my ($err, $msg);

  $msg = RDA::Object::Message->new('DISPLAY.DSP_REPORT',
    page => 1)->add_data($buf);
  return ($err = $slf->{'_agt'}->submit(q{.}, $msg)->is_error($req))
    ? $req->error($err)
    : $req->new($sta);
}

# Load the package
sub _load
{ my ($slf, $req, $flg) = @_;
  my ($bas, $cls, $dir, $grp, $ifh, $lng, $nam, $obj);

  $lng = $slf->{'_lng'};
  $cls = $slf->{'_cls'};
  if (defined($nam = $req->get_first('package')))
  { if ($nam =~ m/^(\w+):(\w+)(?:\.ctl)?$/)
    { ($grp, $nam) = ($1, $2);
      if ($nam  !~ m/^T[LM]\w+$/)
      { die get_string('BAD_TEST', $nam) if $flg;
        $cls = $lng->get_info('cls');
      }
      $obj = $lng->search_package($grp, $nam, $cls);
    }
    else
    { ($dir, $bas) = RDA::Object::Rda->parse_path($nam);
      if ($bas  !~ m/^(?:\w+\.)*T[LM]\w+$/)
      { die get_string('BAD_TEST', $nam) if $flg;
        $cls = $lng->get_info('cls');
      }
      $obj = $lng->load_file($bas, $dir,  $cls) ||
             $lng->load_file($nam, undef, $cls);
    }
  }
  elsif ($ifh = RDA::Handle::Data->new($req))
  { $nam = $req->get_first('name', '_sdcl_');
    $nam =~ s/\.(?:cfg|ctl)$//i;
    $obj = ($nam =~ m/^(\w+):((T[LM])?\w+)$/)
      ? $lng->load_data($ifh, $1, $2, $3 ? $cls : $lng->get_info('cls'))
      : $lng->load_data($ifh, $req->get_first('groups'), $nam, $cls);
  }
  die get_string('NO_CODE') unless $obj;

  # Return the package information
  return $obj;
}

1;

__END__

=head1 SEE ALSO

L<RDA::Agent|RDA::Agent>,
L<RDA::Driver::Collect|RDA::Driver::Collect>,
L<RDA::Error|RDA::Error>,
L<RDA::Handle::Data|RDA::Handle::Data>,
L<RDA::Language::SDCL|RDA::Language::SDCL>,
L<RDA::Object|RDA::Object>,
L<RDA::Object::Collect|RDA::Object::Collect>,
L<RDA::Object::Content|RDA::Object::Content>,
L<RDA::Object::Item|RDA::Object::Item>,
L<RDA::Object::Message|RDA::Object::Message>,
L<RDA::Object::Rda|RDA::Object::Rda>,
L<RDA::Request::DISPLAY|RDA::Request::DISPLAY>,
L<RDA::SDCL::Block|RDA::SDCL::Block>,
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