# Collect.pm: Class Used for Objects to Manage the Collector

package RDA::Object::Collect;

# $Id: Collect.pm,v 1.56 2015/11/18 06:29:04 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/Object/Collect.pm,v 1.56 2015/11/18 06:29:04 RDA Exp $
#
# Change History
# 20151118  MSC  Separate backup indicator and information.

=head1 NAME

RDA::Object::Collect - Class Used for Objects to Manage the Collector

=head1 SYNOPSIS

 require RDA::Object::Collect;

=head1 DESCRIPTION

The objects of the C<RDA::Object::Collect> class are used to manage the
contexts. It is a subclass of L<RDA::Object|RDA::Object>.

The following methods are available:

=cut

use strict;

BEGIN
{ use Exporter;
  use File::Copy qw(copy move);
  use IO::File;
  use RDA::Text qw(get_string);
  use RDA::Handle::Memory;
  use RDA::Object;
  use RDA::Object::Access;
  use RDA::Object::Content qw($RE_DC $RE_ABR $RE_TRC $RE_TST %TB_TRC);
  use RDA::Object::Item;
  use RDA::Object::Log;
  use RDA::Object::Message;
  use RDA::Object::Rda qw($APPEND $CREATE $DIR_PERMS $FIL_PERMS);
  use RDA::SDSL::Module;
}

# Define the global public variables
use vars qw($STRINGS $VERSION @DELETE @DUMP @EXPORT_OK @ISA %SDCL %SUB_DIRS);
$VERSION   = sprintf('%d.%02d', q$Revision: 1.56 $ =~ /(\d+)\.(\d+)/);
@DELETE    = qw(log _inc _mrc _pwd _rem _rpt _tgt);
@DUMP      = (
  obj => {
    },
  );
@EXPORT_OK = qw(%SUB_DIRS);
@ISA       = qw(RDA::Object Exporter);
%SDCL      = (
  als => {
    ## no critic (Interpolation)
    'displayText'       => ['$[COL]', 'display'],
    'findItem'          => ['$[COL]', 'find_item'],
    'forkModules'       => ['$[COL]', 'fork_collect'],
    'getAbsolute'       => ['$[COL]', 'get_absolute'],
    'getCollectGroups'  => ['$[COL]', 'get_groups'],
    'getCollectMembers' => ['$[COL]', 'get_members'],
    'getCollectModules' => ['$[COL]', 'get_modules'],
    'getCollectQueue'   => ['$[COL]', 'get_queue'],
    'getCollectTitles'  => ['$[COL]', 'get_titles'],
    'getDir'            => ['$[COL]', 'get_dir'],
    'getName'           => ['$[COL]', 'get_name'],
    'getRelative'       => ['$[COL]', 'get_relative'],
    'getSub'            => ['$[COL]', 'get_sub'],
    'requestInput'      => ['$[COL]', 'request'],
    'save'              => ['$[COL]', 'save'],
    'submitCommand'     => ['$[COL]', 'submit'],
    'updateUsage'       => ['$[COL]', 'update_usage'],
    'waitModules'       => ['$[COL]', 'wait_collect'],

    },
  end => \&_end_collect,
  flg => 1,
  inc => [qw(RDA::Object)],
  met => {
    'add_collect'    => {ret => 0},
    'add_setup'      => {ret => 0},
    'collect'        => {ret => 0},
    'delete_collect' => {ret => 0},
    'delete_module'  => {ret => 0, arg => [qw(req)]},
    'delete_reports' => {ret => 0},
    'display'        => {ret => 0},
    'end_collect'    => {ret => 0},
    'end_setup'      => {ret => 0},
    'find'           => {ret => 0},
    'find_item'      => {ret => 0},
    'fork_collect'   => {ret => 1},
    'get_absolute'   => {ret => 0},
    'get_data'       => {ret => 0},
    'get_definition' => {ret => 0},
    'get_desc'       => {ret => 0},
    'get_dir'        => {ret => 0},
    'get_element'    => {ret => 1},
    'get_enabled'    => {ret => 1},
    'get_first'      => {ret => 0},
    'get_groups'     => {ret => 1},
    'get_item'       => {ret => 0},
    'get_items'      => {ret => 1},
    'get_local'      => {ret => 1},
    'get_log'        => {ret => 0},
    'get_members'    => {ret => 1},
    'get_modules'    => {ret => 1},
    'get_name'       => {ret => 0},
    'get_output'     => {ret => 0},
    'get_pending'    => {ret => 1},
    'get_primary'    => {ret => 0},
    'get_prime'      => {ret => 0},
    'get_property'   => {ret => 1},
    'get_queue'      => {ret => 1},
    'get_relative'   => {ret => 0},
    'get_sub'        => {ret => 0},
    'get_target'     => {ret => 0},
    'get_targets'    => {ret => 1},
    'get_text'       => {ret => 1},
    'get_titles'     => {ret => 0},
    'get_value'      => {ret => 1},
    'grep'           => {ret => 1},
    'has_dir'        => {ret => 0},
    'is_collected'   => {ret => 0},
    'is_configured'  => {ret => 0},
    'is_done'        => {ret => 0},
    'is_disabled'    => {ret => 0},
    'is_enabled'     => {ret => 0},
    'is_isolated'    => {ret => 0},
    'is_new'         => {ret => 0},
    'is_pending'     => {ret => 0},
    'is_quiet'       => {ret => 0},
    'is_verbose'     => {ret => 0},
    'log'            => {ret => 0},
    'log_timeout'    => {ret => 0, blk => 1},
    'need_setup'     => {ret => 0},
    'post'           => {ret => 0},
    'render'         => {ret => 0},
    'request'        => {ret => 0, blk => 1},
    'run'            => {ret => 0, arg => [qw(req)]},
    'save'           => {ret => 0},
    'set_desc'       => {ret => 0},
    'set_element'    => {ret => 1},
    'set_isolated'   => {ret => 0},
    'set_profile'    => {ret => 1},
    'set_value'      => {ret => 1},
    'setup'          => {ret => 0},
    'submit'         => {ret => 0},
    'suspend_log'    => {ret => 0},
    'sync'           => {ret => 0},
    'update_usage'   => {ret => 0},
    'wait_collect'   => {ret => 0},
    },
  top => 'COL',
  );
%SUB_DIRS  = (
  A => 'archive',
  C => 'collect',
  D => 'remote',
  E => 'extern',
  M => 'mrc',
  O => undef,
  R => 'ref',
  S => 'sample',
  X => 'transfer',
  );

# Define the global private constants
my $PENDING  = -1;
my $SKIP     = 0;
my $OBSOLETE = 1;
my $PARTIAL  = 2;
my $DONE     = 3;

my $DSC_BLD = 'Setup build number';
my $DSC_CLN = 'Shoud RDA clean the data diagnostic directory on first use?';
my $DSC_NEW = 'Is new?';
my $DSC_SFT = 'Software directory';
my $DSC_SUB = 'Is the setup included in the data diagnostic directory?';
my $DSC_WRK = 'Work directory';

my $RE_TYP = qr/^[A-Z]{2,}$/i;

# Define the global private variables
my @tb_sta = qw(skip obsolete partial done pending);
my %tb_add = map {$_ => 1} qw(err out req skp);
my %tb_dmp = (
  B_ALARM   => ['RDA::Alarm',           'DUMP',    1],
  B_BUFFER  => ['RDA::Error',           'DMP_BUF', 1],
  B_DEFINE  => ['RDA::SDSL::Setting',   'DMP_DEF', 1],
  B_DELETE  => ['RDA::Object',          'DELETE',  1],
  B_ENV     => ['RDA::Object::View',    'DUMP',    1],
  B_ERROR   => ['RDA::Error',           'DMP_STK', 1],
  B_HELP    => ['RDA::Web::Help',       'DUMP',    1],
  B_HTML    => ['RDA::Object::Html',    'SHORT',   0],
  B_INPUT   => ['RDA::SDSL::Setting',   'DMP_INP', 1],
  B_ITEM    => ['RDA::Object::Item',    'DUMP',    1],
  B_MESSAGE => ['RDA::Object::Message', 'DUMP',    1],
  B_NEXT    => ['RDA::SDSL::Setting',   'DMP_NXT', 1],
  B_SETUP   => ['RDA::SDSL::Setting',   'DMP_SET', 1],
  B_TIMING  => ['RDA::Object::Timing',  'DUMP',    1],
  B_TYPE    => ['RDA::Object::Type',    'DUMP',    1],
  B_XML     => ['RDA::Object::Xml',     'SHORT',   0],
  );
my %tb_dsc = (
  N_CFG => 'Setup sequence',
  N_RUN => 'Execution sequence',
  N_END => 'End sequence',
  T_TTL => 'Oracle Product Settings',
  );
my %tb_job = (
  clr => {cfg => \&_skip_job,
          err => \&_skip_job,
          out => \&_skip_job,
          use => \&_skip_job,
         },
  end => {cfg => \&_load_job_cfg,
          out => \&_load_job_out,
          use => \&_load_job_use,
         },
  rec => {cfg => \&_load_job_cfg,
          out => \&_skip_job,
          use => \&_skip_job,
         },
  );
my %tb_sta = (
  done     => $DONE,
  obsolete => $OBSOLETE,
  pending  => $PENDING,
  partial  => $PARTIAL,
  skip     => $SKIP,
  );
my %tb_typ = (
  A => ['COL', 'ARC_CREATE'],
  B => ['BOX', 'BOX_CREATE'],
  C => ['COL', 'COL_CREATE'],
  D => ['COL', 'REM_CREATE'],
  E => ['COL', 'EXT_CREATE'],
  I => ['INC', 'INC_CREATE'],
  J => ['JOB', 'JOB_CREATE'],
  L => ['LCK', 'LCK_CREATE'],
  M => ['COL', 'MRC_CREATE'],
  O => ['OVW', 'OVW_CREATE'],
  P => ['PRP', 'PRP_CREATE'],
  R => ['COL', 'REF_CREATE'],
  S => ['COL', 'SMP_CREATE'],
  T => ['TMP', 'TMP_CREATE'],
  W => ['WEB', 'WEB_CREATE'],
  X => ['COL', 'XFR_CREATE'],
  );

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

=head2 S<$h = RDA::Object::Collect-E<gt>new($agent[,$new])>

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

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

=over 16

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

=item S<    B<'cfg' > > Reference to the RDA software configuration

=item S<    B<'cnt' > > Reference to the RDA content control object

=item S<    B<'dat' > > Diagnostic data directory

=item S<    B<'def' > > Reference to the result set definition

=item S<    B<'dft' > > Reference to the DEFAULT item

=item S<    B<'dir' > > Collect directory structure

=item S<    B<'job' > > Job identifier

=item S<    B<'lim' > > Reference to the LIMIT item

=item S<    B<'log' > > Reference to the event log control object

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

=item S<    B<'oid' > > Collector name

=item S<    B<'run' > > Reference to the run time data

=item S<    B<'set' > > Reference to the SETUP item

=item S<    B<'sta' > > Reference to the STATUS item

=item S<    B<'tgt' > > Reference to the TARGET item

=item S<    B<'use' > > Collector usage overview

=item S<    B<'vrb' > > Verbose indicator

=item S<    B<'yes' > > Auto confirmation flag

=item S<    B<'_beg'> > System time of a command start

=item S<    B<'_bak'> > Backup indicator

=item S<    B<'_bkp'> > Backup information for suspend/resume

=item S<    B<'_cfg'> > Module configuration status hash

=item S<    B<'_cln'> > Clean request hash

=item S<    B<'_col'> > Module collection status cache

=item S<    B<'_def'> > Result set definition (setup) file

=item S<    B<'_grp'> > Module group cache

=item S<    B<'_idx'> > Target indexes

=item S<    B<'_inc'> > Reference to the inline code control object

=item S<    B<'_inf'> > Reference for getting missing object attributes

=item S<    B<'_itm'> > Items related to predefined targets

=item S<    B<'_job'> > Job counter

=item S<    B<'_lim'> > Reference to the collection limit control object

=item S<    B<'_mrc'> > Reference to the multi-run collection control object

=item S<    B<'_new'> > New collector indicator

=item S<    B<'_nxt'> > Target name generation sequence numbers

=item S<    B<'_out'> > Output directory hash

=item S<    B<'_pwd'> > Reference to the access control object

=item S<    B<'_prc'> > Progress reporting counter

=item S<    B<'_prf'> > Progress reporting format

=item S<    B<'_prh'> > Progress reporting handle

=item S<    B<'_prm'> > Progress reporting maximum value

=item S<    B<'_prq'> > Parallel run hash

=item S<    B<'_rem'> > Reference to the remote access control object

=item S<    B<'_rpt'> > Reference to the report control object

=item S<    B<'_run'> > Data collection queue

=item S<    B<'_sct'> > Module section requests

=item S<    B<'_seq'> > Work file sequence number

=item S<    B<'_sub'> > Subdirectory names

=item S<    B<'_tgt'> > Reference to the target control object

=item S<    B<'_tim'> > Reference to the timing control object

=item S<    B<'_trc'> > Module tracing requests

=item S<    B<'_typ'> > Directory type definitions

=item S<    B<'_use'> > Library usage hash

=item S<    B<'_wrk'> > Work file hash

=back

Internal keys are prefixed by an underscore.

=cut

sub new
{ my ($cls, $agt, $new) = @_;
  my ($cfg, $dat, $def, $fil, $flg, $lvl, $obj, $oid);

  # Determine the collector configuration
  $cfg = $agt->get_config;
  $lvl = $agt->get_level;
  $oid = lc($agt->get_oid);
  $def = RDA::Object::Item->new($agt, $oid, 'Result Set Definition');
  $fil = "$oid.cfg";
  if ($cfg->get_value('B_CURRENT'))
  { $oid = q{.};
    $agt->trace(get_string('Current', $cfg->get_work))
      unless $lvl < 10;  ## no critic (Unless)
    $dat = $cfg->current_dir;
    $new = 0;

    # Create the minimum entries
    $obj = $def->find('CONFIG', 1);
    $obj->set_value('B_NEW',   0,                        $DSC_NEW);
    $obj->set_value('D_HOME',  $cfg->get_group('D_RDA'), $DSC_SFT);
    $obj->set_value('D_WORK',  $cfg->get_work,           $DSC_WRK);
    $obj->set_value('N_BUILD', $cfg->get_build,          $DSC_BLD);

    # Determine the directory structure
    $obj->set_value('B_SUB',          0, $DSC_SUB);
    $def->set_value('OUTPUT.B_CLEAN', 0, $DSC_CLN);
  }
  elsif ($new || ! -f $fil)
  { $agt->trace(get_string('New', $oid))
      unless $lvl < 10;  ## no critic (Unless)
    $new = 1;

    # Create the minimum entries
    $obj = $def->find('CONFIG', 1);
    $obj->set_value('B_NEW',   1,                        $DSC_NEW);
    $obj->set_value('D_HOME',  $cfg->get_group('D_RDA'), $DSC_SFT);
    $obj->set_value('D_WORK',  $cfg->get_work,           $DSC_WRK);
    $obj->set_value('N_BUILD', $cfg->get_build,          $DSC_BLD);

    # Determine the directory structure
    if ($cfg->get_value('B_SUB'))
    { $dat = $cfg->up_dir;
      $obj->set_value('B_SUB',          1, $DSC_SUB);
      $def->set_value('OUTPUT.B_CLEAN', 1, $DSC_CLN);
    }
    elsif (-d ($dat = $cfg->cat_dir($oid)))
    { $agt->abort(get_string('BAD_NAME', $oid))
        unless  -f $fil || -f $cfg->cat_file($dat, 'RDA.log');
      $def->set_value('OUTPUT.B_CLEAN', 1, $DSC_CLN);
    }
    $agt->abort(get_string('BAD_NAME', $oid))
      if -f $cfg->cat_file($dat, 'Agent.pm');
  }
  else
  { $agt->trace(get_string('Load', $oid))
      unless $lvl < 10;  ## no critic (Unless)
    $new = 0;

    # Load the result set definition
    $def->load_content($cfg->current_dir);

    # Determine the directory structure
    if ($def->get_first('CONFIG.B_SUB'))
    { $dat = $cfg->up_dir;
    }
    elsif (! -d ($dat = $cfg->cat_dir($oid)))
    { $cfg->create_dir($dat, $DIR_PERMS, 1, $agt->should_align);
    }
    $agt->abort(get_string('BAD_NAME', $oid))
      if -f $cfg->cat_file($dat, 'Agent.pm');
  }

  # Create the collector object and return its reference
  return bless {
    agt  => $agt,
    cfg  => $cfg,
    cnt  => $agt->get_content,
    dat  => $dat,
    def  => $def,
    dft  => $def->find('DEFAULT', 1),
    dir  => $cfg->get_group('D_RDA_COL'),
    job  => q{},
    lim  => $def->find('LIMIT', 1),
    log  => RDA::Object::Log->new($agt, $dat, 'RDA'),
    lvl  => $lvl,
    oid  => $oid,
    run  => $agt->get_run,
    set  => $def->find('SETUP', 1),
    sta  => $def->find('STATUS', 1),
    tgt  => $def->find('TARGET', 1),
    vrb  => $agt->is_verbose,
    yes  => $agt->is_isolated,
    _bak => $agt->get_info('bkp'),
    _def => $fil,
    _idx => {},
    _inf => $agt,
    _itm => [],
    _job => 0,
    _new => $new,
    _nxt => {},
    _run => {},
    _sct => {},
    _seq => 0,
    _sub => {%SUB_DIRS},
    _trc => {},
    _typ => {%tb_typ},
    _wrk => {},
    }, ref($cls) || $cls;
}

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

This method creates a new collector. It returns the object reference.

=cut

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

  return $slf->{'_new'}
    ? _create($slf)
    : $slf;
}

sub _create
{ my ($slf) = @_;
  my ($agt);

  # Create the data diagnostic directory and the event log file
  $agt = $slf->{'agt'};
  RDA::Object::Rda->create_dir($slf->{'dat'}, $DIR_PERMS, 0,
    $agt->should_align);
  $slf->{'log'}->start;

  # Create a new collector
  $agt->abort
    if $slf->{'def'}->get_first('CONFIG.B_NEW')
    && $agt->submit(q{.}, 'RDA.START',
                          degree => $slf->get_degree)->is_error($agt);
  $slf->{'_new'} = 0;

  # Return the object reference
  return $slf;
}

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

This method deletes the collector object. The event log file is closed when
needed.

=cut

sub delete_object  ## no critic (Unpack)
{ # Delete the report control
  delete($_[0]->{'_rpt'})->delete_object if exists($_[0]->{'_rpt'});

  # Delete the target control
  delete($_[0]->{'_tgt'})->end if exists($_[0]->{'_tgt'});

  # Clean work files
  if (exists($_[0]->{'_cln'}))
  { foreach my $pth (values(%{delete($_[0]->{'_cln'})}))
    { 1 while unlink($pth);
    }
    $_[0]->{'_wrk'} = {};
  }

  # Delete the collection root object
  $_[0]->SUPER::delete_object;
  return;
}

=head2 S<$h-E<gt>display($name[,$flag[,%hsh]])>

This method displays a text. The text can contain variables that are resolved
through the specified hash. When the variable is not defined in the hash,
properties are used. When the flag is set, an user acknowledgment is requested
before continuing.

=cut

sub display
{ my ($slf, $nam, $flg, %var) = @_;

  return $slf->{'agt'}->submit(q{.}, RDA::Object::Message->new(
    $flg ? 'ASK.ASK_ACKNOWLEDGE' : 'DISPLAY.DSP_TEXT',
    name => $nam,
    )->add_lines(map {$_.q{="}.$var{$_}.q{"}} keys(%var)))->is_success;
}

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

This method returns a reference to the access control object.

=cut

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

  unless (exists($slf->{'_pwd'}))
  { # Create the control object on first use
    eval {
      require RDA::Object::Access;
      $slf->{'_pwd'} = RDA::Object::Access->new($slf);
      };
    $slf->{'agt'}->abort($@, get_string('ERR_ACCESS')) if $@;
  }
  return $slf->{'_pwd'};
}

=head2 S<$h-E<gt>get_agent([$name[,$default]])>

This method returns the value of an agent object attribute or the default
value when the attribute is not defined.

It returns the agent object reference when no attribute name is specified.

=cut

sub get_agent
{ my ($slf, $nam, $dft) = @_;

  return defined($nam) ? $slf->{'agt'}->get_info($nam, $dft) : $slf->{'agt'};
}

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

This method returns a reference to the RDA software configuration.

=cut

sub get_config
{ return shift->{'cfg'};
}

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

This method returns a reference to the RDA content control object.

=cut

sub get_content
{ return shift->{'cnt'};
}

=head2 S<$h-E<gt>get_data([$flag])>

This method returns the diagnostic data directory. When the flag is set, it
returns an absolute path. Otherwise, it returns a path relative to the working
directory.

=cut

sub get_data
{ my ($slf, $flg) = @_;

  return $flg
    ? $slf->{'cfg'}->get_dir('D_CWD', $slf->{'dat'})
    : $slf->{'dat'};
}

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

This method returns the current setting level.

=cut

sub get_degree
{ return shift->{'set'}->get_first('N_LVL', 0);
}

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

This method creates the inline code control object and returns a reference to
it.

=cut

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

  unless (exists($slf->{'_inc'}))
  { # Create the control object on first use
    eval {
      require RDA::Object::Inline;
      $slf->{'_inc'} = RDA::Object::Inline->new($slf);
      };
    $slf->{'agt'}->abort($@, get_string('ERR_INLINE')) if $@;
  }
  return return $slf->{'_inc'}
}

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

This method creates the collection limit control object and returns a reference
to it.

=cut

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

  unless (exists($slf->{'_lim'}))
  { # Create the control object on first use
    eval {
      require RDA::Object::Limit;
      $slf->{'_lim'} = RDA::Object::Limit->new($slf);
      };
    $slf->{'agt'}->abort($@, get_string('ERR_LIMIT')) if $@;
  }
  return return $slf->{'_lim'}
}

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

This method creates a multi-run collection control object and returns a
reference to it.

=cut

sub get_mrc
{ my ($slf, $flg) = @_;

  unless (exists($slf->{'_mrc'}))
  { # Create the control object on first use
    eval {
      require RDA::Object::Mrc;
      $slf->{'_mrc'} = RDA::Object::Mrc->new($slf);
      };
    $slf->{'agt'}->abort($@, get_string('ERR_MRC')) if $@;
  }
  return return $slf->{'_mrc'}
}

=head2 S<$h-E<gt>get_output([$flag])>

=for stopwords postprocessing

This method creates the object to control the output and returns a reference to
it. Setting the flag disables any output postprocessing.

=cut

sub get_output
{ my ($slf, $flg) = @_;

  unless (exists($slf->{'_rpt'}))
  { # Create the control object on first use
    eval {
      require RDA::Object::Output;
      $slf->{'_rpt'} = RDA::Object::Output->new($slf, $flg);
      };
    $slf->{'agt'}->abort($@, get_string('ERR_OUTPUT')) if $@;
  }
  return $slf->{'_rpt'};
}

=head2 S<$h-E<gt>get_registry($key[,$fct,$arg,...])>

This method returns the value of the shared information associated to the
specified key. When it does not exist, it uses the provided function to
collect it.

=cut

sub get_registry
{ return shift->{'agt'}->get_registry(@_);
}

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

This method returns the reference to the remote access control object.

=cut

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

  # When already allocated, return its reference
  unless (exists($slf->{'_rem'}))
  { # Create the control object on first use
    eval {
      require RDA::Object::Remote;
      $slf->{'_rem'} = RDA::Object::Remote->new($slf);
      };
    $slf->{'agt'}->abort($@, get_string('ERR_REMOTE')) if $@;
  }
  return $slf->{'_rem'}
}

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

This method returns the display file handle.

=cut

sub get_screen
{ return shift->{'agt'}->get_screen(@_);
}

=head2 S<$h-E<gt>get_temp([$flag])>

This method returns the temporary directory. When the flag is set, it returns
an absolute path. Otherwise, it returns a path relative to the working
directory.

It creates the directory when needed.

=cut

sub get_temp
{ my ($slf, $flg) = @_;

  # Create the context temporary directory on first call
  $slf->{'_tmp'} =
    RDA::Object::Rda->create_dir(RDA::Object::Rda->cat_dir('temp'), $DIR_PERMS,
    0, $slf->{'agt'}->should_align)
    unless exists($slf->{'_tmp'});

  # Return the path to the context temporary directory
  return $flg
    ? RDA::Object::Rda->cat_dir($slf->{'cfg'}->get_work, $slf->{'_tmp'})
    : $slf->{'_tmp'};
}

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

This method creates the timing control object and returns a reference to it.

=cut

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

  unless (exists($slf->{'_tim'}))
  { # Create the control object on first use
    eval {
      require RDA::Object::Timing;
      $slf->{'_tim'} = RDA::Object::Timing->new($slf);
      };
    $slf->{'agt'}->abort($@, get_string('ERR_TIMING')) if $@;
  }
  return return $slf->{'_tim'}
}

=head2 S<$h-E<gt>get_trace($type)>

This method returns the trace level for the specified object type, zero by
default.

=cut

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

  return $slf->{'def'}->get_first("TRACE.N_$nam", 0);
}

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

This method initializes the collector.

=cut

sub init  ## no critic (Complex)
{ my ($slf) = @_;
  my ($agt, $bld, $cls, $cur, $def, $edt, $obj, $val, $var);

  $agt = $slf->{'agt'};
  $def = $slf->{'def'};
  $edt = $agt->get_info('edt', {});

  # Adjust the RDA software configuration and the result set definition
  unless ($slf->{'_new'})
  { # Adjust the RDA software configuration
    $slf->sync;

    # Upgrade the result set definition
    $bld = $slf->{'cfg'}->get_build;
    $cur = $def->get_first('CONFIG.N_BUILD', 0);
    if ($cur < $bld)
    { $agt->trace(get_string('Upgrade', $slf->{'oid'}))
        unless $slf->{'lvl'} < 10;  ## no critic (Unless)
      $agt->submit(q{.}, 'UPGRADE.COLLECTOR',
        save  => 0,
        trace => exists($edt->{'TRC/N_UPGRADE'}) ? $edt->{'TRC/N_UPGRADE'} :
                 exists($edt->{'TRC/UPGRADE'})   ? $edt->{'TRC/UPGRADE'} :
                 $def->get_first('TRACE.N_UPGRADE'));
    }
  }

  # Convert input directives
  $agt->submit(q{.}, 'UPGRADE.INPUT') if $agt->get_input;

  # Apply temporary changes
  foreach my $key (sort keys(%{$edt}))
  { if ($key =~ m/^COL\/(.*)$/)
    { eval {$def->set_temp($1, $edt->{$key})};
    }
    elsif ($key =~ m/^DFT\/(.*)$/)
    { eval {$def->set_temp("DEFAULT.$1", $edt->{$key})};
    }
    elsif ($key =~ m/^DMP\/(B_)?(.*)$/)
    { eval {$def->set_temp("DUMP.B_$2", $edt->{$key})};
    }
    elsif ($key =~ m/^EXP\/(T_)?(.*)$/)
    { eval {$def->set_temp("SETUP.EXPLORER.XPLR.BEGIN.T_$2", $edt->{$key})};
    }
    elsif ($key =~ m/^LIM\/(.*)$/)
    { eval {$def->set_temp("LIMIT.$1", $edt->{$key})};
    }
    elsif ($key =~ m/^REM\/(.*)$/)
    { eval {$def->set_temp("REMOTE.$1", $edt->{$key})};
    }
    elsif ($key =~ m/^TRC\/(N_)?(.*)$/)
    { eval {$def->set_temp("TRACE.N_$2", $edt->{$key})};
    }
    elsif ($key =~ m/^TGT\/((\w+\.)*([A-Z]{2,})_I\d+)$/ && $slf->{'_new'})
    { eval {_add_target($slf, $3, $1, $edt->{$key})};
    }
    elsif ($key =~ m/^(CFG|ENV|PRF|RUN|TGT)\//)
    { next;
    }
    elsif ($key =~ m/^([A-Z][A-Z\d]*)\/((\w+\.)*[DFI]_\w+)$/)
    { eval {$def->set_temp("PREPARE.$1.$2", $edt->{$key}, 1)};
    }
    elsif ($key =~ m/^([A-Z][A-Z\d]*)\/((\w+\.)*[A-Z]_\w+)$/)
    { eval {$def->set_temp("PREPARE.$1.$2", $edt->{$key})};
    }
    elsif ($key =~ m/^(\w+\.)*[A-Z]_\w+$/)
    { eval {$def->set_temp("SETUP.$key", $edt->{$key})};
    }
  }

  # Control object dump detail level
  if ($obj = $def->find('DUMP'))
  { foreach my $key (keys(%tb_dmp))
    { next unless $obj->get_first($key);
      ($cls, $var, $val) = @{$tb_dmp{$key}};
      eval "require $cls";
      eval "\$$cls\::$var = $val" unless $@;  ## no critic (Eval)
    }
  }

  # Return the object reference
  return $slf;
}

sub _add_target
{ my ($slf, $cls, $nam, $val) = @_;
  my ($obj, $ref);

  $ref = ref($val);
  unless ($ref eq 'HASH')
  { next unless $ref eq 'ARRAY';
    $val = {@{$val}};
  }
  push(@{$slf->{'_itm'}}, $obj = $slf->{'def'}->find("TARGET.INPUT.$nam", 1));
  $obj->set_value('B_DEDICATED', 1);
  $obj->set_value('T_TITLE',     "Input target $nam");
  $obj->set_value('W_CLASS',     $cls);
  foreach my $key (keys(%{$val}))
  { eval {$obj->set_value($key, $val->{$key})};
  }
  return;
}

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

This method indicates whether customer interactions are disabled.

=cut

sub is_isolated
{ return shift->{'yes'};
}

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

This method indicates whether or not it is a new collector.

=cut

sub is_new
{ return shift->{'_new'};
}

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

This method indicates whether all outputs are disabled.

=cut

sub is_quiet
{ return shift->{'agt'}->is_quiet;
}

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

This method indicates whether RDA runs in verbose mode.

=cut

sub is_verbose
{ return shift->{'vrb'};
}

=head2 S<$h-E<gt>relocate($dir)>

This method relocates the collector in the specified directory. It returns the
object reference.

=cut

sub relocate
{ my ($slf, $dir) = @_;
  my ($cfg, $new, $obj);

  # Adjust the software configuration
  $cfg = $slf->get_config;
  chdir($dir = $cfg->create_dir($cfg->is_absolute($dir)
    ? $dir
    : $cfg->cat_dir($cfg->get_group('D_CWD'), $dir)))
    or die get_string('ERR_CHDIR', $dir, $!);
  $cfg->set_info('B_SUB', 1);
  $cfg->set_info('D_CWD', $dir);

  # Return the new collector
  die get_string('NOT_NEW', $dir)
    if -f $slf->{'oid'}.'.cfg' || -d $slf->{'oid'};
  return $slf->{'agt'}->get_collector(1);
}

=head2 S<$h-E<gt>request($block,$name[,$item[,$depth]])>

This method requests additional configuration properties using the setup
specifications. Except when a full path is provided, it first searches the
setup specifications in the directory where the package is located. You can
specify the item used for all objects or properties. When not specified, it
uses the request item. The current setup level applies.

You can control the setup depth by an extra argument. It uses 1 by default.

It returns 1 when the setup is performed. Otherwise, it returns 0.

=cut

sub request
{ my ($slf, $blk) = @_;

  return $blk->get_agent->switch_context($blk, undef, \&_request, @_);
}

sub _request
{ my ($slf, $blk, $nam, $itm, $dpt) = @_;
  my ($dir, $lng, $obj, $pkg, $trc);

  $lng = $slf->{'agt'}->get_lang('SDSL');
  $pkg = $blk->get_package;
  $trc = $blk->get_context->get_trace;
  return 0 unless ($obj =
    RDA::Object::Rda->is_absolute($nam) ?
      $lng->load_file(RDA::Object::Rda->basename($nam),
                      RDA::Object::Rda->dirname($nam)) :
    defined($dir = $pkg->get_info('dir')) ?
      $lng->load_file($nam, $dir) :
    $lng->search_package($pkg->get_info('grp'), $nam));
  $lng->add_usage($obj);
  $obj->set_info('ctx', $pkg->get_top('aux')->get_element('V', 'K_CONTEXT'));
  $obj->set_info('dpt', defined($dpt) ? $dpt : 1);
  $obj->set_info('shr', $blk->get_top);
  $obj->request((ref($itm) eq 'RDA::Object::Item')
    ? $itm
    : $slf->{'run'}->find($itm || 'REQUEST', 1), $trc);
  $obj->delete_object;
  return 1;
}

=head2 S<$h-E<gt>resume([$flag])>

This method restores the original result set definition and run time data. When
the flag is set, it applies the changes on the original data. It returns the
object reference.

=cut

sub resume
{ my ($slf, $flg) = @_;
  my ($bkp, $def, $run);

  die get_string('NO_BACKUP') unless ref($bkp = delete($slf->{'_bkp'}));

  # Extract the recorded changes
  if (delete($bkp->{'rec'}))
  { $def = $slf->{'def'}->extract;
    $run = $slf->{'run'}->extract;
  }

  # Restore the current target
  $slf->get_target->set_current(delete($bkp->{'tgt'}));

  # Restore the original definitions
  foreach my $key (keys(%{$bkp}))
  { $slf->{$key} = $bkp->{$key};
  }

  # Apply the definition changes when requested
  if ($flg)
  { $slf->{'def'}->patch(RDA::Handle::Memory->new($def)) if $def;
    $slf->{'run'}->patch(RDA::Handle::Memory->new($run)) if $run;
  }

  # Return the object reference
  return $slf;
}

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

This method saves the result set definition file. It returns the object
reference.

=cut

sub save
{ my ($slf) = @_;
  my ($bkp, $fil);

  unless ($slf->{'_new'})
  { # Backup the result set definition file
    $slf->{'_bak'} = 0 unless -f ($fil = $slf->{'_def'});
    if ($slf->{'_bak'})
    { $slf->{'agt'}->trace(get_string('Backup', $slf->{'oid'}))
        unless $slf->{'lvl'} < 10;  ## no critic (Unless)
      $bkp = $fil;
      $bkp =~ s/(\.cfg)?$/.bak/i;
      1 while unlink($bkp);
      rename ($fil, $bkp) or die get_string('ERR_BACKUP', $fil, $!);
      $slf->{'_bak'} = 0;
    }

    # Write the result set definition file
    $slf->{'agt'}->trace(get_string('Save', $slf->{'oid'}))
      unless $slf->{'lvl'} < 10;  ## no critic (Unless)
    $slf->{'def'}->save_content(RDA::Object::Rda->current_dir);
  }
  return $slf;
}

=head2 S<$h-E<gt>set_degree($level)>

This method specifies a new setting level. It returns the previous value.

=cut

sub set_degree
{ my ($slf, $lvl) = @_;

  return $slf->{'set'}->set_value('N_LVL', $lvl, 'Setup level')
    if defined($lvl = $slf->{'cfg'}->get_degree($lvl));
  return $slf->{'agt'}->abort(get_string('BAD_DEGREE', $lvl));
}

=head2 S<$h-E<gt>set_isolated($flag)>

This method specifies whether or not customer interactions are disabled at the
collector level. It allows interactions only when allowed at the agent
level. It returns the previous value.

=cut

sub set_isolated
{ my ($slf, $flg) = @_;

  return $slf->{'agt'}->is_isolated
    ? 1
    : $slf->set_info('yes', $flg);
}

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

This method indicates whether or not RDA should perform an incremental save.

=cut

sub should_save
{ my ($slf) = @_;
  my ($flg);

  return defined($flg = $slf->{'dft'}->get_first('B_SAVE'))
    ? $flg
    : $slf->{'agt'}->get_info('sav');
}

=head2 S<$h-E<gt>submit($dest,$message)>

This method finds the agent corresponding to the destination, submits it the
request, and returns a response message.

=head2 S<$h-E<gt>submit($dest,$command,$attribute...)>

This method generates the request message from the arguments, finds the agent
corresponding to the destination, submits it the request, and returns a
response message.

=cut

sub submit
{ return shift->{'agt'}->submit(@_);
}

=head2 S<$h-E<gt>suspend([$flag[,$fork]])>

This method suspends the definition changes. When the flag is set, it starts
recording changes. It returns the object reference.

=cut

sub suspend
{ my ($slf, $rec, $frk) = @_;
  my ($def);

  if ($frk)
  { # Backup the current target
    $slf->{'_bkp'} = {
      rec => $rec,
      tgt => $slf->get_target->get_current,
      };

    # Reset the work files
    $slf->{'_cln'} = {};
    $slf->{'_seq'} = 0;
    $slf->{'_wrk'} = {};

    # Adjust the end message and start change recording
    if ($rec)
    { $slf->{'agt'}->set_info('end', 'EndThread');
      $slf->{'def'}->record;
      $slf->{'run'}->record;
    }
    else
    { $slf->{'agt'}->set_info('end', 'EndJob');
    }
  }
  else
  { # Backup the definition references and the current target
    $slf->{'_bkp'} = {
      def => $slf->{'def'},
      dft => $slf->{'dft'},
      lim => $slf->{'lim'},
      rec => $rec,
      run => $slf->{'run'},
      set => $slf->{'set'},
      sta => $slf->{'sta'},
      tgt => $slf->get_target->get_current,
      yes => $slf->{'yes'},
      };

    # Clone the definition
    $slf->{'def'} = $def = $slf->{'def'}->clone($rec);
    $slf->{'dft'} = $def->find('DEFAULT');
    $slf->{'lim'} = $def->find('LIMIT');
    $slf->{'set'} = $def->find('SETUP');
    $slf->{'sta'} = $def->find('STATUS');
    $slf->{'run'} = $slf->{'run'}->clone($rec);
  }

  # Return the object reference
  return $slf;
}

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

This method synchronizes the software configuration with the collector.

=cut

sub sync
{ my ($slf) = @_;
  my ($def);

  $def = $slf->{'def'}->find('CONFIG', 1);
  return $slf->{'cfg'}->set_context($def->get_first('T_NODE'),
                                    $def->get_first('T_DOMAIN'),
                                    $def->get_first('B_FORK'));
}

=head1 COLLECT MANAGEMENT METHODS

=head2 S<$h-E<gt>add_collect($group[,$module...])>

This method adds modules to the data collection queue. Unless the flag is set,
it skips modules already collected. It returns the number of modules added to
the data collection queue.

=cut

sub add_collect  ## no critic (Complex)
{ my ($slf, $grp, @mod) = @_;
  my ($cnt, $col, $key, $mod, $rec, $sta, $trc,
      $tb_run, $tb_sct, $tb_trc, @sct);

  # Initialization
  $sta = exists($slf->{'_col'}) ? $slf->{'_col'} : load_collect($slf);
  $tb_run = $slf->{'_run'};
  $tb_sct = $slf->{'_sct'};
  $tb_trc = $slf->{'_trc'};

  # Add the modules to the data collection queue
  $cnt = 0;
  while (defined($mod = shift(@mod)))
  { # Get the module information
    $trc = undef;
    ($mod, $trc) = ($2, $TB_TRC{$1}) if $mod =~ $RE_TRC;
    ($mod, @sct) = split(/-/, $mod);
    $key = lc($mod = $slf->{'cnt'}->get_module('DC', $grp, $mod));

    # Skip unknown module
    next unless exists($sta->{$key});
    $rec = $sta->{$key};

    # Merge data collection requests
    if (exists($tb_run->{$key}))
    { $tb_trc->{$key} = $trc unless defined($trc)  ## no critic (Unless)
        && exists($tb_trc->{$key}) && $trc <= $tb_trc->{$key};
      if (@sct)
      { foreach my $sct (@sct)
        { $tb_sct->{$key}->{$sct} = 1;
        }
      }
      else
      { $tb_sct->{$key} = {};
      }
      next;
    }

    # Add the request
    if ($col = $rec->{'sta'})
    { $tb_run->{$key} = $rec;
      $tb_sct->{$key} = {map {$_ => 0} @sct};
      $tb_trc->{$key} = $trc if defined($trc);
      ++$cnt;
    }

    # Add the triggered modules
    foreach my $trg (@{$rec->{'trg'}})
    { $key = lc($trg);
      next unless !exists($tb_run->{$key})  ## no critic (Unless)
        && exists($sta->{$key})
        && ($col = $sta->{$key}->{'sta'});
      $tb_run->{$key} = $sta->{$key};
      $tb_sct->{$key} = {};
      ++$cnt;
    }
  }

  # Add the default modules
  if ($cnt)
  { foreach my $key (keys(%{$sta}))
    { next unless $sta->{$key}->{'dft'};
      unless (exists($tb_run->{$key}))
      { $tb_run->{$key} = $sta->{$key};
        ++$cnt;
        $tb_sct->{$key} = {};
      }
    }
  }

  # Return the number of modules queued
  return $cnt;
}

=head2 S<$h-E<gt>collect($name[,$save[,$trace[,section...]]])>

This method collects the diagnostic information for the specified module. When
the data collection is complete, the method deletes all temporary settings
created by the module. If the save flag is set, then the result set definition
file is saved. The C<DEFAULT.B_SAVE> property specifies the default flag value.

When the data collection is complete, the method adds a collect event (type
'C') to the event log including the module completion status. When relevant, it
includes execution statistics as additional events (type 's').

=cut

sub collect
{ my ($slf, $oid, $sav, $trc, @sct) = @_;
  my ($agt, $def, $err, $lng, $mod, $nam, $obj, $rec, $sct, $sta, $val, $ver);

  # Collect the diagnostic data
  $agt = $slf->{'agt'};
  $lng = $agt->get_lang('SDCL');
  if ($obj = $lng->load_package($oid))
  { # Load the current status on first use
    $sta = exists($slf->{'_col'}) ? $slf->{'_col'} : load_collect($slf);

    # Set current context
    $mod = lc($oid = $obj->get_oid);
    $nam = $obj->get_info('nam');
    $rec = $sta->{$mod};
    $obj->set_info('abr', $rec->{'abr'});
    $obj->set_info('lvl', $val)
      if defined($val = $trc)
      || defined($val = $slf->{'sta'}->get_first("$nam.N_TRC"));

    # Delete previous reports
    if ($rec->{'sta'} > 0)
    { $slf->get_output->load_run($nam) if $rec->{'mrc'};
      delete_reports($slf, $rec->{'abr'}, 0);
    }

    # Reset the module statistics
    reset_usage($slf);

    # Perform the data collection
    $def = $slf->{'sta'}->find($rec->{'def'});
    $def->set_value('G_RUN', time);
    $def->set_value('S_RUN', 'obsolete');
    $slf->log_progress($def->get_first('T_DSC'));
    eval {
      $err = get_string('INTERRUPT');
      local $SIG{'INT'} = sub {
        local $SIG{'__WARN__'} = sub {};
        die $err;
        };
      $err = $obj->exec(get_string('ERR_EXEC'), undef, @sct);
      };
    if ($@)
    { $agt->add_error($@);
      $err = 1;
    }
    $sct = $obj->get_info('sct', {});
    $ver = $obj->get_version;
    $slf->log('C', $nam, $ver, $err,
      join(q{,}, sort grep {$sct->{$_} > 0} keys(%{$sct})));

    # Collect the module statistics
    update_usage($slf, $nam, 0, 1);

    # Indicate that the data collection has been done
    unless ($err)
    { delete($sct->{q{-}});
      $def->set_value('V_RUN', $ver, 'Module version');
      if (grep {$sct->{$_} <= 0} keys(%{$sct}))
      { $rec->{'sta'} = $PARTIAL;
        $def->set_value('S_RUN', 'partial');
        $def->set_value('W_SCT', [grep {$sct->{$_} > 0} sort keys(%{$sct})],
          'Sections collected');
        $def->set_value('W_SKP', [grep {$sct->{$_} == 0} sort keys(%{$sct})],
          'Sections skipped');
      }
      else
      { $rec->{'sta'} = $DONE;
        $def->set_value('S_RUN', 'done');
        $def->set_value('W_SCT');
        $def->set_value('W_SKP');
      }
    }

    # Delete the package
    $lng->remove_package($obj);

    # Delete the temporary settings created by the module
    $slf->{'run'}->clean;

    # When requested, save the configuration
    $slf->save if defined($sav) ? $sav : $slf->should_save;

    # Abort in case of error
    $agt->abort if $err;
  }
  else
  { $mod = lc($oid);
  }

  # Remove the entry from the queue
  delete($slf->{'_run'}->{$mod});
  delete($slf->{'_sct'}->{$mod});
  delete($slf->{'_trc'}->{$mod});

  # Indicate a successful completion
  return 1;
}

=head2 S<$h-E<gt>delete_collect($group,$module[,$save])>

This method deletes the table of contents file, all reports, and all catalogs
that are associated with the specified module. The collection status is reset
also.

=cut

sub delete_collect
{ my ($slf, $grp, $mod, $sav) = @_;
  my ($cnt, $itm, $rec, $sta);

  # Get the module information
  $mod = $2 if $mod =~ $RE_TRC;
  ($mod) = split(/-/, $mod, 2);
  $mod = lc($slf->{'cnt'}->get_module('DC', $grp, $mod));

  # Skip modules without data collection
  $sta = exists($slf->{'_col'}) ? $slf->{'_col'} : load_collect($slf);
  return 0 unless exists($sta->{$mod})  ## no critic (Unless)
               && ($rec = $sta->{$mod})->{'sta'} > 0;

  # Remove collected information
  $cnt = delete_reports($slf, $rec->{'abr'}, -1);

  # Adjust the data collection status
  $itm = $slf->{'sta'}->find($rec->{'def'});
  $itm->set_value('G_RUN', time);
  $itm->set_value('S_RUN', 'pending');
  $rec->{'sta'} = $PENDING;

  # Remove statistics
  clear_usage($slf, $rec->{'def'});

  # When requested, save the configuration
  $slf->save if defined($sav) ? $sav : $slf->should_save;

  # Indicate the successful completion
  return $cnt;
}

=head2 S<$h-E<gt>delete_module($request,$group,$module[,$save])>

This method deletes a module and adds an event (type 'D') in the event log.

=cut

sub delete_module
{ my ($slf, $req, $grp, $mod, $sav) = @_;
  my ($def, $itm, $key, $rec, $sta, $val);

  # Get the module information
  $mod = $2 if $mod =~ $RE_TRC;
  ($mod) = split(/-/, $mod, 2);
  $key = lc($mod = $slf->{'cnt'}->get_module('DC', $grp, $mod));

  # Skip modules that are not yet configured
  $sta = exists($slf->{'_col'}) ? $slf->{'_col'} : load_collect($slf);
  return 0 unless exists($sta->{$key});

  # Do not delete modules that must be executed at each run
  $rec = $sta->{$key};
  _display($slf, 'Delete', $rec->{'def'});  # Text:VI_Delete Text:Delete
  if ($rec->{'dft'})
  { $req->add_error(get_string('IS_DEFAULT', $rec->{'def'}));
    return 0;
  }

  # Delete the reports when forced
  if ($rec->{'sta'} > 0 && $req->get_first('force'))
  { delete_reports($slf, $rec->{'abr'}, -1);
    $rec->{'sta'} = $PENDING;
  }

  # Check report presence
  if ($rec->{'sta'} > 0)
  { $req->add_error(get_string('HAS_REPORTS', $rec->{'def'}));
    return 0;
  }

  # Delete the module
  $val = $rec->{'def'};
  delete($sta->{$key});
  foreach my $top (qw(SETUP STATUS USAGE))
  { $itm->clear(1) if ($itm = $slf->{'def'}->find("$top.$val"));
  }

  # Remove the module from the setup queue
  $sta = $slf->{'sta'};
  foreach my $var (qw(R_CFG R_RUN B_SEL N_TRC))
  { delete($sta->tie_value($var, {})->{$mod});
  }
  delete($slf->{'_cfg'}->{$key})
    if exists($slf->{'_cfg'});

  # Add the event
  $slf->log('D', $mod);

  # When requested, save the configuration
  $slf->save if defined($sav) ? $sav : $slf->should_save;

  # Indicate the command completion
  return 1;
}

=head2 S<$h-E<gt>delete_reports($abbreviation[,$mode])>

This method deletes the table of contents file and all reports that are
associated with the specified module. The collection status is reset also.

When the mode is greater than zero, it limits the file remove to cleanup
contexts.

When the mode is zero the report removal is limited to the C<collect>
directory. Otherwise, the cleanup is extended to all relevant subdirectories.

It returns the number of files removed.

=cut

sub delete_reports
{ my ($slf, $abr, $mod) = @_;
  my ($cnt, $dir, $fil);

  $cnt = 0;

  # Limit the file removal to cleanup contexts
  if ($mod && $mod > 0)
  { my ($key, $sta, $tbl);

    $key = $abr;
    $key =~ s/_/./g;
    if (defined($key = $slf->{'sta'}->get_first($key.'M_NAM')))
    { $sta = exists($slf->{'_col'}) ? $slf->{'_col'} : load_collect($slf);
      $key = lc($key);
      return 0 if exists($sta->{$key}) && $sta->{$key}->{'sta'} > 0;
    }
  }

  # Scan the data diagnostic directory to remove catalogs
  if (opendir(DIR, $dir = $slf->{'dat'}))
  { foreach my $fil (readdir(DIR))
    { next unless $fil =~ m/^(\Q$abr\E[A-Z]\.fil)$/i ||
                  $fil =~ m/^(\Q$abr\ET\d*\.(htm|txt|toc))$/i;
      $fil = RDA::Object::Rda->cat_file($dir, $1);
      ++$cnt while unlink($fil);
    }
    closedir(DIR);
  }

  # Scan the collection subdirectories to remove reports
  foreach my $typ (@{$mod ? [qw(C E M R S)] : [qw(C)]})
  { if (opendir(DIR, $dir = $slf->get_dir($typ)))
    { foreach my $fil (readdir(DIR))
      { next unless $fil =~ m/^($abr.*)$/i;
        $fil = RDA::Object::Rda->cat_file($dir, $1);
        ++$cnt while unlink($fil);
      }
      closedir(DIR);
    }
  }

  # Indicate the number of files removed
  return $cnt;
}

=head2 S<$h-E<gt>end_collect([$save])>

This method performs the pending data collection operations. It returns the
number of modules collected.

=cut

sub end_collect
{ my ($slf, $sav) = @_;
  my ($agt, $cnt, $key, $run, $sct, $set, $tbl, $trc);

  # Delete any previous output control
  delete($slf->{'_rpt'})->delete_object if exists($slf->{'_rpt'});

  # Apply the profile setting changes
  $agt = $slf->{'agt'};
  $set = $slf->{'set'};
  if (ref($tbl = $set->get_value('T_PRF')) eq 'HASH')
  { foreach my $key (keys(%{$tbl}))
    { if ($key =~ m/^(\w+)\/(.*)$/)
      { next if $1 eq 'PRF';
        $agt->get_item($1)->set_temp($2, $tbl->{$key});
      }
      else
      { $set->set_temp($key, $tbl->{$key});
      }
    }
  }

  # Execute the data collection modules
  $cnt = 0;
  $run = $slf->{'_run'};
  $sct = $slf->{'_sct'};
  $trc = $slf->{'_trc'};
  $slf->{'_prq'} = {};
  $cnt += collect($slf, $run->{$key}->{'mod'}, $sav, $trc->{$key},
    keys(%{$sct->{$key}})) while defined($key = _next_collect($run));

  # Clean the items and delete the run-time data and reset jobs
  $slf->{'set'}->clean;
  $slf->{'run'}->clear;
  $slf->reset_job;

  # Execute the post-collect steps and save the result set definition
  $slf->save unless ($cnt + $slf->post('POST_COLLECT', $sav)) == 0
                 || defined($sav)
                 || $slf->should_save;

  # Return the number of collected modules
  return $cnt;
}

sub _next_collect
{ my ($tbl) = @_;
  my ($min);

  foreach my $key (keys(%{$tbl}))
  { $min = $key
      unless defined($min)  ## no critic (Unless)
          && $tbl->{$min}->{'seq'} < $tbl->{$key}->{'seq'};
  }
  return $min;
}

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

This method launches the parallel collections.

=cut

sub fork_collect  ## no critic (Complex)
{ my ($slf) = @_;
  my ($dir, $frk, $ifh, $nam, $oid, $pid, $pth, $rec, $run, $sct, $trc);

  return ()
    unless !$slf->{'dft'}->get_first('B_NO_PARALLEL')  ## no critic (Unless)
        && ($frk = $slf->{'cfg'}->can_fork)
        && exists($slf->{'_run'});

  $dir = $slf->get_dir('J', 1);
  $ifh = IO::File->new;
  $oid = $slf->{'oid'};
  $run = $slf->{'_run'};
  $sct = $slf->{'_sct'};
  $trc = $slf->{'_trc'};
  foreach my $key (keys(%{$run}))
  { $rec = $run->{$key};
    next unless $rec->{'frk'}  ## no critic (Unless)
      && !(exists($trc->{$key}) && $trc->{$key});

    # Clear old files
    $pth = RDA::Object::Rda->cat_file($dir, $rec->{'abr'}.$oid);
    1 while unlink("$pth.sta");
    1 while unlink("$pth.tmp");

    # Launch the collection
    last unless defined($pid = fork());
    if (!$pid)
    { my ($buf, $sta, $val);

      # Perform a double fork except when forks are emulated
      unless ($frk < 0)  ## no critic (Unless)
      { exit(1) unless defined($pid = fork());
        if ($pid)
        { _save_pid($ifh, $pth, $pid);
          exit(0);
        }
      }

      # Perform the collection
      $slf->collect($rec->{'mod'}, 0, 0, keys(%{$sct->{$key}}));

      # Save results
      $sta = $slf->{'sta'}->find($nam = $rec->{'def'});
      $buf = q{};
      foreach my $key ('G_RUN',
                       'S_RUN',
                       'T_RUN',
                       $sta->grep('^(T_NOT|N_(ERR|OUT|REQ|SKP))_'))
      { $buf .= "$key='$val'\n"
          if defined($val = $sta->get_first($key));
      }
      if ($ifh->open("$pth.tmp", $CREATE, $FIL_PERMS))
      { $ifh->syswrite($buf, length($buf));
        $ifh->close;
      }
      move("$pth.tmp", "$pth.sta") || copy("$pth.tmp", "$pth.sta");
      exit(0);
    }

    # Determine the fork success
    if ($frk < 0)
    { _save_pid($ifh, $pth, $pid);
    }
    elsif (waitpid($pid, 0) != $pid || $? != 0)
    { next;
    }

    # Indicate that the module is executed in parallel
    $nam = $rec->{'def'};
    delete($run->{$key});
    delete($sct->{$key});
    delete($trc->{$key});
    $slf->{'_prq'}->{$nam} = $pth;
    $slf->log('c', $nam);
    ++$slf->{'_prc'} if exists($slf->{'_prc'});
  }

  # Return the modules executed in parallel
  return (sort keys(%{$slf->{'_prq'}}));
}

sub _save_pid
{ my ($ofh, $pth, $pid) = @_;
  my ($buf);

  if ($ofh->open("$pth.pid", $CREATE, $FIL_PERMS))
  { $buf = "$pid\n";
    $ofh->syswrite($buf, length($buf));
    $ofh->close;
  }
  return;
}

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

This method returns the list of the modules enabled for a data collection.

=cut

sub get_enabled
{ my ($slf) = @_;
  my ($sta, @tbl);

  $sta = exists($slf->{'_col'}) ? $slf->{'_col'} : load_collect($slf);
  foreach my $rec (values(%{$sta}))
  { push(@tbl, $rec->{'mod'}) if $rec->{'sta'};
  }
  return @tbl;
}

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

This method returns the list of collected modules, sorted alphabetically.

=cut

sub get_modules
{ return (sort shift->{'sta'}->grep('^W_ABR$', 'or'));
}

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

This method returns the list of the modules pending on a data collection.

=cut

sub get_pending
{ my ($slf) = @_;
  my ($sta, @tbl);

  $sta = exists($slf->{'_col'}) ? $slf->{'_col'} : load_collect($slf);
  foreach my $rec (values(%{$sta}))
  { push(@tbl, $rec->{'mod'}) if $rec->{'sta'} && $rec->{'sta'} < $DONE;
  }
  return @tbl;
}

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

This method returns the modules present in the run queue, as a list of
abbreviations.

=cut

sub get_queue
{ my ($slf) = @_;
  my ($run);

  $run = $slf->{'_run'};
  return (map {$run->{$_}->{'def'}}
    sort {$run->{$a}->{'seq'} <=> $run->{$b}->{'seq'}} keys(%{$run}));
}

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

This method returns the group titles as a hash reference.

=cut

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

  _get_groups($slf) unless exists($slf->{'_grp'});
  return $slf->{'_grp'}->[1];
}

=head2 S<$h-E<gt>is_collected($name)>

This method indicates whether a data collection step has been done previously.

=cut

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

  $sta = exists($slf->{'_col'}) ? $slf->{'_col'} : load_collect($slf);
  $nam = lc(
    ($nam =~ $RE_ABR &&
      defined($mod = $slf->{'sta'}->get_first("$1.$2.M_NAM"))) ? $mod :
    ($nam !~ $RE_DC &&
      defined($mod = $slf->{'sta'}->get_first("$nam.M_NAM"))) ? $mod :
    $nam);
  return exists($sta->{$nam}) && $sta->{$nam}->{'sta'} > 0;
}

=head2 S<$h-E<gt>is_disabled($name)>

This method indicates whether data collection should be skipped for the
specified module.

=cut

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

  $sta = exists($slf->{'_col'}) ? $slf->{'_col'} : load_collect($slf);
  $nam = lc(
    ($nam =~ $RE_ABR &&
      defined($mod = $slf->{'sta'}->get_first("$1.$2.M_NAM"))) ? $mod :
    ($nam !~ $RE_DC &&
      defined($mod = $slf->{'sta'}->get_first("$nam.M_NAM"))) ? $mod :
    $nam);
  return exists($sta->{$nam}) && $sta->{$nam}->{'sta'} == $SKIP;
}

=head2 S<$h-E<gt>is_done($name)>

This method indicates whether diagnostic information has been collected
effectively for the specified module.

=cut

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

  $sta = exists($slf->{'_col'}) ? $slf->{'_col'} : load_collect($slf);
  $nam = lc(
    ($nam =~ $RE_ABR &&
      defined($mod = $slf->{'sta'}->get_first("$1.$2.M_NAM"))) ? $mod :
    ($nam !~ $RE_DC &&
      defined($mod = $slf->{'sta'}->get_first("$nam.M_NAM"))) ? $mod :
    $nam);
  return exists($sta->{$nam}) && $sta->{$nam}->{'sta'} == $DONE;
}

=head2 S<$h-E<gt>is_enabled($name)>

This method indicates whether data collection is enabled for the specified
module.

=cut

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

  $sta = exists($slf->{'_col'}) ? $slf->{'_col'} : load_collect($slf);
  $nam = lc(
    ($nam =~ $RE_ABR &&
      defined($mod = $slf->{'sta'}->get_first("$1.$2.M_NAM"))) ? $mod :
    ($nam !~ $RE_DC &&
      defined($mod = $slf->{'sta'}->get_first("$nam.M_NAM"))) ? $mod :
    $nam);
  return exists($sta->{$nam}) && $sta->{$nam}->{'sta'};
}

=head2 S<$h-E<gt>is_pending($name)>

This method indicates whether data collection should be done for the specified
module.

=cut

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

  $sta = exists($slf->{'_col'}) ? $slf->{'_col'} : load_collect($slf);
  $nam = lc(
    ($nam =~ $RE_ABR &&
      defined($mod = $slf->{'sta'}->get_first("$1.$2.M_NAM"))) ? $mod :
    ($nam !~ $RE_DC &&
      defined($mod = $slf->{'sta'}->get_first("$nam.M_NAM"))) ? $mod :
    $nam);
  return exists($sta->{$nam}) && $sta->{$nam}->{'sta'} != $SKIP
                              && $sta->{$nam}->{'sta'} != $DONE;
}

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

This method loads the current collection statuses.

=cut

sub load_collect
{ my ($slf, $flg) = @_;
  my ($cur, $mod, $sta, $tbl);

  $slf->{'_col'} = $tbl = {};
  unless ($flg)
  { $sta = $slf->{'sta'};
    foreach my $itm ($sta->grep('S_RUN', 'or'))
    { $cur = $sta->find($itm);
      $mod = $cur->get_first('M_NAM', $itm);
      $tbl->{lc($mod)} = {
        abr => $cur->get_first('W_ABR'),
        def => $itm,
        dft => $cur->get_first('B_DFT'),
        frk => $cur->get_first('B_FRK'),
        mod => $mod,
        mrc => $cur->get_first('B_MRC'),
        seq => $cur->get_first('R_RUN'),
        sta => $tb_sta{lc($cur->get_first('S_RUN'))},
        trg => [$cur->get_value('M_TRG')]};
    }
  }
  return $tbl;
}

=head2 S<$h-E<gt>post($type[,$save])>

This method executes a post treatment. it returns the number of packages
executed.

=cut

sub post
{ my ($slf, $typ, $sav) = @_;
  my ($agt, $cnt, $grp, $lng, $nam, $obj, $set, $sta, @key, @sct);

  # Determine the save mode
  $sav = $slf->should_save unless defined($sav);

  # Execute corresponding modules
  $cnt = 0;
  $set = $slf->{'set'};
  if (@key = $set->grep("^T_$typ", 'r'))
  { $agt = $slf->{'agt'};
    $lng = $agt->get_lang('SDCL');
    $sta = exists($slf->{'_col'}) ? $slf->{'_col'} : load_collect($slf);
    foreach my $key (@key)
    { # Determine group restrictions
      $grp = $key;
      $grp =~ s/\w+$/W_GRP/;
      $grp = [$set->get_value($grp)];

      # Treat all requested packages/sections
      foreach my $arg ($set->set_value($key))
      { ($nam, @sct) = split(/\-/, $arg);
        next unless defined($nam = $lng->norm_package($grp, $nam));

        if ($obj = $sta->{lc($nam)})
        { # Execute a data collection module
          _display($slf, 'Post', $nam);  # Text:VI_Post Text:Post
          $set->set_temp($obj->{'def'}.'.W_FORCE', $typ);
          $slf->collect($nam, $sav, undef, @sct);
          ++$cnt;
        }
        elsif ($nam =~ $RE_DC)
        { die get_string('NO_SETUP', $nam);
        }
        elsif ($obj = $lng->load_package($nam))
        { # Execute the package
          _display($slf, 'Post', $nam);  # Text:VI_Post Text:Post
          $obj->exec(get_string('ERR_EXEC'), undef, @sct);
          $slf->save if $sav;
          ++$cnt;

          # Delete the package
          $lng->remove_package($obj);
        }
      }
    }

    # Delete the temporary settings created during the collection job
    if ($cnt)
    { $slf->{'set'}->clean;
      $slf->{'run'}->clear;
    }
  }

  # Return the number of packages executed
  return $cnt;
}

=head2 S<$h-E<gt>run($request,$group,$tool[,args[,$sections...]])>

This method executes a tool. You can specify the module name and the
sections as arguments or in the request message.

It deletes all temporary settings created by the module.

On execution completion, the method adds a collect event (type C<T>) to the
event log including the module completion status.

It returns a completion message.

=cut

sub run
{ my ($slf, $req, $grp, $mod, $arg, @sct) = @_;
  my ($agt, $err, $lng, $obj, $rsp, $trc, $ver);

  # Resolve module abbreviation
  die get_string('NO_TOOL') unless defined($mod);
  $trc = undef;
  ($mod, $trc) = ($2, $TB_TRC{$1}) if $mod =~ $RE_TRC;
  $mod = $slf->{'cnt'}->get_module('T', $grp, $mod);
  die get_string('BAD_TOOL', $mod) unless $mod =~ $RE_TST;

  # Execute the test module
  $agt = $slf->{'agt'};
  eval {
    $err = get_string('INTERRUPT');
    $lng = $agt->get_lang('SDCL');
    local $SIG{'INT'} = sub {
      local $SIG{'__WARN__'} = sub {};
      die $err;
      };
    $obj = $lng->load_package($mod);
    die get_string('NO_PACKAGE', $mod) unless defined($obj);
    $obj->set_info('lvl', $trc) if defined($trc);
    $obj->exec(get_string('ERR_EXEC'), $arg, @sct);
    $rsp = $obj->get_info('val');
    $ver = $obj->get_info('ver');
    $lng->remove_package($obj);
    };
  $agt->abort($@) if $@;
  $slf->log('T', $mod, $ver);

  # Return the test result
  return (ref($rsp) eq 'RDA::Object::Message')
    ? $rsp
    : $req->new('INFO.NoResponse', last =>
        (ref($rsp) eq 'RDA::Deleted') ? undef
                                      : $rsp);
}

=head2 S<wait_collect([$max])>

This method waits for the completion of the parallel collections. You can
specify a maximum number of wait loops as an argument.

=cut

sub wait_collect
{ my ($slf, $ctx, $max) = @_;
  my ($cnt, $ifh, $pth, %pid);

  # Check the collection completion
  $cnt = 0;
  $ifh = IO::File->new;
  foreach my $nam (keys(%{$slf->{'_prq'}}))
  { $pth = $slf->{'_prq'}->{$nam};
    if (-f "$pth.sta")
    { _load_sta($slf, $nam);
    }
    elsif (-f "$pth.pid")
    { if ($ifh->open("<$pth.pid"))
      { while(<$ifh>)
        { $pid{$nam} = $1 if m/^(\d+)/;
        }
        $ifh->close;
      }
      ++$cnt;
    }
    else
    { delete($slf->{'_prq'}->{$nam});
    }
  }
  return 0 unless $cnt;

  # Wait for the collection completion
  $max = 0 unless defined($max) && $max > 0;  ## no critic (Unless)
  for(;;)                                     ## no critic (Loop)
  { $cnt = 0;
    foreach my $nam (keys(%{$slf->{'_prq'}}))
    { if (!kill(0, $pid{$nam}) || -f $slf->{'_prq'}->{$nam}.'.sta')
      { _load_sta($slf, $nam);
      }
      else
      { ++$cnt;
      }
    }
    return 0 unless $cnt;
    return 1 if $max < 0;
    --$max if $max;
    sleep(1);
  }
  return;
}

sub _load_sta
{ my ($slf, $nam) = @_;
  my ($ifh, $pth, $sta);

  # Update the settings
  $ifh = IO::File->new;
  $pth = delete($slf->{'_prq'}->{$nam});
  $sta = $slf->{'sta'}->find($nam);
  if ($ifh->open("<$pth.sta"))
  { while (<$ifh>)
    { $sta->set_value($1, $2)
        if m/^(\w+)='(.*)'/;
    }
    $ifh->close;
  }

  # Clear the module files
  1 while unlink("$pth.pid");
  1 while unlink("$pth.sta");
  1 while unlink("$pth.tmp");
  return;
}

=head1 DEFINITION MANAGEMENT METHODS

=head2 S<$h-E<gt>clear([$flag])>

This method clears the item object. Unless the flag is set, it clears its
subobjects.

=cut

sub clear
{ my ($obj, $flg);

  $obj->clear($flg) if ($obj = shift->{'def'}->find(@_));
  return;
}

=head2 S<$h-E<gt>clear_temp($name)>

This method restores the original object property value. It returns that value,
or an undefined value if not previously defined. When executed in an array
context, it returns the results as a list.

=cut

sub clear_temp
{ return shift->{'def'}->clear_temp(@_);
}

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

This method extracts the recorded changes from the definition.

=cut

sub extract
{ return shift->{'def'}->extract;
}

=head2 S<$h-E<gt>find($oid[,$flag])>

This method finds a reference to the specified definition object. When the flag
is set, the objects are automatically created. It returns an undefined value
when the object cannot be found.

=cut

sub find
{ return shift->{'def'}->find(@_);
}

=head2 S<$h-E<gt>get_change($name[,$default])>

This method returns a profile value.

=cut

sub get_change
{ my ($slf, $nam, $dft) = @_;
  my ($key, $tbl);

  $key = 'PRF/'.uc($nam);
  $dft = $tbl->{$key}
    if ref($tbl = $slf->{'set'}->get_value('T_PRF')) eq 'HASH'
    && exists($tbl->{$key});
  if (wantarray)
  { return @{$dft} if ref($dft) eq 'ARRAY';
    return ($dft)  if defined($dft);
    return ();
  }
  return $dft;
}

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

This method returns a reference to the result set definition item.

=cut

sub get_definition
{ return shift->{'def'};
}

=head2 S<$h-E<gt>get_desc($name[,$default])>

This method returns the description of the given result set definitions
property. When the property or its description does not exist, it returns the
default value.

=cut

sub get_desc
{ return shift->{'def'}->get_desc(@_);
}

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

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

=over 8

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

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

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

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

=item S<    B<'L'>> Returns the property value using C<get_local>.

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

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

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

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

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

=item S<    B<'l'>> Same as C<L> but disables the value validation.

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

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

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

=back

=cut

sub get_element
{ return shift->{'def'}->get_element(@_);
}

=head2 S<$h-E<gt>get_first($name[,$default[,$flag]])>

This method returns the first value of a result set definition property or the
default value when the property is not defined.

When an array reference is provided as the name, it returns the value of the
first defined attribute from that list.

When the flag is set, it disables the value validation.

=cut

sub get_first
{ return shift->{'def'}->get_first(@_);
}

=head2 S<$h-E<gt>get_item($abbreviation)>

This method returns a reference to the item corresponding to the external
reference.

=cut

sub get_item
{ return shift->{'agt'}->get_item(@_);
}

=head2 S<$h-E<gt>get_local($name[,$default[,$flag]])>

This method returns the value of the given object property in local
format. When the property does not exist, it returns the default value.

When an array reference is provided as the name, it returns the value of the
first defined attribute from that list.

When the flag is set, it disables the value validation.

When executed in an array context, it returns the results as a list.

=cut

sub get_local
{ return shift->{'def'}->get_local(@_);
}

=head2 S<$h-E<gt>get_primary($name[,$default[,$flag]])>

This method returns the first value of the given object property in local
format. When the property does not exist, it returns the default value.

When an array reference is provided as the name, it returns the value of the
first defined attribute from that list.

When the flag is set, it disables the value validation.

=cut

sub get_primary
{ return shift->{'def'}->get_primary(@_);
}

=head2 S<$h-E<gt>get_prime($name[,$default[,$flag]])>

This method returns the first value of the given object property. It extends
the property search to item properties. When the property does not exist, it
returns the default value.

When the flag is set, it disables the value validation.

=cut

sub get_prime
{ return shift->{'def'}->get_prime(@_);
}

=head2 S<$h-E<gt>get_property($name[,$default[,$flag]])>

This method returns the value of the given object property. It extends the
property search to item properties. When the property does not exist, it
returns the default value.

When the flag is set, it disables the value validation.

=cut

sub get_property
{ return shift->{'def'}->get_property(@_);
}

=head2 S<$h-E<gt>get_text($name[,$default[,$flag]])>

This method returns the value of the given object property. It transforms the
Boolean values, the GMT time stamps, and item references in a textual
representation. When the property does not exist, it returns the default value.

When an array reference is provided as the name, it returns the value of the
first defined attribute from that list.

When the flag is set, it disables the value validation.

When executed in an array context, it returns the results as a list.

=cut

sub get_text
{ return shift->{'def'}->get_text(@_);
}

=head2 S<$h-E<gt>get_value($name[,$default[,$flag]])>

This method returns the value of the given result set definition property. When
the property does not exist, it returns the default value.

When an array reference is provided as the name, it returns the value of the
first defined attribute from that list.

When the flag is set, it disables the value validation.

When executed in an array context, it returns the results as a list.

=cut

sub get_value
{ return shift->{'def'}->get_value(@_);
}

=head2 S<$h-E<gt>grep($re[,$flag])>

This method returns the definition property names that match the regular
expression. It supports the following options:

=over 9

=item B<    'f' > Stops scanning on the first match.

=item B<    'o' > Returns object names instead of property names.

=item B<    'r' > Looks recursively in subobjects.

=item B<    'v' > Inverts the sense of matching to select non-matching lines.

=back

=cut

sub grep  ## no critic (Builtin)
{ return shift->{'def'}->grep(@_);
}

=head2 S<$h-E<gt>set_desc($name,$text)>

This method associates a description text to an existing result set definition
property. When an undefined text is provided, the description is deleted. It
returns the previous description.

=cut

sub set_desc
{ return shift->{'def'}->set_desc(@_);
}

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

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

=over 8

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

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

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

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

=back

=cut

sub set_element
{ return shift->{'def'}->set_element(@_);
}

=head2 S<$h-E<gt>set_temp($name[,$value])>

This method assigns a temporary value to a definition property. When an
undefined value is provided, the property is temporarily deleted.

It returns the previous value, or an undefined value if not previously
defined. When executed in an array context, it returns the results as a list.

=head2 S<$h-E<gt>set_temp($name[,$value,...])>

You can also pass a list of values as multiple arguments instead of an array
reference.

=cut

sub set_temp
{ return shift->{'def'}->set_temp(@_);
}

=head2 S<$h-E<gt>set_value($name[,$value[,$description]])>

This method assigns a new value to a definition property or creates a new
result set definition property. When an undefined value is provided, the
property is deleted.

It returns the previous value. When the result set definition property is not
defined, it returns an undefined value.

When executed in an array context, it returns the result as a list.

=cut

sub set_value
{ return shift->{'def'}->set_value(@_);
}

=head2 S<$h-E<gt>tie_value($name[,$default])>

This method returns the value of the given definition property. When the
property does not exist, it assigns the default value to it.

=cut

sub tie_value
{ return shift->{'def'}->tie_value(@_);
}

=head2 S<$h-E<gt>untie_value($name)>

This method unties the value of the given object property.

=cut

sub untie_value
{ return shift->{'def'}->untie_value(@_);
}

=head1 FILE MANAGEMENT METHODS

This section regroups methods for managing files related to RDA collections
that are based on subdirectory types.

Valid subdirectory types for collection files are:

=over 7

=item B<    A > For the C<archive> subdirectory

=item B<    C > For the C<collect> subdirectory

=item B<    E > For the C<extern> subdirectory

=item B<    M > For the multi-run collections (C<mrc> subdirectory)

=item B<    P > For the remote packages (C<remote> subdirectory)

=item B<    R > For the C<ref> subdirectory

=item B<    S > For the C<sample> subdirectory

=item B<    X > For the transfer subdirectory

=back

Valid subdirectory types for other files are:

=over 7

=item B<    B > For the sandbox subdirectory

=item B<    I > For the inline code subdirectory

=item B<    J > For the job subdirectory

=item B<    L > For the lock subdirectory

=item B<    T > For the temporary subdirectory

=back

=head2 S<$h-E<gt>get_absolute($type,$file[,$flag])>

This method returns the absolute path of the file. When the flag is set, it
creates missing directories also.

=cut

sub get_absolute
{ my ($slf, $typ, $fil, $flg) = @_;

  return RDA::Object::Rda->cat_file($slf->{'cfg'}->get_group('D_CWD'),
    $slf->get_dir($typ, $flg), $fil);
}

=head2 S<$h-E<gt>get_dir($type[,$flag])>

This method returns the path of the directory for the specified type. When the
flag is set, it creates missing directories also.

=cut

sub get_dir
{ my ($slf, $typ, $flg) = @_;
  my ($pth, $rec, $skp);

  # Validate the request
  $slf->{'agt'}->abort(get_string('BAD_DIRECTORY', $typ))
    unless exists($slf->{'_typ'}->{$typ});
  $rec = $slf->{'_typ'}->{$typ};

  # Determine the report subdirectory
  $pth = exists($slf->{'_out'}->{$typ})
    ? $slf->{'_out'}->{$typ}
    : _get_dir($slf, $typ, $rec->[0]);

  # Create the report subdirectory when needed
  if ($flg && ! -d $pth)
  { $skp = $rec->[0] ne 'COL' || -d $slf->{'dat'};
    RDA::Object::Rda->create_dir($pth, $DIR_PERMS, 0,
      $slf->{'agt'}->should_align, $rec->[1]);
    $slf->{'log'}->start unless $skp;
  }

  # Return the report subdirectory
  return $pth;
}

sub _get_dir
{ my ($slf, $typ, $str) = @_;
  my ($pth);

  $pth = ($str ne 'COL') ?
           RDA::Object::Rda->cat_dir($slf->get_temp,
             $str.q{_}.$slf->{'oid'}) :
         defined($str = $slf->get_sub($typ)) ?
           RDA::Object::Rda->cat_dir($slf->{'dat'}, $str) :
         $slf->{'dat'};
  RDA::Object::Rda->clean_dir($pth) if $typ eq 'T' && -d $pth;
  return $slf->{'_out'}->{$typ} = $pth;
}

=head2 S<$h-E<gt>get_name($type,$file)>

This method returns the name of the collection report.

=cut

sub get_name
{ my ($slf, $typ, $fil) = @_;
  my ($str);

  $slf->{'agt'}->abort(get_string('BAD_SUB', $typ))
    unless exists($slf->{'_sub'}->{$typ});
  return defined($str = $slf->{'_sub'}->{$typ})
    ? join(q{/}, $str, $fil)
    : $fil;
}

=head2 S<$h-E<gt>get_relative($type,$file[,$flag])>

This method returns the relative path of the file. When the flag is set, it
creates missing directories also.

=cut

sub get_relative
{ my ($slf, $typ, $fil, $flg) = @_;

  return RDA::Object::Rda->cat_file($slf->get_dir($typ, $flg), $fil);
}

=head2 S<$h-E<gt>get_sub($type)>

This method returns the name of the report subdirectory for the specified
type. It returns an undefined value when not applicable.

=cut

sub get_sub
{ my ($slf, $typ) = @_;

  return exists($slf->{'_sub'}->{$typ}) ? $slf->{'_sub'}->{$typ} : undef;
}

=head2 S<$h-E<gt>has_dir($type)>

This method indicates whether the directory for the specified type has been
requested.

=cut

sub has_dir
{ my ($slf, $typ) = @_;

  return exists($slf->{'_out'}->{$typ}) ? $slf->{'_out'}->{$typ} : undef;
}

=head1 JOB MANAGEMENT METHODS

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

This method clears the job identifier.

=cut

sub clear_job
{ return shift->{'job'} = q{};
}

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

This method returns a new job identifier.

=cut

sub get_job
{ my ($slf) = @_;
  my ($str, $val);

  # Abort nested jobs
  die get_string('IN_JOB') if $slf->{'job'};

  # Clear previous files used for transfering thread information
  _load_job($slf, $tb_job{'clr'}) unless $slf->{'_job'};

  # Return the next job identifier
  ## no critic (Bit)
  $str = q{};
  $val = ++$slf->{'_job'};
  do
  { $str .= chr(64 + ($val & 15));
    $val >>= 4;
  } while $val;
  return $str;
}

=head2 S<$h-E<gt>load_job($type[,$output])>

This method loads job information.

=cut

sub load_job
{ my ($slf, $typ, $out) = @_;

  _load_job($slf, $tb_job{$typ}, $out)
    if exists($tb_job{$typ}) && ($out || !$slf->{'_job'});
  return;
}

sub _load_job
{ my ($slf, $tbl, $out) = @_;
  my ($dir, $nam, $pth, $trc);

  $nam = $slf->{'oid'};
  $trc = $slf->get_trace('JOB');
  $dir = $slf->get_dir('J');
  if (opendir(JOB, $dir))
  { foreach my $fil (sort readdir(JOB))
    { next unless $fil =~ m/^($nam\_[A-Z]+\.(cfg|out|use))$/i;
      $pth = RDA::Object::Rda->cat_file($dir, $1);
      &{$tbl->{$2}}($slf, $pth, $out);
      unless ($trc)
      { 1 while unlink($pth);
      }
    }
    closedir(JOB);
  }
  $out->check_free(0) if $out;
  return;
}

sub _load_job_cfg
{ my ($slf, $pth) = @_;
  my ($ifh);

  $slf->{'def'}->patch($ifh)
    if ($ifh = IO::File->new)->open("<$pth");
  return;
}

sub _load_job_out
{ my ($slf, $pth, $out) = @_;
  my ($ifh);

  $out->load($ifh)
    if $out && ($ifh = IO::File->new)->open("<$pth");
  return;
}

sub _load_job_use
{ my ($slf, $pth) = @_;
  my ($ifh);

  $slf->load_usage($ifh)
    if ($ifh = IO::File->new)->open("<$pth");
  return;
}

sub _skip_job
{ return;
}

=head2 S<$h-E<gt>prefix_job($nam)>

This method returns the path to a job file.

=cut

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

  return RDA::Object::Rda->cat_file($slf->get_dir('J', 1),
    $slf->get_agent('oid').$nam)
}

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

This method clears the job identifier and reset the job sequencer.

=cut

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

  $slf->{'job'} = q{};
  $slf->{'_job'} = 0;
  return;
}

=head2 S<$h-E<gt>set_job($job)>

This method stores the job identifier specified as an argument.

=cut

sub set_job
{ my ($slf, $job) = @_;

  return $slf->{'job'} = $job;
}

=head1 LOG FILE MANAGEMENT METHODS

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

This method returns a reference to the log object.

=cut

sub get_log
{ return shift->{'log'};
}

=head2 S<$h-E<gt>log($typ[,$arg...])>

This method logs an event in the event log. It prefixes event records with a
time stamp (GMT) and the setup name. The fields are separated by a C<|>
character.

It stores the event if the log file is not currently open.

It returns an undefined value if the type does not contain ASCII letters
only. Otherwise, it returns the number of events effectively in the log file.

=cut

sub log  ## no critic (Builtin)
{ return shift->{'log'}->log(@_);
}

=head2 S<$h-E<gt>log_end($blk,$arg...)>

This method logs the duration of a command execution.

=cut

sub log_end
{ my ($slf, $blk, @arg) = @_;

  $slf->{'log'}->log('x', $blk->get_top->get_oid,
    $blk->get_package('oid'), time - delete($slf->{'_beg'}), @arg)
    if exists($slf->{'_beg'});
  return;
}

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

This method records the command start.

=cut

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

  return $slf->{'_beg'} = time;
}

=head2 S<$h-E<gt>log_timeout($blk,$typ[,$arg...])>

This method logs a timeout event in the event log.

=cut

sub log_timeout
{ my ($slf, $blk, $typ, @arg) = @_;
  my ($out, $rpt, $top);

  $top = $blk->get_top;
  if (defined($out = $top->get_info('rpt')))
  { $rpt = $out->get_info('cur');
    $slf->{'log'}->log('t', $top->get_oid,
      ref($rpt) ? $rpt->get_path : $blk->get_package('oid'), $typ,
      map {$out->filter($_)} @arg)
  }
  else
  { $slf->{'log'}->log('t', $top->get_oid, $blk->get_package('oid'), $typ,
      @arg);
  }
  return;
}

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

This method suspends event logging and closes the log file.

=cut

sub suspend_log
{ return shift->{'log'}->suspend;
}

=head1 PROGRESS MANAGEMENT METHODS

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

This methods ends progress reporting.

=cut

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

  delete($slf->{'_prh'})->close if exists($slf->{'_prh'});
  return;
}

=head2 S<$h-E<gt>log_progress($text)>

This method logs progress.

=cut

sub log_progress
{ my ($slf, $txt) = @_;

  if (exists($slf->{'_prh'}))
  { my ($buf);

    $buf = (ref($txt) eq 'ARRAY')
      ? join(q{}, @{$txt})
      : sprintf($slf->{'_prf'}, ++$slf->{'_prc'}, $slf->{'_prm'}, $txt);
    $slf->{'_prh'}->syswrite($buf, length($buf));
  }
  return;
}

=head2 S<$h-E<gt>reset_progress([$add])>

This methods adjusts the maximum based on the modules to collect and the number
of additional steps.

=cut

sub reset_progress
{ my ($slf, $add) = @_;

  $slf->{'_prm'} = $slf->{'_prc'} + (scalar $slf->get_enabled)
    + (defined($add) ? $add : 0) if exists($slf->{'_prh'});
  return;
}

=head2 S<$h-E<gt>set_progress($ofh,$fmt)>

This methods activates the progress reporting.

=cut

sub set_progress
{ my ($slf, $ofh, $fmt) = @_;

  $slf->{'_prc'} = 0;
  $slf->{'_prf'} = $fmt;
  $slf->{'_prh'} = $ofh;
  $slf->{'_prm'} = q{?};
  return;
}

=head1 RENDER MANAGEMENT METHODS

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

This method renders all pending reports. It returns the list of the reports
that have been rendered.

=cut

sub render
{ return shift->{'agt'}->submit(q{.}, 'RENDER.GEN_HTML')->get_value('reports');
}

=head1 SETUP MANAGEMENT METHODS

=head2 S<$h-E<gt>add_setup($group,$selected,$flag[,$module...])>

This method adds modules to the setup queue. Unless the flag is set, it skips
modules already configured. It returns the number of modules added to the setup
queue.

=cut

sub add_setup
{ my ($slf, $grp, $sel, $flg, @arg) = @_;
  my ($cnt, $def, $dir, $dsc, $fil, $mod, $seq, $sta, $sub, $trc,
      $tb_cfg, $tb_run, $tb_sel, $tb_trc);

  # Initialization
  $dir = $slf->{'dir'};
  $sta = $slf->{'sta'};
  $tb_cfg = $sta->tie_value('R_CFG', {});
  $tb_run = $sta->tie_value('R_RUN', {});
  $tb_sel = $sta->tie_value('B_SEL', {});
  $tb_trc = $sta->tie_value('N_TRC', {});
  load_setup($slf) unless exists($slf->{'_cfg'});

  # Add the modules to the setup queue
  $cnt = 0;
  foreach my $arg (@arg)
  { # Get the module information
    ($mod, $trc) = ($arg, undef);
    ($mod, $trc) = ($2, $TB_TRC{$1}) if $mod =~ $RE_TRC;
    ($mod) = split(/-/, $mod, 2);
    $mod = $slf->{'cnt'}->get_module('DC', $grp, $mod);
    next unless $mod =~ $RE_DC && $2;
    ($sub, $fil) = ($2, "DC$3.ctl");

    # Reject pending and configured modules
    if (exists($tb_cfg->{$mod}))
    { $tb_trc->{$mod} = $trc unless defined($trc)  ## no critic (Unless)
        && exists($tb_trc->{$mod}) && $trc <= $tb_trc->{$mod};
      next;
    }
    next if !$flg && exists($slf->{'_cfg'}->{lc($mod)});
    ($seq, $dsc) = $slf->{'cnt'}->get_sequence(RDA::Object::Rda->cat_file($dir,
      $sub, $fil));
    next unless defined($dsc);

    # Adjust the sequence number
    ## no critic qw(Mismatch,Number)
    $def = load_group($slf, $sub);
    if ($seq =~ m/^(E)?(\d{3})(\/(E)?(\d{3}))?$/)
    { $tb_cfg->{$mod} =
        $def->get_first($1 ? ['N_END', 'N_CFG'] : 'N_CFG', 500) + "0.$2";
      $tb_run->{$mod} = defined($3)
        ? $def->get_first($4 ? ['N_END', 'N_RUN'] : 'N_RUN', 500) + "0.$5"
        : $def->get_first($1 ? ['N_END', 'N_RUN'] : 'N_RUN', 500) + "0.$2";
    }
    else
    { $tb_cfg->{$mod} = $def->get_first('N_CFG', 500) + 0.5;
      $tb_run->{$mod} = $def->get_first('N_RUN', 500) + 0.5;
    }
    $tb_sel->{$mod} = $sel;
    $tb_trc->{$mod} = $trc if defined($trc);
    ++$cnt;
  }

  # Return the number of modules queued
  return $cnt;
}

=head2 S<$h-E<gt>end_setup([$save])>

This method performs the pending setup operations. It returns the number of
modules configured.

=cut

sub end_setup
{ my ($slf, $sav) = @_;
  my ($agt, $cnt, $nam, $nxt, $sel, $set, $sta, $tbl, $trc);

  # Force the creation of the collector
  _create($slf) if $slf->{'_new'};

  # Apply the profile setting changes
  $agt = $slf->{'agt'};
  $set = $slf->{'set'};
  if (ref($tbl = $set->get_value('T_PRF')) eq 'HASH')
  { foreach my $key (keys(%{$tbl}))
    { if ($key =~ m/^(\w+)\/(.*)$/)
      { next if $1 eq 'PRF';
        $agt->get_item($1)->set_temp($2, $tbl->{$key});
      }
      else
      { $set->set_temp($key, $tbl->{$key});
      }
    }
  }

  # Perform pending setup operations
  $cnt = 0;
  $sta = $slf->{'sta'};
  if (ref($nxt = $sta->tie_value('R_CFG')) eq 'HASH')
  { $sel = $sta->tie_value('B_SEL', {});
    $trc = $sta->tie_value('N_TRC', {});
    $cnt += setup($slf, [], $nam, $sav, $trc->{$nam}, $sel->{$nam})
      while defined($nam = _next_setup($nxt));
    $slf->{'def'}->set_value('OUTPUT.B_CLEAN', 1, $DSC_CLN);
  }

  # Execute the post-setup steps and save the result set definition
  $slf->save unless ($cnt + $slf->post('POST_SETUP', $sav)) == 0
                 || defined($sav)
                 || $slf->should_save;

  # Return the number of modules configured
  return $cnt;
}

sub _next_setup
{ my ($tbl) = @_;
  my ($min, $mod);

  foreach my $key (keys(%{$tbl}))
  { ($mod, $min) = ($key, $tbl->{$key})
      unless defined($mod) && $min < $tbl->{$key};  ## no critic (Unless)
  }
  return $mod;
}

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

This method returns the list of module groups ordered by their collection
sequence.

=cut

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

  _get_groups($slf) unless exists($slf->{'_grp'});
  return @{$slf->{'_grp'}->[0]};
}

sub _get_groups
{ my ($slf) = @_;
  my ($cur, $def, %seq, %ttl);

  # Get the group information
  $def = $slf->{'def'}->find('GROUP', 1);
  foreach my $nam ($def->grep('^T_TTL$', 'or'))
  { $cur = $def->find($nam);
    $seq{$nam} = $cur->get_first('N_CFG');
    $ttl{$nam} = $cur->get_first('T_TTL');
  }

  # Sort the groups
  return $slf->{'_grp'} =
    [[sort {$seq{$a} <=> $seq{$b} || $a cmp $b} keys(%seq)], \%ttl];
}

=head2 S<$h-E<gt>get_members($group)>

This method returns the list of the configured modules in the specified group,
sorted by their configuration sequence.

=cut

sub get_members
{ my ($slf, $grp) = @_;
  my ($seq, %tbl);

  foreach my $obj ($slf->{'sta'}->find($grp, 1)->get_childs)
  { $tbl{$obj->get_oid} = $seq if defined($seq = $obj->get_first('R_CFG'));
  }
  return (sort {$tbl{$a} <=> $tbl{$b}} keys(%tbl));
}

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

This method returns the list of profile modules.

=cut

sub get_profile
{ return shift->{'set'}->get_value('M_PRF');
}

=head2 S<$h-E<gt>is_configured($name)>

This method indicates if a module is configured already.

=cut

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

  load_setup($slf) unless exists($slf->{'_cfg'});
  return exists($slf->{'_cfg'}->{lc(($nam =~ $RE_DC)
    ? $nam
    : $slf->{'cnt'}->get_module('DC', [], $nam))});
}

=head2 S<$h-E<gt>load_group($group)>

This method loads the definition of the specified group and returns a reference
to its definition item.

=cut

sub load_group
{ my ($slf, $grp) = @_;
  my ($def, $nam, $ifh);

  # Check for an existing group definition
  return $def if defined($def = $slf->find($nam = "GROUP.$grp"));

  # Load the group definition
  $ifh = IO::File->new;
  if ($ifh->open('<'.RDA::Object::Rda->cat_file($slf->{'dir'}, $grp,
    'group.cfg')))
  { $slf->{'agt'}->trace(get_string('LoadGroup', $nam))
      unless $slf->{'lvl'} < 20;  ## no critic (Unless)
    $slf->find('GROUP', 1)->load($ifh);
  }
  $def = $slf->find($nam, 1);

  # Create a group by default
  unless ($def->is_defined('N_CFG'))
  { $slf->{'agt'}->trace(get_string('CreateGroup', $nam))
      unless $slf->{'lvl'} < 20;  ## no critic (Unless)
    $def->set_value('N_CFG', 500,                       $tb_dsc{'N_CFG'});
    $def->set_value('N_RUN', 500,                       $tb_dsc{'N_RUN'});
    $def->set_value('N_END', 500,                       $tb_dsc{'N_END'});
    $def->set_value('T_TTL', 'Oracle Product Settings', $tb_dsc{'T_TTL'});
  }
  else
  { # Add missing descriptions
    foreach my $key (keys(%tb_dsc))
    { $def->needs_desc($key, $tb_dsc{$key});
    }
  }

  # Return a reference to the group definition
  return $def;
}

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

This method loads the current setup statuses.

=cut

sub load_setup
{ my ($slf, $flg) = @_;
  my ($cur, $sta, $tbl);

  $slf->{'_cfg'} = $tbl = {};
  unless ($flg)
  { $sta = $slf->{'sta'};
    foreach my $itm ($sta->grep('S_CFG', 'or'))
    { $cur = $sta->find($itm);
      $tbl->{lc($cur->get_first('M_NAM', $itm))} =
        $tb_sta{lc($cur->get_value('S_CFG'))};
    }
  }
  return $tbl;
}

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

This method indicates whether some setup is still needed.

=cut

sub need_setup
{ return scalar keys(%{shift->{'sta'}->tie_value('R_CFG', {})});
}

=head2 S<$h-E<gt>set_profile($definition)>

This method specifies a new collection profile. It returns the previous
profile values.

=cut

sub set_profile
{ my ($slf, $def) = @_;
  my ($set, $tgt);

  # In a new collector, include the profile targets
  if ($slf->{'_new'})
  { foreach my $key (keys(%{$tgt = $def->get_targets({})}))
    { eval {_add_target($slf, $2, $key, $tgt->{$key})}
        if $key =~ m/^(\w+\.)*([A-Z]{2,})_\w*P\d+$/;
    }
  }

  # Store the profile definition
  $set = $slf->{'set'};
  $set->set_value('B_PRF', $def->get_types,     'Profile type list');
  $set->set_value('K_PRF', [$def->get_names],   'Specified profiles');
  $set->set_value('M_PRF', [$def->get_modules], 'Profile collection list');
  $set->set_value('N_PRF', $def->get_levels,    'Profile level alterations');
  $set->set_value('T_PRF', $def->get_changes,   'Profile values');
  return;
}

=head2 S<$h-E<gt>setup($group,$name[,$save[,$trace[,$selected]]])>

This method performs the setup of the specified data collection module. It
returns the number of modules configured.

=cut

sub setup
{ my ($slf, $grp, $oid, $sav, $trc, $sel) = @_;
  my ($bkp, $cnt, $lng, $mod, $nam, $obj, $ref, $sta, $use, $val, @dep);

  # Determine if the definition file must save at setup end
  $sav = $slf->should_save unless defined($sav);

  # Load the current status on first use
  $sta = exists($slf->{'_cfg'}) ? $slf->{'_cfg'} : load_setup($slf);

  # Perform the module setup
  $cnt = 0;
  $lng = $slf->{'agt'}->get_lang('SDSL');
  $ref = ref($obj = $lng->search_package($grp, $oid));
  if ($ref eq 'ARRAY')
  { # Declare the module
    $mod = lc($oid = RDA::SDSL::Module::declare($slf, @{$obj}));
    _display($slf, 'Setup', $oid);  # Text:VI_Setup Text:Setup
    $sta->{$mod} = $DONE;
    ++$cnt;

    # When requested, save the configuration
    $slf->save if $sav;
  }
  elsif ($ref eq 'RDA::SDSL::Module')
  { # Set current context
    $grp = $obj->get_info('grp');
    $mod = lc($oid = $obj->get_oid);
    $nam = $obj->get_info('nam');
    $obj->set_info('lvl', $val)
      if defined($val = $trc)
      || defined($val = $slf->{'sta'}->get_first("$nam.N_TRC"));

    # Perform prerequisites and module setup
    ($sta->{$mod}, $val) = ($PARTIAL, $sta->{$mod});
    eval {
      # Treat the prerequisites
      if (@dep = map {$lng->norm_package($grp, $_)} $obj->get_pre)
      { add_setup($slf, [], 0, 0, @dep);
        foreach my $dep (@dep)
        { $cnt += setup($slf, $grp, $dep, $sav, undef, 0)
            unless exists($sta->{lc($dep)});
        }
      }
      };
    if (defined($val))
    { $sta->{$mod} = $val;
    }
    else
    { delete($sta->{$mod});
    }
    die $@ if $@;

    # Abort the setup to consider setup queue changes
    if ($cnt)
    { $obj->delete_object;
      return $cnt;
    }

    # Setup the module
    _display($slf, 'Setup', $oid);  # Text:VI_Setup Text:Setup
    $bkp = $lng->set_usage($use = {});
    $cnt += $obj->setup($sel);
    $lng->set_usage($bkp);
    $sta->{$mod} = $DONE;
    $slf->log('S', $nam, $obj->get_version);
    foreach my $oid (keys(%{$use}))
    { $slf->log('r', $oid, $use->{$oid});
    }

    # Delete the module
    $obj->delete_object;

    # When requested, save the configuration
    $slf->save if $sav;
  }
  else
  { $mod = lc($oid = join (q{:}, @{$grp}, $oid));
    _display($slf, 'Skip', $oid);  # Text:VI_Skip Text:Skip
    foreach my $key (qw(R_CFG R_RUN B_SEL N_TRC))
    { delete($slf->{'sta'}->tie_value($key, {})->{$oid});
    }
    $sta->{$mod} = $SKIP;
  }

  # Delete the collection status and group caches
  delete($slf->{'_col'});
  delete($slf->{'_grp'});

  # Return the number of packages configured
  return $cnt;
}

=head1 TARGET MANAGEMENT METHODS

=head2 S<$h-E<gt>find_item($type,$key,$value[,$flag])>

This method returns the definition of the first target that contains the
specified property value. You can specify C<.> as key to search based on the
target identifier. Otherwise it returns an undefined value.

When the flag is set, it disables the value validation.

=head2 S<$h-E<gt>find_item($type,{$key=>$value...}[,$flag])>

This method returns the definition of the first target that contains all
specified property values. Otherwise it returns an undefined value.

By default, it restricts the search to shared targets.

When the flag is set, it disables the value validation.

=head2 S<$h-E<gt>find_item($type,[$key=>$value...][,$flag])>

This method returns the definition of the first target that contains any of the
specified property values. Otherwise it returns an undefined value.

When the flag is set, it disables the value validation.

=cut

sub find_item  ## no critic (Complex)
{ my ($slf, $typ, $qry, @arg) = @_;
  my ($cur, $flg, $prv, $ref, $tbl, $val);

  # Validate the type
  die get_string('BAD_TYPE') unless $typ && $typ =~ $RE_TYP;

  # Search the item
  $ref = ref($qry);
  if ($ref eq 'ARRAY')
  { my ($key);

    # Search for any of property values
    $flg = shift(@arg);
    $tbl = _get_items($slf, uc($typ));
    foreach my $obj (values(%{$tbl}))
    { @arg = @{$qry};
      while (($key, $val) = splice(@arg, 0, 2))
      { return $obj
          if defined($val)
          && defined($cur = $obj->get_first($key, undef, $flg))
          && $cur eq $val;
      }
    }
  }
  elsif ($ref eq 'HASH')
  { # Search for a group of property values
    $flg = shift(@arg);
    $prv = !exists($qry->{'B_DEDICATED'});
    $tbl = _get_items($slf, uc($typ));
    ITEM: foreach my $obj (values(%{$tbl}))
    { next if $prv && $obj->get_first('B_DEDICATED');
      foreach my $key (keys(%{$qry}))
      { next      unless defined($val = $qry->{$key});
        next ITEM unless defined($cur = $obj->get_first($key, undef, $flg))
                      && $cur eq $val;
      }
      return $obj;
    }
  }
  elsif (!$ref && defined($val = shift(@arg)))
  { # Search for the specified property value
    $flg = shift(@arg);
    $tbl = _get_items($slf, uc($typ));
    if ($qry eq q{.})
    { return $tbl->{$val} if exists($tbl->{$val});
    }
    else
    { foreach my $obj (values(%{$tbl}))
      { next if $obj->get_first('B_DEDICATED');
        return $obj
          if defined($cur = $obj->get_first($qry, undef, $flg))
          && $cur eq $val;
      }
    }
  }
  return;
}

=head2 S<$h-E<gt>get_items($type)>

This method returns the references to all target definitions from the specified
type.

=cut

sub get_items
{ my ($slf, $typ) = @_;
  my ($tbl);

  # Validate the type
  die get_string('BAD_TYPE') unless $typ && $typ =~ $RE_TYP;

  # Return the existing target definitions
  $tbl = _get_items($slf, uc($typ));
  return (map {$tbl->{$_}} sort keys(%{$tbl}));
}

sub _get_items
{ my ($slf, $typ) = @_;
  my ($tbl);

  return $slf->{'_idx'}->{$typ} if exists($slf->{'_idx'}->{$typ});

  $tbl = {};
  foreach my $obj ($slf->{'def'}->find('TARGET', 1)->search("^$typ\_"))
  { $tbl->{$obj->get_oid} = $obj;
  }
  return $slf->{'_idx'}->{$typ} = $tbl;
}

=head2 S<$h-E<gt>get_next($type[,$parent])>

This method returns an unique target name for the specified type.

=cut

sub get_next
{ my ($slf, $typ, $par) = @_;
  my ($nam, $nxt, $pth, $tbl);

  # Validate the type
  die get_string('BAD_TYPE') unless $typ && $typ =~ $RE_TYP;

  # Determine the next target name
  $nxt = $slf->{'_nxt'};
  $tbl = _get_items($slf, $typ = uc($typ));
  do
  { $nam = sprintf('%s_T%04d', $typ, ++$nxt->{$typ});
  } while exists($tbl->{$nam});

  # Create the target definition
  $pth = (defined($par) && length($par)) ? "$par.$nam" : "TARGET.$typ.$nam";
  $tbl->{$nam} = $slf->{'def'}->find($pth, 1);
  return $pth;
}

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

This method creates the target control object and returns a reference to it.

=cut

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

  unless (exists($slf->{'_tgt'}))
  { eval {
      require RDA::Object::Target;
      $slf->{'_tgt'} = RDA::Object::Target->new($slf);
      };
    $slf->{'agt'}->abort($@, get_string('ERR_TARGET')) if $@;
  }
  return $slf->{'_tgt'};
}

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

This method returns and clears the input and profile targets.

=cut

sub get_targets
{ return (splice(@{shift->{'_itm'}}));
}

=head1 USAGE MANAGEMENT METHODS

=head2 S<$h-E<gt>clear_usage($name)>

This method clears usage information.

=cut

sub clear_usage
{ my ($slf, $nam) = @_;
  my ($itm);

  $itm->clear(1) if ($itm = $slf->{'def'}->find("USAGE.$nam"));
  return;
}

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

This method extracts the library usage.

=cut

sub extract_usage
{ my ($slf, $ofh) = @_;
  my ($buf, $rec, $use);

  # Update the statistics
  foreach my $lib ($slf->{'agt'}->get_lang('SDCL')->get_libraries('usage'))
  { $lib->get_stats;
  }

  # Extract the statistics
  $buf = q{};
  $use = $slf->{'_use'};
  foreach my $typ (keys(%{$use}))
  { next unless ref($rec = $use->{$typ}) eq 'HASH';
    foreach my $key (keys(%{$rec}))
    { $buf .= join(q{|}, $typ, $key, $rec->{$key}, qq{\n});
    }
  }
  return $buf;
}

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

This method returns the library usage hash.

=cut

sub get_usage
{ return shift->{'_use'};
}

=head2 S<$h-E<gt>incr_usage($typ)>

This method increments the request counter.

=cut

sub incr_usage
{ my ($slf, $typ) = @_;

  $slf->{'_use'}->{$typ} = {not => q{}, out => 0, req => 0}
    unless exists($slf->{'_use'}->{$typ});
  return ++$slf->{'_use'}->{$typ}->{'req'};
}

=head2 S<$h-E<gt>init_usage($name)>

This method initializes the usage counters with the result of the previous run.

=cut

sub init_usage
{ my ($slf, $nam) = @_;
  my ($def, $use);

  $slf->{'_use'} = $use = {};
  foreach my $lib ($slf->{'agt'}->get_lang('SDCL')->get_libraries('usage'))
  { $lib->clr_stats;
  }
  $def = $slf->{'def'}->find("USAGE.$nam", 1);
  foreach my $key ($def->grep('^(T_NOT|N_(ERR|OUT|REQ|SKP))_'))
  { $use->{uc($2)}->{lc($1)} = $def->get_first($key)
      if $key =~ m/^[NT]_(ERR|NOT|OUT|REQ|SKP)_(.*)$/;
  }
  return;
}

=head2 S<$h-E<gt>load_usage($ifh)>

This method loads the library usage from the specified file handle. It closes
the file handle on completion.

=cut

sub load_usage
{ my ($slf, $ifh) = @_;
  my ($key, $typ, $use, $val);

  $use = $slf->{'_use'};
  while (<$ifh>)
  { s/[\n\r]+$//;
    ($typ, $key, $val) = split(/\|/, $_, 4);
    $use->{$typ} = {not => q{}, req => 0, ver => q{?}}
      unless exists($use->{$typ});
    if (exists($tb_add{$key}) && exists($use->{$typ}->{$key}))
    { $use->{$typ}->{$key} += $val;
    }
    else
    { $use->{$typ}->{$key} = $val;
    }
  }
  $ifh->close;
  return;
}

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

This method resets the usage counters.

=cut

sub reset_usage
{ my ($slf, $flg) = @_;
  my ($lng);

  $slf->{'_use'} = {};
  $lng = $slf->{'agt'}->get_lang('SDCL');
  foreach my $lib ($lng->get_libraries('reset'))
  { $lib->reset;
  }
  foreach my $lib ($lng->get_libraries('usage'))
  { $lib->clr_stats;
  }
  return;
}

=head2 S<$h-E<gt>update_usage($name[,$mrc[,$log]])>

This method updates the library usage in the specified module.

=cut

sub update_usage
{ my ($slf, $nam, $mrc, $log) = @_;
  my ($def, $grp, $rec, $use);

  $def = $slf->{'def'}->find($mrc ? "USAGE.$nam.LAST_MRC" : "USAGE.$nam",
    1)->clear(1);
  $use = $slf->{'_use'};
  foreach my $lib ($slf->{'agt'}->get_lang('SDCL')->get_libraries('usage'))
  { $lib->get_stats;
  }
  foreach my $typ (sort keys(%{$use}))
  { $rec = $use->{$typ};
    $slf->log('s', $nam, $typ, $rec->{'req'},
      exists($rec->{'err'}) ? $rec->{'err'} : q{},
      exists($rec->{'out'}) ? $rec->{'out'} : q{},
      exists($rec->{'skp'}) ? $rec->{'skp'} : q{},
      $rec->{'not'}) if $log;
    $def->set_value("N_REQ_$typ", $rec->{'req'});
    $def->set_value("N_ERR_$typ", $rec->{'err'}) if exists($rec->{'err'});
    $def->set_value("N_OUT_$typ", $rec->{'out'}) if exists($rec->{'out'});
    $def->set_value("N_SKP_$typ", $rec->{'skp'}) if exists($rec->{'skp'});
    $def->set_value("T_NOT_$typ", $rec->{'not'});
  }
  return $mrc;
}

=head1 WORK FILE MANAGEMENT METHODS

=head2 S<$h-E<gt>clean_work($type)>

This method tries to remove the current work file. When it cannot remove the
file, it disables further usage of that file.

=cut

sub clean_work
{ my ($slf, $typ) = @_;
  my ($pth);

  $typ = 'tmp' unless defined($typ);
  if (exists($slf->{'_wrk'}) && exists($slf->{'_wrk'}->{$typ}))
  { $pth = $slf->{'_cln'}->{$slf->{'_wrk'}->{$typ}};
    1 while unlink($pth);
    delete($slf->{'_wrk'}->{$typ}) if -e $pth;
  }
  return;
}

=head2 S<$h-E<gt>get_work($type[,$flag])>

This method returns the path to the corresponding work file. When the flag is
set, it forces the creation of the directory.

=cut

sub get_work
{ my ($slf, $typ, $flg) = @_;
  my ($oid);

  $typ = 'tmp' unless defined($typ);
  return $slf->{'_cln'}->{$slf->{'_wrk'}->{$typ}}
    if exists($slf->{'_wrk'}->{$typ});

  $slf->{'_wrk'}->{$typ} = $oid =
    sprintf('%s_W%05d_%02d', $slf->{'oid'}, $$, ++$slf->{'_seq'});
  return $slf->{'_cln'}->{$oid} =
    RDA::Object::Rda->cat_file($slf->get_dir('T', $flg), $oid.q{_}.$typ);
}

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

# Display message
sub _display
{ my ($slf, $key, @arg) = @_;

  if ($slf->{'vrb'})
  { $slf->{'vrb'}->dsp_line(get_string("VI_$key", @arg));
  }
  elsif ($slf->{'lvl'} >= 20)
  { $slf->{'agt'}->trace(get_string($key, @arg));
  }
  return;
}

# --- SDCL extensions ---------------------------------------------------------

# Clean the collection
sub _end_collect
{ my ($pkg) = @_;
  my ($col);

  # Delete the sand box directory
  $col = $pkg->get_collector;
  RDA::Object::Rda->delete_dir(delete($col->{'_out'}->{'B'}))
    if exists($col->{'_out'}->{'B'});
  return;
}

1;

__END__

=head1 SEE ALSO

L<RDA::Agent|RDA::Agent>,
L<RDA::Alarm|RDA::Alarm>,
L<RDA::Driver::Library|RDA::Driver::Library>
L<RDA::Error|RDA::Error>,
L<RDA::Handle::Memory|RDA::Handle::Memory>,
L<RDA::Object|RDA::Object>,
L<RDA::Object::Access|RDA::Object::Access>,
L<RDA::Object::Content|RDA::Object::Content>,
L<RDA::Object::Display|RDA::Object::Display>,
L<RDA::Object::Env|RDA::Object::Env>,
L<RDA::Object::Html|RDA::Object::Html>,
L<RDA::Object::Item|RDA::Object::Item>,
L<RDA::Object::Log|RDA::Object::Log>,
L<RDA::Object::Message|RDA::Object::Message>,
L<RDA::Object::Output|RDA::Object::Output>,
L<RDA::Object::Rda|RDA::Object::Rda>,
L<RDA::Object::Profile|RDA::Object::Profile>,
L<RDA::Object::Target|RDA::Object::Target>,
L<RDA::Object::Xml|RDA::Object::Xml>,
L<RDA::SDCL::Block|RDA::SDCL::Block>,
L<RDA::SDCL::Language|RDA::SDCL::Language>,
L<RDA::SDSL::Language|RDA::SDSL::Language>,
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