# Agent.pm: Class Used for Objects to Interface with the Diagnostic Agent

package RDA::Agent;

# $Id: Agent.pm,v 1.48 2015/08/24 09:31:38 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/Agent.pm,v 1.48 2015/08/24 09:31:38 RDA Exp $
#
# Change History
# 20150821  MSC  Update the SEE ALSO section.

=head1 NAME

RDA::Agent - Class Used for Objects to Interface with the Diagnostic Agent

=head1 SYNOPSIS

 require RDA::Agent;

=head1 DESCRIPTION

The objects of the C<RDA::Agent> class are used to interface with the Remote
Diagnostic Agent (RDA).

The following methods are available:

=cut

use strict;

BEGIN
{ use Exporter;
  use File::Copy;
  use IO::File;
  use IO::Handle;
  use RDA::Error;
  use RDA::Object;
  use RDA::Object::Message;
  use RDA::Object::Rda qw($CREATE $FIL_PERMS);
  use RDA::Object::View;
  use RDA::Local::Unix;
  use RDA::Text qw(get_string);
  use RDA::Trace;
}

autoflush STDOUT 1;  ## no critic (Call)
autoflush STDERR 1;  ## no critic (Call)

# Define the global public variables
use vars qw($INTERRUPT $RE_OID $STRINGS $VERSION @DELETE @DUMP @EXPORT_OK @ISA);
$INTERRUPT = 'Interrupted';
$RE_OID    = qr/^([A-Za-z]\w{0,31})$/;
$VERSION   = sprintf('%d.%02d', q$Revision: 1.48 $ =~ /(\d+)\.(\d+)/);
@DELETE    = qw(_lck _rem _req _lng _col _dsp);
@DUMP      = (
  obj => {
    'RDA::Object::Rda'  => 1,
    },
  );
@EXPORT_OK = qw($INTERRUPT $RE_OID);
@ISA       = qw(RDA::Error RDA::Trace Exporter);

# Define the global private constants

# Define the global private variables
my %tb_mod = (
  # Alias
  A => {'-add' => \&_add_alias,
        '-del' => \&_delete_alias,
        '-req' => \&_treat_request,
       },
  # Error
  E => {'-add' => \&_add_error,
        'err'  => 'NOT_IMPLEMENTED',
       },
  # Local agent
  L => {'-add' => \&_add_agent,
        '-del' => \&_delete_agent,
        '-req' => \&_submit_request,
       },
  # No treatment
  N => {'-del' => \&_delete_entry,
        '-req' => \&_reject_request,
        'sta'  => 'ERROR.NotImplemented',
       },
  # Remote agent
  R => {'-add' => \&_add_agent,
        '-del' => \&_delete_agent,
        '-req' => \&_submit_request,
       },
  );

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

=head2 S<$h = RDA::Agent-E<gt>new($def[,attrname =E<gt> $value,...])>

The object constructor. This method enables you to specify the agent definition
and initial attributes at object creation time.

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

=over 16

=item S<    B<'aux' > > Reference to the associated control object (M,S)

=item S<    B<'bkp' > > Setup backup flag (M,S)

=item S<    B<'brk' > > Treatment break request (C)

=item S<    B<'cfg' > > Reference to the RDA software configuration (M,S)

=item S<    B<'ctl' > > Controlling agent hash (M,S)

=item S<    B<'drv' > > Reference to the communication driver object (C,S)

=item S<    B<'edt' > > Edit directives (M,S)

=item S<    B<'end' > > End message (M,S)

=item S<    B<'err' > > Error buffer (M,S)

=item S<    B<'ids' > > Request identifier list (M,S)

=item S<    B<'ifh' > > Communication channel input file handle (C,S)

=item S<    B<'inp' > > Input directives (M,S)

=item S<    B<'lck' > > Lock indicator (M,S)

=item S<    B<'loc' > > Do local usage tracking (C)

=item S<    B<'lvl' > > Trace level (C,M,S)

=item S<    B<'new' > > New setup indicator (M,S)

=item S<    B<'nod' > > Node name (C,M,S)

=item S<    B<'ofh' > > Communication channel output file handle (C,S)

=item S<    B<'oid' > > Agent identifier (C,M,S)

=item S<    B<'out' > > Disable output (M,S)

=item S<    B<'par' > > Reference to the parent agent (C)

=item S<    B<'pid' > > Execution agent process identifier (C)

=item S<    B<'pre' > > Trace prefix (C,M,S)

=item S<    B<'prx' > > Proxy hash (M,S)

=item S<    B<'rdr' > > Standard error redirection (M)

=item S<    B<'req' > > Current request (M,S)

=item S<    B<'sav' > > Incremental save indicator (M,S)

=item S<    B<'set' > > Setup directive (M,S)

=item S<    B<'tot' > > Total usage overview (M)

=item S<    B<'upd' > > Usage update command (C)

=item S<    B<'use' > > Agent usage overview (C,M,S)

=item S<    B<'vrb' > > Verbose mode indicator (M,S)

=item S<    B<'yes' > > Auto confirmation flag (M,S)

=item S<    B<'zip' > > Report archive location (M)

=item S<    B<'_chg'> > Proxy change cache (M,S)

=item S<    B<'_cnt'> > Reference to the RDA content control object (M,S)

=item S<    B<'_col'> > Reference to the collector object (M,S)

=item S<    B<'_dfh'> > Display file handle (M,S)

=item S<    B<'_dsp'> > Reference to the display control object (M,S)

=item S<    B<'_gid'> > Group identifier of the context owner (M,S)

=item S<    B<'_itm'> > Item reference hash (M,S)

=item S<    B<'_kil'> > Kill indicator (C)

=item S<    B<'_lck'> > Lock control object (M)

=item S<    B<'_lng'> > Language hash (M,S)

=item S<    B<'_mod'> > Model definitions (M,S)

=item S<    B<'_own'> > Ownership alignment stack (M,S)

=item S<    B<'_reg'> > Registry hash (M,S)

=item S<    B<'_req'> > Request library hash (M,S)

=item S<    B<'_rem'> > Reference to the remote access control object (M,S)

=item S<    B<'_run'> > Reference to the run time item (M,S)

=item S<    B<'_seq'> > Request sequencer (M,S)

=item S<    B<'_ses'> > Reference to the session object (C)

=item S<    B<'_sys'> > Reference to the system view object (M,S)

=item S<    B<'_swt'> > Context switch sequencer (M,S)

=item S<    B<'_uid'> > User identifier of the context owner (M,S)

=back

Internal keys are prefixed by an underscore.

The control agent definition object is represented by a blessed hash
reference. The following special keys are used:

=over 16

=item S<    B<'cls' > > Control agent class

=item S<    B<'err' > > Creation error message

=item S<    B<'fwd' > > Request library-specific forward directives

=item S<    B<'lib' > > Associated request library

=item S<    B<'loc' > > Driver detection indicator

=item S<    B<'pkg' > > List of required packages for the model

=item S<    B<'spn' > > Process spawn required for the model

=item S<    B<'sta' > > Rejection status

=item S<    B<'-add'> > Add function

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

=item S<    B<'-als'> > Alias hash

=item S<    B<'-del'> > Delete function

=item S<    B<'-dis'> > Disable indicator

=item S<    B<'-end'> > End request attribute

=item S<    B<'-nod'> > Node identifier

=item S<    B<'-oid'> > Agent identifier

=item S<    B<'-req'> > Request function

=item S<    B<'-typ'> > Agent type

=back

=cut

sub new  ## no critic (Complex)
{ my ($cls, $arg, @arg) = @_;
  my ($lib, $nod, $oid, $slf);

  # Validate arguments
  if (ref($arg) eq 'ARRAY')
  { ($oid, $lib) = @{$arg};

    # Validate the agent identifier
    ($oid) = ($oid =~ $RE_OID)
       or die get_string('BAD_OID', $oid);
  }
  else
  { # Assure backward compatibility with older versions
    unshift(@arg, $arg);
    $oid = 'output';
  }
  $nod = uc($oid);

  # Create the agent
  if (defined($lib))
  { my ($ctl, $key, $val);

    # Create a slave agent object (S)
    $slf = bless {
      bkp  => 1,
      cfg  => {},
      ctl  => $ctl = {},
      edt  => {},
      end  => 'EndSlave',  # Text:EndSlave
      err  => [],
      ids  => [],
      inp  => [],
      lck  => 0,
      lvl  => 0,
      new  => 0,
      nod  => $nod,
      oid  => $oid,
      out  => 0,
      pre  => "S:$oid",
      prx  => {},
      req  => undef,
      sav  => 1,
      use  => {},
      vrb  => 0,
      yes  => 0,
      _chg => {$nod => {}},
      _dfh => $RDA::Text::TRACE = \*STDERR,
      _lng => {},
      _reg => {},
      _seq => 0,
      _swt => 0,
      }, ref($cls) || $cls;

    # Add the initial attributes
    while (($key, $val) = splice(@arg, 0, 2))
    { $val = $key unless defined($val);
      $slf->{$key} = $val;
    }

    # Get the system view
    $slf->{'_sys'} = RDA::Object::View->new($slf, $slf->{'edt'});

    # Initialize the RDA software configuration
    RDA::Object::Rda->new($slf)->set_work($slf)->check;

    # Do extra initialization
    $ctl->{q{.}}  =
    $ctl->{$nod}  = {'-req' => \&_treat_request};
    $ctl->{q{?}}  =
    $ctl->{q{..}} = {'-agt' => $slf,
                     '-req' => \&_submit_request};
    if ($slf->{'out'})
    { $slf->{'lvl'} = 0;
      $slf->{'vrb'} = 0;
      $slf->{'yes'} = 1;
      $slf->{'_dsp'}= undef;
      $slf->{'_req'}->{'DISPLAY'} = $slf;
    }
    else
    { $ctl->{q{.}}->{'fwd'}->{'DISPLAY'} = $ctl->{q{..}};
    }
    if ($slf->{'yes'})
    { $slf->{'_req'}->{'ASK'} = $slf;
    }
    else
    { $ctl->{q{.}}->{'fwd'}->{'ASK'} = $ctl->{q{..}};
    }

    # Check if flock and fork are possible
    $slf->{'cfg'}->can_flock;

    # Treat the submitted requests
    eval q{require RDA::Driver::Agent};
    $slf->abort($@, get_string('ERR_REQUIRE', 'RDA::Driver::Agent')) if $@;
    RDA::Driver::Agent->treat_messages($slf, "$lib.EXIT");
  }
  else
  { my ($ctl, $key, $val);

    # Create a master agent object (M)
    $slf = bless {
      bkp  => 1,
      cfg  => {},
      ctl  => $ctl = {},
      edt  => {},
      end  => 'EndAgent',  # Text:EndAgent Text:EndJob Text:EndThread
      err  => [],
      ids  => [],
      inp  => [],
      lck  => 0,
      lvl  => 0,
      new  => 0,
      nod  => $nod,
      oid  => $oid,
      out  => 0,
      pre  => "M:$oid",
      prx  => {},
      req  => undef,
      sav  => 1,
      tot  => {},
      use  => {},
      vrb  => 0,
      yes  => 0,
      _chg => {},
      _dfh => $RDA::Text::TRACE = \*STDOUT,
      _lng => {},
      _reg => {},
      _seq => 0,
      _swt => 0,
      }, ref($cls) || $cls;

    # Add the initial attributes
    while (($key, $val) = splice(@arg, 0, 2))
    { $slf->{$key} = defined($val) ? $val : $key;
    }

    # Get the system view
    $slf->{'_sys'} = RDA::Object::View->new($slf, $slf->{'edt'});

    # Initialize the RDA software configuration
    RDA::Object::Rda->new($slf)->set_work($slf)->check;

    # Do extra initialization
    $ctl->{q{.}}  =
    $ctl->{q{..}} =
    $ctl->{$nod}  = {'-req' => \&_treat_request};
    if ($slf->{'out'})
    { $slf->{'lvl'} = 0;
      $slf->{'vrb'} = 0;
      $slf->{'yes'} = 1;
      $slf->{'_dsp'}= undef;
      $slf->{'_req'}->{'DISPLAY'} = $slf;
    }
    $slf->{'_req'}->{'ASK'} = $slf if $slf->{'yes'};
    $slf->trace(get_string('StartAgent', $oid))
      unless $slf->{'lvl'} < 10;  ## no critic (Unless)

    # Prevent concurrent usage of a same result set definition file
    if ($slf->{'lck'})
    { $val = $slf->{'cfg'}->get_group('D_CWD') unless defined($val =
        RDA::Object::Rda->is_path($slf->get_env('RDA_LOCK'))) && -d $val;
      eval {
        require RDA::Object::Lock;
        $slf->{'_lck'} = RDA::Object::Lock->new($slf, $val);
        if  ($slf->{'lck'} > 0)
        { die get_string('IN_USE', $oid)
            unless $slf->{'_lck'}->lock($oid, 1);
        }
        else
        { $slf->{'_lck'}->lock('-B-'.$oid);
        }
      };
      die $@ if $@ =~ m/^RDA-/;
    }
  }

  # Return the object reference
  return $slf;
}

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

This method aligns the ownership of registered paths.

=cut

sub align_ownership
{ my ($slf) = @_;
  my ($gid, $pth, $stk, $uid);

  if (exists($slf->{'_own'}))
  { $stk = $slf->{'_own'};
    $uid = $slf->{'_uid'};
    $gid = $slf->{'_gid'};
    chown($uid, $gid, $pth) while defined($pth = pop(@{$stk}));
  }
  return $slf;
}

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

This method terminates open tasks inside the agent.

=cut

sub delete_object  ## no critic (Unpack)
{ $_[0]->trace(get_string($_[0]->{'end'}, $_[0]->{'nod'}))
    unless $_[0]->{'lvl'} < 10;  ## no critic (Unless)
  $_[0]->align_ownership;
  $_[0]->close_channel;
  $_[0]->SUPER::delete_object;
  return;
}

=head2 S<$h-E<gt>delete_registry($key)>

This method deletes the shared information associated to the specified key and
returns it.

=cut

sub delete_registry
{ my ($slf, $key) = @_;

  return delete($slf->{'_reg'}->{$key});
}

=head2 S<$h-E<gt>end($arg[,$val])>

This method terminates the execution of a master or execution agent. It first
stops all control agents.

When a message is provided as an argument, the usage is added in it and the
message is sent.

When a function reference is provided as an argument, the function is called
just before the exit.

You can specify the exit value as an extra argument. It uses 0 by default.

=cut

sub end
{ my ($slf, $arg, $ret) = @_;
  my ($ref);

  $ref = ref($arg);

  # Stop all control agents
  $slf->{'ids'} = $arg->get_info('ids') if $ref eq 'RDA::Object::Message';
  $slf->delete_agent(q{*}) if exists($slf->{'ctl'});

  # Returns the exit response
  if ($ref eq 'CODE')
  { $slf->merge_usage(1);
    &$arg($slf);
  }
  elsif ($ref eq 'RDA::Object::Message' && exists($slf->{'drv'}))
  { $arg->move_errors($slf);
    $arg->set_value('_stop', $slf->{'nod'});
    $slf->{'drv'}->send_message($slf->add_usage($arg));
    sleep(2) if is_slave($slf);
  }

  # Delete the agent and exit
  $slf->delete_object;
  exit(defined($ret) ? $ret : 0);
}

=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_collector([$new])>

This method returns a reference to the collector object. It initializes that
object on first call.

=cut

sub get_collector
{ my ($slf, $new) = @_;
  my ($col);

  # When already allocated, return its reference
  if (exists($slf->{'_col'}))
  { return $slf->{'_col'} unless $new;
    $slf->{'_col'}->delete_object;
  }
  else
  { eval q{require RDA::Object::Collect};
    $slf->abort($@, get_string('ERR_REQUIRE', 'RDA::Object::Collect')) if $@;
  }

  # When not yet done, allocate or create it
  $slf->{'_col'} = $col = RDA::Object::Collect->new($slf,
    $slf->{'new'} || $new || 0);
  $col->init;

  # Update the language interfaces
  foreach my $ctl (values(%{$slf->{'_lng'}}))
  { $ctl->refresh($col);
  }

  # Return the collector reference
  return $col;
}

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

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

=cut

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

  # When already allocated, return its reference
  return $slf->{'_cnt'} if exists($slf->{'_cnt'});

  # When not yet done, create it
  eval q{require RDA::Object::Content};
  $slf->abort($@, get_string('ERR_REQUIRE', 'RDA::Object::Content')) if $@;
  return $slf->{'_cnt'} = RDA::Object::Content->new($slf);
}

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

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

=cut

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

  # When already allocated, return its reference
  return $slf->{'_dsp'} if exists($slf->{'_dsp'});

  # When not yet done, create it
  eval q{require RDA::Object::Display};
  $slf->abort($@, get_string('ERR_REQUIRE', 'RDA::Object::Display')) if $@;
  return $slf->{'_dsp'} = RDA::Object::Display->new($slf);
}

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

This method returns the value of an initial environment variable or the
default value when the variable is not defined.

It returns a reference to an environment copy when no variable name is
specified.

=cut

sub get_env
{ my ($slf, $key, $dft) = @_;

  return $slf->{'_sys'}->get_env($key, $dft);
}

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

This method returns the next request identifier.

=cut

sub get_id
{ my $slf = shift->get_top;

  return [@{$slf->{'ids'}}, ++$slf->{'_seq'}];
}

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

This method returns the input directives as a list.

=cut

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

  return () unless ref($slf->{'inp'}) eq 'ARRAY';
  return @{$slf->{'inp'}};
}

=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
{ my ($slf, $abr) = @_;

  $abr= uc($abr);
  return $slf->{'_itm'}->{$abr}
    if exists($slf->{'_itm'}->{$abr});
  return $slf->{'_itm'}->{$abr} =
    ($abr eq 'COL') ? $slf->get_collector->get_definition :
    ($abr eq 'RUN') ? $slf->get_run :
    ($abr eq 'TGT') ? $slf->get_collector->find('TARGET.INPUT', 1) :
                      $slf->abort(get_string('BAD_ITEM', $abr));
}

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

This method returns a reference to the object associated with a language. It
dies when the language cannot be loaded.

=cut

sub get_lang
{ my ($slf, $nam, $flg) = @_;
  my ($cls);

  # When already allocated, return its reference
  return $slf->{'_lng'}->{$nam} if exists($slf->{'_lng'}->{$nam});

  # Load the corresponding package
  $cls = 'RDA::'.$nam.'::Language';
  eval qq{require $cls};
  $slf->abort($@, get_string('ERR_REQUIRE', $cls)) if $@;

  # Initialize the language object
  return $slf->{'_lng'}->{$nam} = $cls->new($slf, $flg);
}

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

In list contexts, this method returns the user and group identifiers of the
diagnostic data directory owner. In scalar contexts, it returns its user
identifier. When the context does not yet exist, it returns an empty list or
an undefined value, respectively.

You can specify the ownership alignment indicator as an argument.

=cut

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

  # Determine the diagnostic data directory owner
  unless (exists($slf->{'_uid'}))
  { return unless (@sta = stat($slf->get_collector->get_data));
    $slf->{'_uid'} = $sta[4];
    $slf->{'_gid'} = $sta[5];
  }

  # Adjust ownership indicator
  if (defined($flg))
  { if (!$flg)
    { $slf->align_ownership;
      delete($slf->{'_own'});
    }
    elsif (!exists($slf->{'_own'}))
    { $slf->{'_own'} = [];
    }
  }

  # Return owner information
  return ($slf->{'_uid'}, $slf->{'_gid'}) if wantarray;
  return $slf->{'_uid'};
}

=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
{ my ($slf, $key, $fct, @arg) = @_;

  return
    exists($slf->{'_reg'}->{$key}) ? $slf->{'_reg'}->{$key} :
    (ref($fct) eq 'CODE')          ? $slf->{'_reg'}->{$key} = &$fct(@arg) :
                                     undef;
}

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

This method returns a reference to the run time item.

=cut

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

  # When already allocated, return its reference
  return $slf->{'_run'} if exists($slf->{'_run'});

  # Create the run time item
  eval q{require RDA::Object::Item};
  $slf->abort($@, get_string('ERR_REQUIRE', 'RDA::Object::Item')) if $@;
  return $slf->{'_run'} = RDA::Object::Item->new($slf, 'run', 'Run time data');
}

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

This method returns the display file handle.

=cut

sub get_screen
{ return shift->{'_dfh'};
}

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

This method returns the value of a current environment variable or the
default value when the variable is not defined.

It returns a reference to the system view object when no variable name is
specified.

=cut

sub get_system
{ my ($slf, $key, $dft) = @_;

  return defined($key)
    ? $slf->{'_sys'}->get_value($key, $dft)
    : $slf->{'_sys'};
}

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

This method indicates whether customer interactions are disabled.

=cut

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

=head2 S<$top-E<gt>is_local($oid[,$flg])>

This method indicates if the specified agent is defined locally. When the flag
is set, it skips proxy entries.

=cut

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

  # Validate the argument
  die get_string('BAD_OID') unless $dst;
  $dst = uc($dst);

  # Look for a control agent
  $slf = $slf->get_top;
  if (exists($slf->{'ctl'}))
  { foreach my $oid (keys(%{$slf->{'ctl'}}))
    { return 1 if $oid eq $dst;
    }
  }

  # Look for a proxy
  if (exists($slf->{'prx'}) && !$flg)
  { my $oid;

    foreach my $prx (keys(%{$slf->{'prx'}}))
    { (undef, $oid) = split(/\//, $prx);
      return 1 if $oid eq $dst;
    }
  }

  # Indicate that the destination is not known locally
  return 0;
}

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

This method indicates whether all outputs are disabled.

=cut

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

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

This method indicates if we are not in the master agent process.

=cut

sub is_slave
{ return exists(shift->get_top('ctl')->{q{?}});
}

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

This method indicates whether RDA runs in verbose mode.

=cut

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

  return $slf->{'vrb'} ? $slf->get_display : undef;
}

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

This method redirects the standard output and error as requested by the
C<RDA_WARN> environment variable. It disables file-based redirections when the
flag is true.

=cut

sub redirect
{ my ($slf, $flg) = @_;
  my ($env, $rdr);

  $env = $slf->{'_sys'}->get_value('RDA_WARN', q{});

  # Redirect the standard error as requested
  if ($rdr = ($env =~ m/^&(\d)$/)             ? q{>&=}.$1 :
             ($env =~ m/^\+\+[\w\/\\\.\:\$]/) ? q{>&=1} :
             $flg                             ? undef :
             ($env =~ m/^\&LOG$/i)            ? q{>&}.fileno(_get_log($slf)) :
             ($env =~ m/^([\w\/\\\.]+)$/)     ? q{>>}.$1 :
             $slf->get_info('rdr', $env)      ? undef :
                                                q{>}.$slf->{'cfg'}->dev_null)
  { open(STDERR, $rdr)  ## no critic (Open)
      or $slf->abort($!, get_string('ERR_REDIRECT'));
    $slf->{'rdr'} = $rdr;
    ## no critic (Local,Unless)
    $SIG{'__DIE__'}  = sub { open(STDERR, q{>&STDOUT})
                               unless $^S || !defined($^S) };
    $SIG{'__WARN__'} = sub { print @_ };
  }

  # Redirect the standard output as requested
  if ($env =~ m/^\+*([\w\/\\\.\:\$]+)$/)
  { $env = $1;
    eval q{require RDA::Handle::Tie};
    $slf->abort($@, get_string('ERR_REQUIRE', 'RDA::Handle::Tie')) if $@;
    open(OLDOUT, q{>&STDOUT})  ## no critic (Handle,Open)
      or $slf->abort($!, get_string('ERR_STDOUT'));
    tie(*STDOUT, q{RDA::Handle::Tie}, \*OLDOUT, qq{>>$env});  ## no critic (Tie)
  }

  # Return the object reference
  return $slf;
}

# Get the log file
sub _get_log
{ my ($slf, $nam) = @_;
  my ($col, $log, $ofh);

  eval {
    $col = $slf->get_collector;
    unless ($col->is_new)
    { $log = $col->get_log;
      $log->start(1);
      $ofh = $log->get_handle;
    }
    };
  $slf->abort($@, get_string('ERR_LOG')) if $@;
  return $ofh || *STDOUT;
}

=head2 S<$h-E<gt>set_item($abbreviation,$item)>

This method associates an item to an external reference.

=cut

sub set_item
{ my ($slf, $abr, $itm) = @_;

  return $slf->{'_itm'}->{uc($abr)} = $itm;
}

=head2 S<$h-E<gt>set_screen($handle)>

This method sets the specified file handle as the new display file handle and
returns the previous display file handle.

=cut

sub set_screen
{ my ($slf, $hnd) = @_;

  ($hnd, $slf->{'_dfh'}) = ($slf->{'_dfh'}, $hnd);
  return $hnd;
}

=head2 S<$h-E<gt>set_stderr([$redirection])>

This method reopens the standard error when it was previously redirected. It
redirects it to the standard output by default.

=cut

sub set_stderr
{ my ($slf, $rdr) = @_;

  if (exists($slf->{'rdr'}) && substr($slf->{'rdr'}, 0, 1) eq '>')
  { open(STDERR, $slf->{'rdr'} = $rdr || q{>&STDOUT})  ## no critic (Open)
      or die get_string('ERR_STDERR', $!);
  }
  return $slf;
}

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

This method indicates whether the ownership should be aligned.

=cut

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

  return exists($slf->{'_own'}) ? $slf->{'_own'} : undef
}

=head1 AGENT MANAGEMENT METHODS

=head2 S<$h-E<gt>add_agent($oid[,$att[,$ttl]])>

This method adds a new agent. You can specify start attributes with a hash
reference.

You can specify a negative time-to-live value to communicate the agent
existence to sub processes and a request message to custom the new agent.

It returns a reference to the control structure.

=cut

sub add_agent
{ my ($slf, $oid, $typ, $att, $ttl) = @_;
  my ($def, $new, $nod, $prx);

  # Validate the agent identifier
  die get_string('BAD_OID') unless defined($oid) && $oid =~ $RE_OID;
  $new = uc($oid = $1);
  $slf = $slf->get_top;

  # Delete any previous control agent
  delete_agent($slf, $new) if exists($slf->{'ctl'}->{$new});

  # Create the new agent and initialize it
  $slf->trace(get_string('StartAgent', $oid))
    unless $slf->{'lvl'} < 10;  ## no critic (Unless)
  $def = {-nod => $new,
          -oid => $oid,
          -typ => $typ,
          %{get_model($slf, $typ)}};
  $def = &{$def->{'-add'}}($slf, $oid, $def, $att)
    if exists($def->{'-add'});

  # Update the proxy declarations
  $nod = $slf->{'nod'};
  $prx = "$nod/$new";
  $ttl = 0 unless defined($ttl);
  if ($ttl < 0)
  { $slf->{'prx'}->{$prx} = [$nod, $ttl];
    foreach my $key (keys(%{$slf->{'_chg'}}))
    { $slf->{'_chg'}->{$key}->{$prx} = "..:$ttl" if $key ne $nod;
    }
  }
  else
  { $slf->{'prx'}->{$prx} = [$nod, 0];
  }
  $slf->{'_chg'}->{$nod}->{$prx} = "$nod:1" if exists($slf->{'_chg'}->{$nod});

  # Return the control agent
  return $slf->{'ctl'}->{$new} = $def;
}

# Add an agent
sub _add_agent
{ my ($slf, $oid, $def, $att) = @_;
  my ($cls, $opt, $rsp, $val, @edt);

  $cls = $def->{'cls'} || 'RDA::Agent::Local';
  eval qq{require $cls};
  $slf->abort($@, get_string('ERR_REQUIRE', $cls)) if $@;

  # Determine the edit directives
  $att = {} unless ref($att);
  if (exists($att->{'edit'}))
  { if (ref($opt = delete($att->{'edit'})))
    { push(@edt, @{$opt});
    }
    else
    { push(@edt, $opt);
    }
  }
  elsif (exists($slf->{'edt'}))
  { push(@edt, map {$_.q{=}.$opt->{$_}}
               grep {defined($opt->{$_}) && !ref($opt->{$_})}
               keys(%{$opt = $slf->{'edt'}}));
  }
  $att->{'edit'} = [@edt] if @edt;

  # Create the control agent object
  $def->{'-agt'} = $cls->new($slf, $oid);

  # Start the agent and adapt the agent behavior
  $slf->{'_chg'}->{$def->{'-nod'}} = {};
  if ($rsp = $def->{'-agt'}->start($def, $att))
  { $def->{'-dis'} = 1    if $rsp->set_value('no_command');
    $def->{'-end'} = $val if ($val = $rsp->set_value('exit_request'));
    delete($slf->{'_chg'}->{$def->{'-nod'}}) if $rsp->set_value('no_proxy');
  }

  # Return the agent definition
  return $def;
}

# Add an alias
sub _add_alias
{ my ($slf, $oid) = @_;
  my ($def);

  $def = $slf->{'ctl'}->{q{.}};
  $def->{'-als'}->{uc($oid)} = 1;
  return $def;
}

# Generate an add error
sub _add_error
{ my ($slf, $oid, $def) = @_;

  return $slf->abort(get_string($def->{'err'}));
}

=head2 S<$top-E<gt>delete_agent($oid[,wrk])>

This method stops and removes the specified control agent. When C<*> is
specified as object identifier, it removes all control agents.

You can specify a work directory action as an extra argument. So, dynamic work
directory can be cleaned or deleted at agent exit.

It returns an undefined value.

=cut

sub delete_agent
{ my ($slf, $oid, $wrk) = @_;
  my ($ctl, $err, $nod, @pid);

  # Validate the arguments
  $slf->abort(get_string('BAD_OID')) unless $oid;

  # Delete the agent list
  $slf = $slf->get_top;
  $ctl = $slf->{'ctl'};
  if ($oid eq q{*})
  { foreach my $itm (sort keys(%{$ctl}))
    { push(@pid, &{$ctl->{$itm}->{'-del'}}($slf, $itm, $wrk))
        if exists($ctl->{$itm}->{'-del'});
    }
  }
  elsif (exists($ctl->{$nod = uc($oid)}))
  { push(@pid, &{$ctl->{$nod}->{'-del'}}($slf, $nod, $wrk))
      if exists($ctl->{$nod}->{'-del'});
  }
  else
  { $slf->abort(get_string('BAD_AGENT', $oid));
  }

  # Wait for process completion
  foreach my $pid (@pid)
  { waitpid($pid, 0);
  }
  return;
}

# Delete an agent
sub _delete_agent
{ my ($slf, $nod, $wrk, $flg) = @_;
  my ($agt, $def, $prx, $req, $rsp, @pid);

  if ($def = delete($slf->{'ctl'}->{$nod}))
  { # Update the proxy declarations
    $prx = $slf->{'nod'}.q{/}.$nod;
    foreach my $gtw (keys(%{$slf->{'_chg'}}))
    { $slf->{'_chg'}->{$gtw}->{$prx} = q{};
    }
    delete($slf->{'prx'}->{$prx});

    # End the control agent
    if (exists($def->{'-agt'}))
    { $agt = $def->{'-agt'};

      if (exists($agt->{'pid'}) && $agt->{'pid'})
      { # Stop the agent
        if ($flg || $agt->{'_kil'})
        { $slf->trace(get_string('Kill', $agt->{'nod'}))
            unless $slf->{'lvl'} < 10;  ## no critic (Unless)
          eval {kill(15, $agt->{'pid'})};
        }
        else
        { $slf->trace(get_string('Stop', $agt->{'nod'}))
            unless $slf->{'lvl'} < 10;  ## no critic (Unless)
          $req = RDA::Object::Message->new($agt->{'brk'}, work => $wrk);
          $req->set_id($agt);
          $rsp = $agt->{'drv'}->exec_request($req);
          $agt->move_errors($rsp);
          eval {kill(15, $agt->{'pid'})} unless $rsp->is_success;
        }
        push(@pid, delete($agt->{'pid'}));

        # Close the communication handles
        close_channel($agt);
      }

      # Collect the usage information
      $agt->close_session;
      $agt->merge_usage;
      $agt->delete_object;
      $slf->trace(get_string('Stopped', $nod))
        unless $slf->{'lvl'} < 10;  ## no critic (Unless)
    }
  }
  return @pid;
}

# Delete an alias
sub _delete_alias
{ my ($slf, $nod) = @_;
  my ($def, $prx);

  if (($def = delete($slf->{'ctl'}->{$nod})) && delete($def->{'-als'}->{$nod}))
  { # Update the proxy declarations
    $prx = $slf->{'nod'}.q{/}.$nod;
    foreach my $gtw (keys(%{$slf->{'_chg'}}))
    { $slf->{'_chg'}->{$gtw}->{$prx} = q{};
    }
    delete($slf->{'prx'}->{$prx});

    # Notify the deletion
    $slf->trace(get_string('Deleted', $nod))
      unless $slf->{'lvl'} < 10;  ## no critic (Unless)
  }
  return;
}

# Delete a control agent
sub _delete_control
{ my ($slf, $nod) = @_;
  my ($def, $prx);

  if ($def = delete($slf->{'ctl'}->{$nod}))
  { # Update the proxy declarations
    $prx = $slf->{'nod'}.q{/}.$nod;
    foreach my $gtw (keys(%{$slf->{'_chg'}}))
    { $slf->{'_chg'}->{$gtw}->{$prx} = q{};
    }
    delete($slf->{'prx'}->{$prx});

    # Delete the remote session and collect the usage information
    if (exists($def->{'-agt'}))
    { $def->{'-agt'}->close_session;
      $def->{'-agt'}->merge_usage;
      $def->{'-agt'}->delete_object;
    }

    # Notify the deletion
    $slf->trace(get_string('Stopped', $nod))
      unless $slf->{'lvl'} < 10;  ## no critic (Unless)
  }
  return;
}

# Delete an entry
sub _delete_entry
{ my ($slf, $nod) = @_;

  delete($slf->{'ctl'}->{$nod});
  return;
}

=head2 S<$top-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<$top-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
{ my ($slf, $dst, $req, @arg) = @_;
  my ($def, $rec, $rsp, $val, %bkp);

  # Add the message identifier
  $dst = defined($dst) ? uc($dst) : q{.};
  $req = RDA::Object::Message->new($req, @arg) unless ref($req);

  # Set a dedicated context for the request
  $slf = $slf->get_top;
  $bkp{'err'} = $slf->{'err'};
  $bkp{'ids'} = $slf->{'ids'};
  $bkp{'req'} = $slf->{'req'};
  $slf->{'err'} = $req->get_errors;
  $slf->{'ids'} = $req->set_id($slf);
  $slf->{'req'} = $req;

  # Treat the request
  $slf->trace_object($req, get_string('T_Request', $dst))
    unless $slf->{'lvl'} < 40;  ## no critic (Unless)
  eval {
    $rsp = defined($def = _find_agent($slf, $req, $dst))
      ? &{$def->{'-req'}}($slf, $req, $req->set_value('_save'), $def)
      : $req->new('ERROR.InvalidDest', dest => $dst);
    };
  $rsp = $req->error('Exec', $@) if $@;

  # Trace the response
  $slf->trace_object($rsp, get_string('T_Response', $dst))
    unless $slf->{'lvl'} < 40;  ## no critic (Unless)

  # Restore the previous context
  $slf->{'err'} = $bkp{'err'};
  $slf->{'ids'} = $bkp{'ids'};
  $slf->{'req'} = $bkp{'req'};

  # Return the response
  return $rsp;
}

# Find the agent associated to the destination
sub _find_agent
{ my ($slf, $req, $dst) = @_;
  my ($ctl, $def, $gtw, $lib, $min, $oid, $rec);

  # Look for a control agent
  $ctl = $slf->{'ctl'};
  if (exists($ctl->{$dst}))
  { $def = $ctl->{$dst};
    if (exists($def->{'fwd'}))
    { ($lib) = split(/\./, $req->get_info('msg'), 2);
      return $def->{'fwd'}->{$lib} if exists($def->{'fwd'}->{$lib});
    }
    return $def;
  }

  # Look for a proxy
  $req->set_value('_dest', $dst) unless $req->is_defined('_dest');
  if (exists($slf->{'prx'}))
  { foreach my $prx (keys(%{$slf->{'prx'}}))
    { (undef, $oid) = split(/\//, $prx);
      next unless $oid eq $dst;
      $rec = $slf->{'prx'}->{$prx};
      ($gtw, $min) = ($rec->[0], $rec->[1])
        unless defined($min) && $min <= $rec->[1];  ## no critic (Unless)
    }
    return $ctl->{$gtw} if defined($min);
  }

  # Otherwise delegate the search to the upper level when exists
  return exists($ctl->{q{?}}) ? $ctl->{q{?}} : undef;
}

# Reject a request
sub _reject_request
{ my ($slf, $req, $def) = @_;

  return $req->new($def->{'sta'});
}

# Submit a request to another agent
sub _submit_request
{ my ($slf, $req, $sav, $def) = @_;
  my ($drv, $msg, $rsp, $val);

  # Indicate if the agent is busy or disabled
  $drv = $def->{'-agt'}->{'drv'};
  return $req->new('ERROR.AgentBusy') if $drv->is_busy;
  return $req->new('ERROR.Disabled')  if $def->{'-dis'};

  # Execute the request
  if ($sav)
  { $req->set_value('_forward', 1);
    $rsp = $drv->exec_request($req, 1);
  }
  else
  { $rsp = $drv->exec_request($req, $req->get_first('_forward'));
  }

  # Detect agent end and remote exit request
  if (defined($val = $rsp->set_value('_stop')))
  { _delete_control($slf, $val);
  }
  elsif (exists($def->{'-end'})
    && defined($val = $rsp->set_value($def->{'-end'})))
  { $slf->trace(get_string('T_Exit'))
      unless $slf->{'lvl'} < 40;  ## no critic (Unless)
    delete_agent($slf, $def->{'-oid'}, 'keep', $val);
  }

  # Return the response
  treat_data($slf, $rsp, $sav) if $sav;
  return $rsp
}

# Treat a request
sub _treat_request
{ my ($slf, $req, $sav) = @_;
  my ($lib, $msg, $nam, $rsp);

  $msg = $req->get_info('msg');
  $slf->add_error($@, get_string('BAD_COMMAND', $msg))
    unless $msg =~ m/^((\w+)\.\w+)$/;
  incr_usage($slf, $msg = $1);                 ## no critic (Capture)
  $slf->trace_object($req, get_string('T_Execute'))
    unless $slf->{'lvl'} < 40;  ## no critic (Unless)
  $lib = eval {get_library($slf, $nam = $2)};  ## no critic (Capture)
  if ($@)
  { $slf->add_error($@, get_string('BAD_LIBRARY', $nam));
    $rsp = $req->error('BadLibrary');
  }
  elsif ($lib)
  { $rsp = eval {$lib->exec_command($req)};
    if ($@)
    { $slf->add_error($@);
      $rsp = $req->error('Aborted');
    }
  }
  else
  { $rsp = $req->error('BadLibrary', get_string('BAD_LIBRARY', $nam));
  }
  incr_usage($slf, $msg, $rsp->get_info('msg'));
  treat_data($slf, $rsp, $sav) if $sav;
  return $rsp;
}

=head1 PRIVATE AGENT METHODS

=head2 S<$h-E<gt>exec_command($request)>

This method allows to implement a library that skips all commands.

=cut

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

  return $req->new('INFO.Skipped');
}

=head2 S<$h-E<gt>get_agent($node)>

This method return a reference to the control agent associated to the
specified node.

=cut

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

  return (exists($slf->{'ctl'}) &&
          exists($slf->{'ctl'}->{$nod = uc($nod)}) &&
          exists($slf->{'ctl'}->{$nod}->{'-agt'}))
    ? $slf->{'ctl'}->{$nod}->{'-agt'}
    : undef;
}

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

This method indicates that there is no default password.

=cut

sub get_default
{ return;
}

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

This method returns a reference to the library control object. It loads the
library on first use.

=cut

sub get_library
{ my ($slf, $nam) = @_;
  my ($cls, $err);

  # Load the library on the first request
  unless (exists($slf->{'_req'}->{$nam}))
  { $slf->trace(get_string('LoadLibrary', $nam))
      unless $slf->{'lvl'} < 20;  ## no critic (Unless)
    $slf->{'_req'}->{$nam} = undef;
    $cls = "RDA::Request::$nam";
    eval qq{require $cls};
    $slf->abort($@, get_string('ERR_LOAD', $nam)) if $@;
    eval {$slf->{'_req'}->{$nam} = $cls->new($slf)};
    $slf->abort($@, get_string('ERR_INIT', $nam)) if $@;
  }

  # Return a reference to the library control object
  return $slf->{'_req'}->{$nam};
}

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

This method returns a reference to the remote access control object dedicated
to the agent management.

=cut

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

  $slf->{'_rem'} = $slf->get_collector->get_remote->new($slf)
    unless exists($slf->{'_rem'});
  return $slf->{'_rem'}
}

=head2 S<$top-E<gt>get_model($typ)>

This method gets the agent model for the specified object type and the current
operating system..

=cut

sub get_model
{ my ($slf, $typ) = @_;
  my ($buf, $ctl, $fam, $ifh, $lin, $val);

  # Check if the model is already loaded
  return $slf->{'_mod'}->{$typ} if exists($slf->{'_mod'}->{$typ});

  # Load the agent model
  $ifh = IO::File->new;
  if ($ifh->open('<'.$slf->{'cfg'}->get_file('D_RDA_ADM', "model/$typ.cfg")))
  { # Initialisation
    $fam = $slf->{'cfg'}->get_family;
    $lin = q{};

    # Treat all lines
    while (defined($buf = $ifh->getline))
    { # Trim spaces and join continuation lines
      $buf =~ s/^\s+//;
      $buf =~ s/[\r\n]+$//;
      $lin .= $buf;
      next if $lin =~ s/\\$//;
      $lin =~ s/\s+$//;

      # Parse the line
      if ($lin =~ m/^\[(\*|(\w+(\|\w+)*)):([A-Z])\]/)
      { # Validate any model found
        last if defined($ctl = _val_model($slf, $ctl));

        # Check the new model
        next unless exists($tb_mod{$4});
        $val = $tb_mod{$4};
        $ctl = {%{$val}}
          if !$2 || grep {$_ eq $^O || $_ eq $fam} split(/\|/, $2);
      }
      elsif ($ctl && $lin =~ m/^(\w+)="(.*?)"/)
      { $ctl->{lc($1)} = RDA::Object::decode($2);
      }
      $lin = q{};
    }
    $ifh->close;
  }

  # Return the model
  return $slf->{'_mod'}->{$typ} = $ctl || $tb_mod{'N'};
}

# Validate the model
sub _val_model
{ my ($slf, $ctl) = @_;

  if ($ctl)
  { # Check spawn requirement
    if ($ctl->{'spn'})
    { return unless $slf->{'cfg'}->can_spawn;
    }

    # Check package requirements
    if ($ctl->{'pkg'})
    { foreach my $pkg (split(/,/, $ctl->{'pkg'}))
      { eval qq{require $pkg};
        return if $@;
      }
    }
  }
  return $ctl;
}

=head2 S<$h-E<gt>switch_context($context,$error,$function[,$arg...])>

This method switches the error context for executing the specified function. It
returns the function value.

=cut

sub switch_context
{ my ($slf, $ctx, $msg, $fct, @arg) = @_;
  my ($bkp, $err, $ret, $uid);

  $slf->trace(get_string('T_Switch', $uid = ++$slf->{'_swt'}))
    unless $slf->{'lvl'} < 50;  ## no critic (Unless)
  $bkp = $slf->{'err'};
  $slf->{'err'} = $ctx->get_errors;
  eval {$ret = &$fct(@arg)};
  $err = $@;
  $slf->trace(get_string('T_Revert', $uid))
    unless $slf->{'lvl'} < 50;  ## no critic (Unless)
  $slf->{'err'} = $bkp;
  if ($err)
  { die $err if $err =~ m/^$INTERRUPT/;
    $slf->abort($ctx->purge_errors, $msg) if $ctx->add_error($err)->has_errors;
  }
  return $ret;
}

=head2 S<RDA::Agent-E<gt>treat_data($response,$treatment)>

This method applies the data treatment.

=cut

sub treat_data
{ my ($slf, $rsp, $sav) = @_;

  if (ref($sav) eq 'HASH')
  { return $rsp->save_data($sav->{'pth'}, $sav->{'mod'})
      if exists($sav->{'pth'});
    return &{$sav->{'fct'}}($rsp, $sav->{'arg'})
      if exists($sav->{'fct'});
    return $rsp->skip_data
      if exists($sav->{'skp'});
  }
  return -1;
}

=head1 PRIVATE CONTROL AGENT METHODS

=head2 S<$h-E<gt>add_changes($node)>

This method identifies the specified changes to a new proxy definition. It
returns a reference to the agent object.

=cut

sub add_changes
{ my ($slf, $nod) = @_;
  my ($ttl);

  if (exists($slf->{'_chg'}->{$nod}))
  { foreach my $prx (keys(%{$slf->{'prx'}}))
    { $ttl = $slf->{'prx'}->{$prx}->[1];
      $slf->{'_chg'}->{$nod}->{$prx} = "..:$ttl" if $ttl < 0;
    }
  }
  return $slf;
}

=head2 S<$h-E<gt>apply_changes($message)>

This method applies the specified changes to the proxy definitions. It returns
a reference to the message object.

=cut

sub apply_changes
{ my ($slf, $msg) = @_;
  my ($chg, $gtw, $nod, $prx, $ttl);

  if (ref($chg = $msg->set_value('_proxies')))
  { $slf = $slf->get_top;
    $nod = $slf->{'nod'};
    foreach my $itm (@{$chg})
    { ($prx, $gtw, $ttl) = split(/[\=\:]/, $itm);
      if ($gtw)
      { $slf->{'prx'}->{$prx} = [$gtw, $ttl];
        if ($ttl < 0)
        { foreach my $key (keys(%{$slf->{'_chg'}}))
          { $slf->{'_chg'}->{$key}->{$prx} = "..:$ttl" if $key ne $nod;
          }
        }
        else
        { $slf->{'_chg'}->{$nod}->{$prx} = $nod.q{:}.++$ttl
            if exists($slf->{'_chg'}->{$nod});
        }
      }
      else
      { delete($slf->{'prx'}->{$prx});
        foreach my $key (keys(%{$slf->{'_chg'}}))
        { $slf->{'_chg'}->{$key}->{$prx} = q{};
        }
      }
    }
  }
  return $msg;
}

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

This method closes the communication handles.

=cut

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

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

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

This method closes the remote session.

=cut

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

  delete($slf->{'_ses'})->end_session if exists($slf->{'_ses'});
  return;
}

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

This method sends a signal to the child process to stop the agent.

=cut

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

  # Abort invalid request
  return 0 unless exists($slf->{'pid'}) && $slf->{'pid'};

  # Stop the agent
  $slf->trace(get_string('Kill', $slf->{'nod'}))
    unless $slf->{'lvl'} < 10;  ## no critic (Unless)
  eval {kill(15, $slf->{'pid'})};

  # Close the communication handles
  close_channel($slf);

  # Wait for the process completion
  waitpid($slf->{'pid'}, 0);
  delete($slf->{'pid'});

  # Indicate the successful completion
  return 1;
}

=head2 S<$h-E<gt>merge_changes($message)>

This method adds the local proxy changes to the message. It returns a reference
to the message object.

=cut

sub merge_changes
{ my ($slf, $msg) = @_;
  my ($chg, $nod, @chg);

  $nod = $slf->{'nod'};
  $slf = $slf->get_top;
  if (exists($slf->{'_chg'}->{$nod}) &&
    (@chg = keys(%{$chg = $slf->{'_chg'}->{$nod}})))
  { $msg->add_value('_proxies', map {$_.q{=}.$chg->{$_}} sort @chg);
    undef %{$chg};
  }
  return $msg;
}

=head1 PRIVATE USAGE METHODS

=head2 S<$agt-E<gt>add_usage($msg[,$attr])>

This method transfers the usage information inside the message. When requested,
it takes a copy in another attribute.

=cut

sub add_usage
{ my ($slf, $msg, $nam) = @_;
  my ($use);

  if (exists($slf->{'use'}))
  { $use = $slf->{'use'};
    if ($slf->is_slave)
    { $msg->add_value('_use',
        map {$_.qq{=\173}.join(q{,}, %{delete($use->{$_})}).qq{\175}}
            sort keys(%{$use}));
      $msg->set_value($nam, scalar $msg->get_value('_use')) if $nam;
    }
    else
    { $msg->add_value($nam,
        map {$_.qq{=\173}.join(q{,}, %{delete($use->{$_})}).qq{\175}}
            sort keys(%{$use}))
        if $nam;
      $slf->merge_usage(1);
    }
  }
  return $msg;
}

=head2 S<$h-E<gt>extract_usage($msg)>

This method extracts the usage information from the message if the agent is
managing command usage.

=cut

sub extract_usage
{ my ($slf, $msg) = @_;
  my ($key, $tbl, $use, %use);

  if (exists($slf->{'use'}))
  { $use = $slf->{'use'};
    if ($tbl = $msg->set_value('_use'))
    { foreach my $val (@{$tbl})
      { next unless $val =~ m/^([^\=]+)=\{(.*)\}$/;
        $key = $1;
        %use = split(/,/, $2);
        foreach my $sta (keys(%use))
        { $use->{$key}->{$sta} += $use{$sta};
        }
      }
    }
  }
  return $msg;
}

=head2 S<$h-E<gt>incr_usage($key[,$status])>

This method increases the specified usage counter.

=cut

sub incr_usage
{ my ($slf, $key, $sta) = @_;
  my ($use);

  ++$slf->{'use'}->{$slf->{'nod'}.q{/}.$key}->{defined($sta) ? $sta : q{}}
    if exists($slf->{'use'});
  return;
}

=head2 S<$h-E<gt>merge_usage([$flg])>

This method merges the agent usage information into its parent agent. When the
flag is set, usage is merged with the total usage.

=cut

sub merge_usage
{ my ($slf, $flg) = @_;
  my ($chl, $par, $sta, $tbl, $tot);

  $tot = $flg                         ? $slf->get_info('tot') :
         ref($par = $slf->get_parent) ? $par->get_info('use') :
                                        undef;
  if (ref($tot) && ref($chl = $slf->get_info('use')))
  { foreach my $key (keys(%{$chl}))
    { foreach my $sta (keys(%{$tbl = delete($chl->{$key})}))
      { $tot->{$key}->{$sta} += $tbl->{$sta};
      }
    }
  }
  return;
}

1;

__END__

=head1 SEE ALSO

L<RDA::Agent::Local|RDA::Agent::Local>,
L<RDA::Agent::Remote|RDA::Agent::Remote>,
L<RDA::Alarm|RDA::Alarm>,
L<RDA::Build|RDA::Build>,
L<RDA::Deleted|RDA::Deleted>,
L<RDA::Driver::7Zip|RDA::Driver::7Zip>,
L<RDA::Driver::Agent|RDA::Driver::Agent>,
L<RDA::Driver::Convert|RDA::Driver::Convert>,
L<RDA::Driver::Da|RDA::Driver::Da>,
L<RDA::Driver::Daemon|RDA::Driver::Daemon>,
L<RDA::Driver::Dbd|RDA::Driver::Dbd>,
L<RDA::Driver::Diff|RDA::Driver::Diff>,
L<RDA::Driver::Header|RDA::Driver::Header>,
L<RDA::Driver::Jar|RDA::Driver::Jar>,
L<RDA::Driver::Jdbc|RDA::Driver::Jdbc>,
L<RDA::Driver::Jsch|RDA::Driver::Jsch>,
L<RDA::Driver::Library|RDA::Driver::Library>,
L<RDA::Driver::Local|RDA::Driver::Local>,
L<RDA::Driver::Pax|RDA::Driver::Pax>,
L<RDA::Driver::Product|RDA::Driver::Product>,
L<RDA::Driver::Rda|RDA::Driver::Rda>,
L<RDA::Driver::Results|RDA::Driver::Results>,
L<RDA::Driver::Rsh|RDA::Driver::Rsh>,
L<RDA::Driver::Sgml|RDA::Driver::Sgml>,
L<RDA::Driver::Sqlplus|RDA::Driver::Sqlplus>,
L<RDA::Driver::Ssh|RDA::Driver::Ssh>,
L<RDA::Driver::SshAgent|RDA::Driver::SshAgent>,
L<RDA::Driver::Tar|RDA::Driver::Tar>,
L<RDA::Driver::Template|RDA::Driver::Template>,
L<RDA::Driver::Web|RDA::Driver::Web>,
L<RDA::Driver::WinOdbc|RDA::Driver::WinOdbc>,
L<RDA::Driver::Zip|RDA::Driver::Zip>,
L<RDA::Error|RDA::Error>,
L<RDA::Handle::Agent|RDA::Handle::Agent>,
L<RDA::Handle::Area|RDA::Handle::Area>,
L<RDA::Handle::Block|RDA::Handle::Block>,
L<RDA::Handle::Data|RDA::Handle::Data>,
L<RDA::Handle::Deflate|RDA::Handle::Deflate>,
L<RDA::Handle::Filter|RDA::Handle::Filter>,
L<RDA::Handle::Memory|RDA::Handle::Memory>,
L<RDA::Handle::Render|RDA::Handle::Render>,
L<RDA::Handle::Tie|RDA::Handle::Tie>,
L<RDA::Handle::Timing|RDA::Handle::Timing>,
L<RDA::Handle::Vector|RDA::Handle::Vector>,
L<RDA::Library::Admin|RDA::Library::Admin>,
L<RDA::Library::Archive|RDA::Library::Archive>,
L<RDA::Library::Buffer|RDA::Library::Buffer>,
L<RDA::Library::Data|RDA::Library::Data>,
L<RDA::Library::Db|RDA::Library::Db>,
L<RDA::Library::Dbi|RDA::Library::Dbi>,
L<RDA::Library::Expr|RDA::Library::Expr>,
L<RDA::Library::File|RDA::Library::File>,
L<RDA::Library::Ftp|RDA::Library::Ftp>,
L<RDA::Library::Html|RDA::Library::Html>,
L<RDA::Library::Http|RDA::Library::Http>,
L<RDA::Library::Product|RDA::Library::Product>,
L<RDA::Library::Remote|RDA::Library::Remote>,
L<RDA::Library::String|RDA::Library::String>,
L<RDA::Library::Table|RDA::Library::Table>,
L<RDA::Library::Temp|RDA::Library::Temp>,
L<RDA::Library::Value|RDA::Library::Value>,
L<RDA::Library::Windows|RDA::Library::Windows>,
L<RDA::Library::Xml|RDA::Library::Xml>,
L<RDA::Limit::Common|RDA::Limit::Common>,
L<RDA::Limit::Default|RDA::Limit::Default>,
L<RDA::Limit::Period|RDA::Limit::Period>,
L<RDA::Limit::Pfast|RDA::Limit::Pfast>,
L<RDA::Limit::Pstrict|RDA::Limit::Pstrict>,
L<RDA::Local::Cygwin|RDA::Local::Cygwin>,
L<RDA::Local::Unix|RDA::Local::Unix>,
L<RDA::Local::Vms|RDA::Local::Vms>,
L<RDA::Local::Windows|RDA::Local::Windows>,
L<RDA::Object|RDA::Object>,
L<RDA::Object::Access|RDA::Object::Access>,
L<RDA::Object::Archive|RDA::Object::Archive>,
L<RDA::Object::Buffer|RDA::Object::Buffer>,
L<RDA::Object::Collect|RDA::Object::Collect>,
L<RDA::Object::Content|RDA::Object::Content>,
L<RDA::Object::Cookie|RDA::Object::Cookie>,
L<RDA::Object::Display|RDA::Object::Display>,
L<RDA::Object::Env|RDA::Object::Env>,
L<RDA::Object::Explorer|RDA::Object::Explorer>,
L<RDA::Object::Ftp|RDA::Object::Ftp>,
L<RDA::Object::Hcve|RDA::Object::Hcve>,
L<RDA::Object::Html|RDA::Object::Html>,
L<RDA::Object::Index|RDA::Object::Index>,
L<RDA::Object::Inline|RDA::Object::Inline>,
L<RDA::Object::Item|RDA::Object::Item>,
L<RDA::Object::Jar|RDA::Object::Jar>,
L<RDA::Object::Java|RDA::Object::Java>,
L<RDA::Object::Lex|RDA::Object::Lex>,
L<RDA::Object::Limit|RDA::Object::Limit>,
L<RDA::Object::Lock|RDA::Object::Lock>,
L<RDA::Object::Log|RDA::Object::Log>,
L<RDA::Object::Manifest|RDA::Object::Manifest>,
L<RDA::Object::Message|RDA::Object::Message>,
L<RDA::Object::Mrc|RDA::Object::Mrc>,
L<RDA::Object::Output|RDA::Object::Output>,
L<RDA::Object::Parser|RDA::Object::Parser>,
L<RDA::Object::Pipe|RDA::Object::Pipe>,
L<RDA::Object::Rda|RDA::Object::Rda>,
L<RDA::Object::Remote|RDA::Object::Remote>,
L<RDA::Object::Report|RDA::Object::Report>,
L<RDA::Object::Request|RDA::Object::Request>,
L<RDA::Object::Response|RDA::Object::Response>,
L<RDA::Object::Table|RDA::Object::Table>,
L<RDA::Object::Target|RDA::Object::Target>,
L<RDA::Object::Telnet|RDA::Object::Telnet>,
L<RDA::Object::Timing|RDA::Object::Timing>,
L<RDA::Object::Toc|RDA::Object::Toc>,
L<RDA::Object::Token|RDA::Object::Token>,
L<RDA::Object::Type|RDA::Object::Type>,
L<RDA::Object::UsrAgent|RDA::Object::UsrAgent>,
L<RDA::Object::View|RDA::Object::View>,
L<RDA::Object::Windows|RDA::Object::Windows>,
L<RDA::Object::Xml|RDA::Object::Xml>,
L<RDA::Operator::Array|RDA::Operator::Array>,
L<RDA::Operator::Hash|RDA::Operator::Hash>,
L<RDA::Operator::Scalar|RDA::Operator::Scalar>,
L<RDA::Operator::Value|RDA::Operator::Value>,
L<RDA::Options|RDA::Options>,
L<RDA::Request::AGENT|RDA::Request::AGENT>,
L<RDA::Request::ASK|RDA::Request::ASK>,
L<RDA::Request::CONVERT|RDA::Request::CONVERT>,
L<RDA::Request::DIAGLET|RDA::Request::DIAGLET>,
L<RDA::Request::DISPLAY|RDA::Request::DISPLAY>,
L<RDA::Request::EXTRA|RDA::Request::EXTRA>,
L<RDA::Request::FILTER|RDA::Request::FILTER>,
L<RDA::Request::MRC|RDA::Request::MRC>,
L<RDA::Request::PACKAGE|RDA::Request::PACKAGE>,
L<RDA::Request::PROFILE|RDA::Request::PROFILE>,
L<RDA::Request::RDA|RDA::Request::RDA>,
L<RDA::Request::REMOTE|RDA::Request::REMOTE>,
L<RDA::Request::RENDER|RDA::Request::RENDER>,
L<RDA::Request::SDCL|RDA::Request::SDCL>,
L<RDA::Request::SDSL|RDA::Request::SDSL>,
L<RDA::Request::TEST|RDA::Request::TEST>,
L<RDA::Request::THREAD|RDA::Request::THREAD>,
L<RDA::Request::UPGRADE|RDA::Request::UPGRADE>,
L<RDA::Request::WEB|RDA::Request::WEB>,
L<RDA::SDCL::Block|RDA::SDCL::Block>,
L<RDA::SDCL::Context|RDA::SDCL::Context>,
L<RDA::SDCL::Language|RDA::SDCL::Language>,
L<RDA::SDCL::Value|RDA::SDCL::Value>,
L<RDA::SDSL::Language|RDA::SDSL::Language>,
L<RDA::SDSL::Module|RDA::SDSL::Module>,
L<RDA::SDSL::Setting|RDA::SDSL::Setting>,
L<RDA::Target::Base|RDA::Target::Base>,
L<RDA::Target::Common|RDA::Target::Common>,
L<RDA::Target::Database|RDA::Target::Database>,
L<RDA::Target::Db|RDA::Target::Db>,
L<RDA::Target::Dbi|RDA::Target::Dbi>,
L<RDA::Target::Domain|RDA::Target::Domain>,
L<RDA::Target::Home|RDA::Target::Home>,
L<RDA::Target::Instance|RDA::Target::Instance>,
L<RDA::Target::MwHome|RDA::Target::MwHome>,
L<RDA::Target::System|RDA::Target::System>,
L<RDA::Target::WlHome|RDA::Target::WlHome>,
L<RDA::Text|RDA::Text>,
L<RDA::Token::Action|RDA::Token::Action>,
L<RDA::Token::Complex|RDA::Token::Complex>,
L<RDA::Token::Quoted|RDA::Token::Quoted>,
L<RDA::Token::Simple|RDA::Token::Simple>,
L<RDA::Trace|RDA::Trace>,
L<RDA::UI::Diaglet|RDA::UI::Diaglet>,
L<RDA::UI::Explorer|RDA::UI::Explorer>,
L<RDA::UI::Extra|RDA::UI::Extra>,
L<RDA::UI::Language|RDA::UI::Language>,
L<RDA::UI::Ocm|RDA::UI::Ocm>,
L<RDA::UI::Remote|RDA::UI::Remote>,
L<RDA::UI::Rda|RDA::UI::Rda>,
L<RDA::UI::Test|RDA::UI::Test>,
L<RDA::UI::Tools|RDA::UI::Tools>,
L<RDA::UI::Upgrade|RDA::UI::Upgrade>,
L<RDA::UI::Web|RDA::UI::Web>,
L<RDA::Value::Array|RDA::Value::Array>,
L<RDA::Value::Assoc|RDA::Value::Assoc>,
L<RDA::Value::Code|RDA::Value::Code>,
L<RDA::Value::Global|RDA::Value::Global>,
L<RDA::Value::Hash|RDA::Value::Hash>,
L<RDA::Value::Internal|RDA::Value::Internal>,
L<RDA::Value::List|RDA::Value::List>,
L<RDA::Value::Operator|RDA::Value::Operator>,
L<RDA::Value::Pointer|RDA::Value::Pointer>,
L<RDA::Value::Property|RDA::Value::Property>,
L<RDA::Value::Scalar|RDA::Value::Scalar>,
L<RDA::Value::Variable|RDA::Value::Variable>,
L<RDA::Web::Display|RDA::Web::Display>,
L<RDA::Web::Explorer|RDA::Web::Explorer>,
L<RDA::Web::Help|RDA::Web::Help>,
L<RDA::Web::Rda|RDA::Web::Rda>,
L<RDA::Web::System|RDA::Web::System>,
L<RDA::Web::Tool|RDA::Web::Tool>

=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