# RDA.pm: RDA Command Library

package RDA::Request::RDA;

# $Id: RDA.pm,v 1.20 2015/04/29 13:52:06 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/Request/RDA.pm,v 1.20 2015/04/29 13:52:06 RDA Exp $
#
# Change History
# 20150424  MSC  Introduce the control agent concept.

=head1 NAME

RDA::Request::RDA - RDA Command Library

=head1 SYNOPSIS

 require RDA::Request::RDA;

=head1 DESCRIPTION

The objects of the C<RDA::Request::RDA> class are used to interface with a RDA
collector.

The following methods are available:

=cut

use strict;

BEGIN
{ use Exporter;
  use IO::File;
  use RDA::Text qw(get_string);
  use RDA::Agent;
  use RDA::Object;
  use RDA::Object::Access qw(check_dsn check_sid norm_credential);
  use RDA::Object::Collect;
  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.20 $ =~ /(\d+)\.(\d+)/);
@ISA     = qw(Exporter);

# Define the global private constants
my $CLS = [qw(RDA::Object::Collect
              RDA::Object::Env
              RDA::Object::Item
              RDA::Object::Rda
              RDA::Object::Target
              RDA::Object::View
              RDA::Object::Windows)];

# Define the global private variables
my %tb_cmd = (
  'RDA.AUTHENTICATE' => \&_do_authen,
  'RDA.CHECK'        => \&_do_check,
  'RDA.COLLECT'      => \&_do_collect,
  'RDA.DELETE'       => \&_do_delete,
  'RDA.HALT'         => \&_do_halt,
  'RDA.KILL'         => \&_do_kill,
  'RDA.POST'         => \&_do_post,
  'RDA.REFRESH'      => \&_do_refresh,
  'RDA.RUN'          => \&_do_run,
  'RDA.SAMPLE'       => \&_do_sample,
  'RDA.SAVE'         => \&_do_save,
  'RDA.SETUP'        => \&_do_setup,
  'RDA.START'        => \&_do_start,
  );

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

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

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

C<RDA::Request::RDA> 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<'_dir'> > Collect directory structure

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

=item S<  B<'_get'> > Reference to the item accessible by the SDCL interface

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

=item S<  B<'_set'> > Reference to the item modifiable by the SDCL interface

=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,
    _dir => $cfg->get_group('D_RDA_COL'),
    _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 RDA.AUTHENTICATE - Authenticate command

This command stores user authentication in the context definition. It supports
the following attributes:

=over 12

=item B<  action>

Specifies the authentication action: C<add> or C<delete>.

=item B<  password>

Specifies the user password.

=item B<  type>

Specifies the user type.

=item B<  user>

Specifies the user name.

=back

=cut

sub _do_authen
{ my ($slf, $req) = @_;
  my ($act, $col, $def, $dsp, $grp, $key, $pwd, $sid, $usr);

  eval {
    # Validate the user name
    die get_string('NO_USER')
      unless length($usr = $req->get_first('user', q{}));

    # Treat the action
    $act = lc($req->get_first('action',q{}));
    $col = $slf->{'_agt'}->get_collector;
    $def = $col->find('ACCESS', 1);
    $dsp = $slf->{'_dsp'};
    if ($act eq 'add')
    { $dsp->dsp_line(get_string('V_AddAuthen', $usr)) if $dsp;
      ($grp, $key, $usr, $sid) =
        _get_authen($slf, $def, $usr, $req->get_value('type'));
      $pwd = $req->get_first('password');
      $pwd = $col->get_access->ask_password(get_string('Password', $usr))
        unless defined($pwd);
      $pwd = pack('u', $pwd);
      chomp($pwd);
      $def->set_value("$grp.T_USR_$key", $usr);
      $def->set_value("$grp.T_SID_$key", $sid) if length($sid);
      $def->set_value("$grp.T_CRD_$key", $pwd);
    }
    elsif ($act eq 'delete')
    { $dsp->dsp_line(get_string('V_AddAuthen', $usr)) if $dsp;
      ($grp, $key) = _get_authen($slf, $def, $usr, $req->get_value('type'));
      $def->set_value("$grp.T_USR_$key");
      $def->set_value("$grp.T_SID_$key");
      $def->set_value("$grp.T_CRD_$key");
    }
    else
    { die get_string('BAD_AUTHEN', $act);
    }
    };

  # Indicate the completion status
  return $req->reply($@, 'Authen');
}

sub _get_authen
{ my ($slf, $def, $usr, @typ) = @_;
  my ($num, $grp, $ref, $sid, $typ);

  # Derive some types
  $sid = q{};
  if ($usr =~ m/^(\w+)(\@oracle|\@\+)?\@([\+\w]+(\.[\w\-]+)*)$/i ||
      $usr =~
        m/^(\w+)(\@oracle|\@\+)?\@([\w\.\-]+:\d+:([\+\.\w]*:)?[\+\.\w]+)$/i)
  { $usr = uc($1);
    $sid = check_sid($3);
    @typ = ('ORACLE');
  }
  elsif ($usr =~ m/^(\w+)\@(odbc|\-)\@(.+)$/i)
  { $usr = uc($1);
    $sid = check_dsn($3);
    @typ = ('ODBC');
  }
  elsif ($usr =~ m/^(\w+)\@([a-z][a-z\d]*)\@(.+)$/i && lc($2) ne 'oracle')
  { ($typ, $sid, $usr) = norm_credential($2, $3, $1);
    @typ = ($typ);
  }
  elsif (!@typ)
  { $usr = uc($usr);
    @typ = ('ORACLE');
  }
  elsif (uc($typ[0]) eq 'DB')
  { $usr = uc($usr);
    @typ = (defined($typ[1]) ? $typ[1] : 'ORACLE')
  }
  elsif (uc($typ[0]) eq 'PSEUDO')
  { ($typ, $sid, $usr) = norm_credential('pseudo', $typ[1], $usr);
    @typ = ($typ);
  }

  # Search if it already exists
  $def = $def->find($grp = uc(join(q{.}, @typ)), 1);
  foreach my $key ($def->grep('^T_USR_\d+$'))
  { return ($grp, substr($key, 6), $usr, $sid)
      if $usr eq $def->get_first($key)
      && $sid eq $def->get_first('T_SID_'.substr($key,6), q{});
  }

  # Determine its identifier
  $num = unpack('%32C*', $usr);
  do
  { $ref = sprintf('%06d', $num++);
  } while $def->is_defined('T_USR_'.$ref);
  return ($grp, $ref, $usr, $sid);
}

=head2 RDA.CHECK - Check group command

This command checks a group file. It supports the following attribute:

=over 14

=item B<  definition>

Specifies the group configuration file to check.

=back

=cut

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

  # Validate the attribute
  return $req->error('NoDefinition')
    unless defined($pth = $req->get_first('definition'));

  # Check the requested file

  # Return the completion status
  return $req->reply($@, 'Check');
}

=head2 RDA.COLLECT - Data collection execution command

This command executes data collection modules. It supports the following
attributes:

=over 12

=item B<  groups>

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

=item B<  modules>

Specifies the list of data collection modules to collect (all configured
modules by default). It accepts module abbreviations and module names.

=item B<  pending>

When true, limits the default data collection to pending modules.

=item B<  profiles>

When present, specifies one or more profiles to use.

=item B<  save>

Allows to overwrite the incremental save indicator.

=back

=cut

sub _do_collect
{ my ($slf, $req) = @_;
  my ($agt, $cnt, $col, $dsp, $grp, $nam, $prf, $sav, @tbl);

  $cnt = 0;
  $agt = $slf->{'_agt'};
  $dsp = $slf->{'_dsp'};
  $dsp->dsp_line(get_string('V_Collect')) if $dsp;

  eval {
    # Get the collection description
    $col = $agt->get_collector;

    # Specify the setting level
    $col->set_degree($nam) if defined($nam = $req->get_first('degree'));

    # Specify a new setup profile
    $grp = $req->get_value('groups');
    if (@tbl = $req->get_value('profiles'))
    { $prf = $agt->get_library('PROFILE')->merge($grp, @tbl);
      $col->set_profile($prf);

      # Add the profile modules to the setup queue and execute pending requests
      @tbl = $prf->get_modules(1);
      $col->add_setup($grp, 1, 0, @tbl);
      $col->end_setup($sav);

      # Add the profile modules to the collection queue
      $col->add_collect($grp, @tbl);
    }

    # Identify the data collection requests
    $sav = $req->get_first('save');
    if (@tbl = $req->get_value('modules'))
    { # Execute the pending setup requests
      $col->add_setup($grp, 1, 0, @tbl);
      $col->end_setup($sav);

      # Queue the specified data collections
      $col->add_collect($grp, @tbl);
    }
    else
    { # Execute pending requests
      $col->end_setup($sav);

      # Queue the specified data collections
      unless ($prf)
      { if ($req->get_first('pending'))
        { $col->add_collect($grp, $col->get_pending);
        }
        else
        { $col->add_collect($grp, $col->get_enabled);
        }
      }
    }

    # Execute the data collection
    $cnt = $col->end_collect($sav);
    $dsp->dsp_line(get_string('VI_NoCollect')) if $dsp && $cnt == 0;
    };

  # Indicate the completion status
  return $req->reply($@, 'Collect', count => $cnt);
}

=head2 RDA.DELETE - Data collection module deletion command

This command deletes data collection modules. It supports the following
attributes:

=over 11

=item B<  groups>

When present, restricts the data collection module search to the specified
groups.

=item B<  modules>

Specifies the list of data collection module configurations to delete (none
by default). It accepts module abbreviations and module names.

=item B<  save>

Allows to overwrite the incremental save indicator.

=back

=cut

sub _do_delete
{ my ($slf, $req) = @_;
  my ($cnt, $col, $grp, $sav);

  $cnt = 0;
  $slf->{'_dsp'}->dsp_line(get_string('V_DelModule')) if $slf->{'_dsp'};

  eval {
    # Get the collection description
    $col = $slf->{'_agt'}->get_collector;

    # Delete the module configurations
    $grp = $req->get_value('groups');
    $sav = $req->get_first('save');
    foreach my $mod ($req->get_value('modules'))
    { $cnt += $col->delete_module($req, $grp, $mod, $sav);
    }
    };

  # Indicate the completion status
  return $req->reply($@, 'Delete', count => $cnt);
}

=head2 RDA.HALT - Halt command

This command halts the background collection.

=cut

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

  $slf->{'_dsp'}->dsp_line(get_string('V_Halt')) if $slf->{'_dsp'};
  eval {_get_daemon($slf)->halt_bgnd};

  # Indicate the completion status
  return $req->reply($@, 'Halt');
}

=head2 RDA.KILL - Kill command

This command kills the background collection.

=cut

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

  $slf->{'_dsp'}->dsp_line(get_string('V_Kill')) if $slf->{'_dsp'};
  eval {_get_daemon($slf)->kill_bgnd};

  # Indicate the completion status
  return $req->reply($@, 'Kill');
}

=head2 RDA.POST - Post treatment execution command

This command executes a post treatment. It supports the following attributes:

=over 8

=item B<  type>

Specifies the type of the post treatment.

=item B<  save>

Allows to overwrite the incremental save indicator.

=back

=cut

sub _do_post
{ my ($slf, $req) = @_;
  my ($cnt, $typ);

  return $req->error('NoType')
    unless defined($typ = $req->get_first('type')) && length($typ);
  $slf->{'_dsp'}->dsp_line(get_string('V_Post', $typ)) if $slf->{'_dsp'};

  eval {
    $cnt = $slf->{'_agt'}->get_collector->post($typ, $req->get_first('save'));
    };

  # Indicate the completion status
  return $req->reply($@, 'Post', count => $cnt);
}

=head2 RDA.REFRESH - Collector refresh command

This command refreshes the collection definition by using the original start
scenario. It supports the following attributes:

=for stopwords desc

=over 11

=item B<  collector>

When true, reruns the collector setup.

=item B<  degree>

Specifies a new setting level.

=item B<  desc>

Specifies a collection description.

=item B<  save>

Allows to overwrite the incremental save indicator.

=item B<  setup>

When true, forces the collector setup.

=back

=cut

sub _do_refresh
{ my ($slf, $req) = @_;
  my ($agt, $col, $def, $lvl, $nam, $obj, $sav, $set);

  $agt = $slf->{'_agt'};
  $lvl = $slf->{'_lvl'};
  eval {
    # Initialize the collector
    $col = $agt->get_collector($req->get_first('force'));
    die get_string('IS_NEW', $col->get_oid) if $col->is_new;
    $slf->{'_dsp'}->dsp_line(get_string('V_Refresh', $col->get_oid))
      if $slf->{'_dsp'};

    # Set up the collector
    $slf->{'_get'} = $def = $col->get_definition;
    $set = $def->find('CONFIG', 1);
    $set->set_value('T_DESCRIPTION', $req->get_first('desc'),
      'Start scenario description');
    $col->create->set_degree($req->get_first('degree', 0));
    if ($req->get_first('collector')
      && ($obj = $agt->get_lang('SDSL')->load_package('RDA:COLsetup')))
    { $obj->request($agt->get_run->find('CONTEXT', 1), $lvl % 10);
      $obj->delete_object;
    }

    # Execute the start scenario
    if (($nam = $set->get_first('M_START')) &&
        ($obj = $agt->get_lang('SDCL')->search_package([], $nam, $CLS)))
    { $slf->{'_set'} = $set = $def->find('START', 1);
      $obj->set_info('aux', $slf);
      $obj->exec(get_string('ERR_RUN'), undef, 'refresh');
      $set->set_value('G_RUN', time, 'Start execution date/time');
    }

    # Force the setup
    $col->end_setup(0) if $req->get_first('setup');

    # Save the setup
    $sav = $req->get_first('save');
    $col->save if defined($sav) ? $sav : $col->should_save;
    };
  delete($slf->{'_get'});
  delete($slf->{'_set'});

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

=head2 RDA.RUN - Tool execution command

This command executes a tool. It supports the following attributes:

=over 12

=item B<  args>

Specifies arguments to pass to the tool.

=item B<  groups>

When specified, restricts the tool module search to the specified groups.

=item B<  sections>

When present, restricts the code execution to the specified sections (C<tool>
by default).

=item B<  tool>

Specifies the tool name or abbreviation.

=back

=cut

sub _do_run
{ my ($slf, $req) = @_;
  my ($grp, $mod, $rsp);

  die get_string('NO_TOOL')
    unless defined($mod = $req->get_first('tool'));
  $slf->{'_dsp'}->dsp_line(get_string('V_Run', $mod)) if $slf->{'_dsp'};

  eval {
    $grp = $req->get_value('groups');
    $rsp = $slf->{'_agt'}->get_collector->run($req, $grp, $mod,
      [$req->get_value('args')], $req->get_value('sections', 'tool'));
    };

  # Indicate the completion status
  return $rsp || $req->error('Run', $@);
}

=head2 RDA.SAMPLE - Sample command

This command starts a background collection. It supports the following
attributes:

=over 11

=item B<  force>

When set, halts the background collection.

=item B<  groups>

When specified, restricts the sampling module search to the specified groups.

=item B<  modules>

Specifies the list of modules to sample.

=item B<  output>

Specifies the output file (the null device by default).

=back

=cut

sub _do_sample
{ my ($slf, $req) = @_;
  my ($col, $drv, $dsp, $grp, $ret, @mod);

  eval {
    $col = $slf->{'_agt'}->get_collector;
    $dsp = $slf->{'_dsp'};
    @mod = $col->get_value('SAMPLE.M_MODULES')
      unless (@mod = $req->get_value('modules'));

    if (@mod)
    { $dsp->dsp_line(get_string('V_Sample')) if $dsp;

      # Ensure that the sampling modules are configured
      $grp = $req->get_value('groups');
      $col->add_setup($grp, 1, 0, @mod);
      $col->end_setup;
      #$col->save;

      # Start the background collection
      $drv = _get_daemon($slf);
      $ret = $drv->run_bgnd($req->get_first('output',
        RDA::Object::Rda->dev_null), $grp, @mod);
      if ($ret == 0)
      { # Don't save the setup in the launcher
        $slf->{'_agt'}->set_info('sav', 0);

        # When forced, try to halt it
        if ($req->get_first('force'))
        { $dsp->dsp_line(get_string('V_Halt')) if $dsp;
          sleep(1);
          $drv->halt_bgnd;
        }
      }
    }
    };

  # Indicate the completion status
  return $req->reply($@, 'Sample');
}

sub _get_daemon
{ my ($slf) = @_;

  unless (exists($slf->{'_drv'}))
  { # Create the daemon driver object on first use
    eval {
      require RDA::Driver::Daemon;
      $slf->{'_drv'} = RDA::Driver::Daemon->new($slf->{'_agt'});
      };
    $slf->{'_agt'}->abort($@, get_string('ERR_DAEMON')) if $@;
  }
  return $slf->{'_drv'};
}

=head2 RDA.SAVE - Save command

This command saves the result set definition unless they have not been loaded.

=cut

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

  $slf->{'_dsp'}->dsp_line(get_string('V_Save')) if $slf->{'_dsp'};

  # Save the result set definition
  eval {$slf->{'_agt'}->get_collector->save};

  # Indicate the completion status
  return $req->reply($@, 'Save');
}

=head2 RDA.SETUP - Data collection setup command

This command performs data collection setup. It supports the following
attributes:

=over 13

=item B<  collector>

When true, reruns the collector setup.

=item B<  degree>

When present, specifies a new setting level. It is saved for future setup
operations.

=item B<  display>

Controls when the packaging text must be displayed (true by default).

=item B<  force>

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

=item B<  groups>

When specified, restricts the data collection module search to the specified
groups.

=item B<  modules>

Specifies the list of data collection modules to configuration (all
unconfigured modules by default). It accepts module abbreviations and module
names.

=item B<  profiles>

When present, specifies one or more profiles to use.

=item B<  save>

Allows to overwrite the incremental save indicator.

=back

=cut

sub _do_setup  ## no critic (Complex)
{ my ($slf, $req) = @_;
  my ($agt, $cnt, $col, $dsp, $flg, $grp, $lvl, $obj, $prf, $sav, @tbl);

  $cnt = $flg = 0;
  $agt = $slf->{'_agt'};
  $dsp = $slf->{'_dsp'};
  $dsp->dsp_line(get_string('V_Setup')) if $dsp;

  eval {
    # Get the collection description
    $col = $agt->get_collector;

    # Specify a new setting level
    $col->set_degree($lvl) if defined($lvl = $req->get_first('degree'));

    # Rerun collector setup when requested
    $sav = $req->get_first('save');
    if ($req->get_first('collector'))
    { $flg = 1;
      if (!$col->is_new
        && ($obj = $agt->get_lang('SDSL')->load_package('RDA:COLsetup')))
      { $obj->request($agt->get_run->find('CONTEXT', 1), $slf->{'_lvl'} % 10);
        $obj->delete_object;
        $col->save if defined($sav) ? $sav : $col->should_save;
      }
    }

    # Specify a new setup profile
    $grp = $req->get_value('groups');
    if (@tbl = $req->get_value('profiles'))
    { $prf = $agt->get_library('PROFILE')->merge($grp, @tbl);
      $col->set_profile($prf);
      $col->add_setup($grp, 1, 1, $prf->get_modules(1));
    }

    # Identify new setup requests
    if ($req->is_defined('modules'))
    { $col->add_setup($grp, 1, 1, $req->get_value('modules'));
    }
    elsif (!$prf)
    { @tbl = $col->get_content->get_modules('DC')
        unless (@tbl = $col->get_profile) || $flg;
      $col->add_setup($grp, 0, $req->get_first('force'), @tbl) if @tbl;
    }

    # Treat the pending requests
    $cnt += $col->end_setup($sav);
    if ($cnt)
    { # Display the setup text
      $req->abort
        if $dsp
        && $req->get_first('display', $col->get_first('DEFAULT.B_TEXT', 1) &&
             !$req->is_defined('modules','profiles'))
        && $slf->{'_agt'}->submit(q{.}, 'DISPLAY.DSP_TEXT',
             name => RDA::Object::Rda->is_cygwin  ? 'Setup/Windows' :
                     RDA::Object::Rda->is_vms     ? 'Setup/VMS' :
                     RDA::Object::Rda->is_windows ? 'Setup/Windows' :
                                                    'Setup',
             )->is_error($req);
    }
    elsif ($dsp)
    { $dsp->dsp_line(get_string('VI_NoSetup'));
    }
    };

  # Indicate the completion status
  return $req->reply($@, 'Setup', count => $cnt);
}

=head2 RDA.START - Collection creation command

This command creates a collection by executing a start scenario. It supports
the following attributes:

=over 11

=item B<  args>

Specifies optional arguments.

=item B<  degree>

Specifies a new setting level.

=item B<  desc>

Specifies a collection description.

=item B<  force>

When true, forces the scenario execution even when the collection already
exists.

=item B<  groups>

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

=item B<  package>

Specifies the start scenario.

=item B<  profiles>

When present, specifies one or more profiles to use.

=item B<  save>

Allows to overwrite the incremental save indicator.

=item B<  setup>

When true, forces the collector setup.

=back

=cut

sub _do_start
{ my ($slf, $req) = @_;
  my ($agt, $col, $def, $grp, $lng, $lvl, $nam, $obj, $oid, $prf, $sav, $set,
      @tbl);

  $agt = $slf->{'_agt'};
  $lng = $agt->get_lang('SDCL');
  $lvl = $slf->{'_lvl'};
  eval {
    # Initialize the collector
    $col = $agt->get_collector($req->get_first('force'));
    $def = $col->get_definition;
    $grp = $req->get_value('groups');
    if (($nam = $req->get_first('package')) &&
        ($obj = $lng->search_package($grp, $nam, $CLS)))
    { $slf->{'_get'} = $def;

      # Execute the relocate section of the start script
      $obj->set_info('aux', $slf);
      $obj->exec(get_string('ERR_RUN'), [$req->get_value('args')], 'relocate');
      $oid = $obj->get_oid;
      if (defined($set = $obj->get_info('val')))
      { $lng->remove_package($obj);
        $col = $col->relocate($set);
        $def = $col->get_definition;
      }

      # Ensure that the collector is new
      die get_string('NOT_NEW', $col->get_oid) unless $col->is_new;

      # Set the start script
      $slf->{'_dsp'}->dsp_line(get_string('V_Create', $col->get_oid))
        if $slf->{'_dsp'};
      $def->set_value('CONFIG.M_START', $oid,
        'Start scenario module');
    }
    else
    { die get_string('NOT_NEW', $col->get_oid) unless $col->is_new;
      $slf->{'_dsp'}->dsp_line(get_string('V_Create', $col->get_oid))
       if $slf->{'_dsp'};
    }

    # Set up the collector
    $set = $def->find('CONFIG', 1);
    $set->set_value('B_NEW');
    $set->set_value('T_DESCRIPTION', $req->get_first('desc'),
      'Start scenario description');
    $col->create->set_degree($req->get_first('degree', 0));
    if ($obj = $agt->get_lang('SDSL')->load_package('RDA:COLsetup'))
    { $obj->request($agt->get_run->find('CONTEXT', 1), $lvl % 10);
      $obj->delete_object;
    }

    # Add the specified profiles
    if (@tbl = $req->get_value('profiles'))
    { $prf = $agt->get_library('PROFILE')->merge($grp, @tbl);
      $col->set_profile($prf);
      $col->add_setup($grp, 1, 1, $prf->get_modules(1));
    }

    # Execute the start scenario
    if (($nam = $req->get_first('package', $set->get_first('M_START'))) &&
        ($obj = $lng->search_package($grp, $nam, $CLS)))
    { $slf->{'_get'} = $def;
      $slf->{'_set'} = $set = $def->find('START', 1);
      $set->set_value('D_SCENARIO',   $obj->get_dir,
        'Start scenario directory');
      $set->set_value('M_START',      $obj->get_oid,
        'Start scenario module');
      $set->set_value('T_PARAMETERS', $req->get_value('args'),
        'Start scenario arguments');

      # Execute the start section of the start script
      $obj->set_info('aux', $slf);
      $obj->exec(get_string('ERR_RUN'), [$req->get_value('args')], 'start');
      $lng->remove_package($obj);
      $set->set_value('G_RUN', time, 'Start execution date/time');
    }
    else
    { $set->set_value('D_SCENARIO');
      $set->set_value('M_START');
      $set->set_value('T_PARAMETERS');
    }

    # Force the setup
    $col->end_setup(0) if $req->get_first('setup');

    # Save the setup
    $sav = $req->get_first('save');
    $col->save if defined($sav) ? $sav : $col->should_save;
    };
  delete($slf->{'_get'});
  delete($slf->{'_set'});

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

=head1 SDCL PROPERTY INTERFACE

=head2 S<$h-E<gt>get_element($mode,$name)>

This method returns the item element as a list. It supports the following
access mode:

=over 5

=item B<  C > Returns the property value using C<clear_temp>.

=item B<  D > Returns the property description using C<get_desc>.

=item B<  E > Indicates whether the property is defined.

=item B<  I > Returns the item object reference using C<find>.

=item B<  P > Returns the property value using C<get_property>.

=item B<  T > Returns the property value using C<get_text>.

=item B<  V > Returns the property value using C<get_value>.

=item B<  c > Same as C<C> but disables the value validation.

=item B<  i > Same as C<I> but creates missing objects.

=item B<  p > Same as C<P> but disables the value validation.

=item B<  t > Same as C<T> but disables the value validation.

=item B<  v > Same as C<V> but disables the value validation.

=back

=cut

sub get_element
{ my ($slf, $mod, $nam) = @_;

  if ($nam =~ m/^_\.((\w+\.)*\w+)$/)
  { return ($slf->{'_get'}->get_element($mod, $1)) if exists($slf->{'_get'});
  }
  elsif ($nam =~ m/(^\w+\.)*\w+$/)
  { return ($slf->{'_set'}->get_element($mod, $nam)) if exists($slf->{'_set'});
  }
  die get_string('BAD_PROPERTY', $nam)
}

=head2 S<$h-E<gt>set_element($mode,$name,$value)>

This method sets an item element. It supports the following access modes:

=over 5

=item B<  D > Sets the property description using C<set_desc>.

=item B<  R > Sets the property value using C<set_raw>.

=item B<  T > Sets the property value using C<set_temp>.

=item B<  V > Sets the property value using C<set_value>.

=back

=cut

sub set_element
{ my ($slf, $mod, $nam, $val) = @_;

  if ($nam =~ m/^(\w+\.)*\w+$/ && exists($slf->{'_set'}))
  { die get_string('BAD_VALUE', $nam) unless ref($val) =~ m/^(ARRAY|HASH)?$/;
    $slf->{'_set'}->set_element($mod, $nam, $val);
  }
  else
  { die get_string('BAD_PROPERTY', $nam);
  }
  return;
}

1;

__END__

=head1 SEE ALSO

L<RDA::Agent|RDA::Agent>,
L<RDA::Error|RDA::Error>,
L<RDA::Request::DISPLAY|RDA::Request::DISPLAY>,
L<RDA::Object|RDA::Object>,
L<RDA::Object::Access|RDA::Object::Access>,
L<RDA::Object::Collect|RDA::Object::Collect>,
L<RDA::Object::Display|RDA::Object::Display>,
L<RDA::Object::Item|RDA::Object::Item>,
L<RDA::Object::Message|RDA::Object::Message>,
L<RDA::Object::Rda|RDA::Object::Rda>,
L<RDA::SDCL::Language|RDA::SDCL::Language>,
L<RDA::SDSL::Language|RDA::SDSL::Language>,
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