# Property.pm: Class Used for Managing Properties

package RDA::Value::Property;

# $Id: Property.pm,v 1.21 2015/08/25 07:20:36 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/Value/Property.pm,v 1.21 2015/08/25 07:20:36 RDA Exp $
#
# Change History
# 20150825  MSC  Add the LIM group.

=head1 NAME

RDA::Value::Property - Class Used for Managing Properties

=head1 SYNOPSIS

 require RDA::Value::Property;

=head1 DESCRIPTION

The objects of the C<RDA::Value::Property> class are used to manage
properties.

The following methods are available:

=cut

use strict;

BEGIN
{ use Exporter;
  use RDA::Text qw(get_string);
  use RDA::Object;
  use RDA::Object::Rda;
  use RDA::SDCL::Value;
  use RDA::Value::List;
  use RDA::Value::Scalar;
}

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

# Define the global private constants
## no critic (Numbered)
my $RE0 = qr/^\w+$/;
my $RE1 = qr/^\w+(\.\w+)*$/;
my $RE2 = qr/^(\w+\/)?\w+(\.\w+)*$/;

my $RSM = 'CDEILMPTVXcilptvx';
my $WSM = 'DERTVX';

# Define the global private variables
my %tb_cnv = (
  q{$} => qr/^[CDFLNPQST]$/,
  q{@} => qr/^$/,  ## no critic (Fixed)
  q{%} => qr/^$/,  ## no critic (Fixed)
  );
my %tb_dft = (
  q{$} => 'F',
  q{@} => q{},
  q{%} => q{},
  );
my %tb_env = (
  C => q{,},
  P => q{\|},
  V => undef,
  );
my %tb_fmt = (
  C => \&_fmt_val_comma,
  D => \&_fmt_val_dot,
  F => \&_fmt_val_first,
  L => \&_fmt_val_last,
  N => \&_fmt_val_none,
  P => \&_fmt_val_pipe,
  Q => \&_fmt_val_quote,
  S => \&_fmt_val_space,
  T => \&_fmt_val_text,
  );
my %tb_grp = (
  AS  => [1, $RE1, 'V',   q{},  \&_get_as],
  AUX => [1, $RE1, $RSM,  $WSM, \&_get_aux,       \&_set_aux ],
  CFG => [1, $RE1, 'V',   q{},  \&_get_config],
  CMD => [1, $RE1, 'V',   'V',  \&_get_command,   \&_set_command],
  CNT => [1, $RE1, 'V',   q{},  \&_get_counter],
  COL => [1, $RE1, $RSM,  $WSM, \&_get_collector, \&_set_collector],
  CTX => [1, $RE1, $RSM,  $WSM, \&_get_context,   \&_set_context ],
  CUR => [1, $RE1, 'V',   'V',  \&_get_current,   \&_set_current],
  DFT => [1, $RE1, $RSM,  $WSM, \&_get_default,   \&_set_default],
  ENV => [RDA::Object::Rda->is_windows ? 1 : 0,
             $RE1, 'CPV', 'V',  \&_get_env,       \&_set_env],
  GRP => [1, $RE1, $RSM,  $WSM, \&_get_group,     \&_set_group],
  INC => [1, $RE1, 'V',   q{},  \&_get_incr],
  LIM => [1, $RE1, $RSM,  $WSM, \&_get_limit,     \&_set_limit],
  MOD => [1, $RE1, $RSM,  $WSM, \&_get_module,    \&_set_module],
  NXT => [1, $RE1, 'V',   q{},  \&_get_next],
  OS  => [1, $RE1, 'V',   q{},  \&_get_os],
  OUT => [1, $RE1, 'V',   q{},  \&_get_output],
  PRF => [1, $RE1, 'V',   q{},  \&_get_profile],
  RDA => [1, $RE1, 'V',   q{},  \&_get_rda],
  REG => [1, $RE1, 'V',   q{},  \&_get_registry],
  RUN => [1, $RE1, $RSM,  $WSM, \&_get_run,       \&_set_run],
  SET => [1, $RE1, $RSM,  $WSM, \&_get_setup,     \&_set_setup],
  STA => [1, $RE1, $RSM,  $WSM, \&_get_status,    \&_set_status],
  SYS => [RDA::Object::Rda->is_windows ? 1 : 0,
             $RE1, 'CPV', 'V',  \&_get_system,    \&_set_system],
  VAR => [0, $RE0, 'V',   q{},  \&_get_variable],
  q{-}=> [1, $RE2, $RSM,  $WSM, \&_get_module,    \&_set_module],
  );
my %tb_mod = (
  q{$} => qr/^[CDEIMPRTVXiptvx]$/,
  q{@} => qr/^[CPRTVptv]$/,
  q{%} => qr/^[CPRTVptv]$/,
  );
## use critic

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

=head2 S<$h = RDA::Value::Property-E<gt>new($blk,$typ,$nam,$mod,$dft)>

The object constructor.

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

=over 12

=item S<    B<'blk' > > Reference to the current block

=item S<    B<'cnv' > > Conversion type

=item S<    B<'dft' > > Default value

=item S<    B<'flg' > > Dynamic name error handling indicator

=item S<    B<'grp' > > Property group

=item S<    B<'mod' > > Property mode

=item S<    B<'nam' > > Property name

=item S<    B<'sep' > > Separator (C<.> by default)

=item S<    B<'var' > > Variable type

=item S<    B<'_dyn'> > Dynamic property indicator

=item S<    B<'_get'> > Associated 'get' routine

=item S<    B<'_grp'> > Dynamic group name

=item S<    B<'_nam'> > Dynamic property name

=item S<    B<'_set'> > Associated 'set' routine

=back

Internal keys are prefixed by an underscore.

It supports the following property groups

=over 11

=item S<    B<'AS' > > Conversion properties

=item S<    B<'AUX'> > External interface

=item S<    B<'CFG'> > RDA configuration directory definitions

=item S<    B<'CMD'> > operating system commands

=item S<    B<'CNT'> > Modules counters

=item S<    B<'COL'> > Collector definition properties

=item S<    B<'CTX'> > Properties from the current setup context

=item S<    B<'CUR'> > Current execution context properties

=item S<    B<'DFT'> > Collector default properties

=item S<    B<'ENV'> > Environment variables

=item S<    B<'GRP'> > Module group properties

=item S<    B<'INC'> > Incremented module counters

=item S<    B<'LIM'> > Limit definition properties

=item S<    B<'MOD'> > Module properties

=item S<    B<'NXT'> > Incremented target counters

=item S<    B<'OS' > > Operating system indicators

=item S<    B<'OUT'> > Output/report directory definitions

=item S<    B<'PRF'> > Profile settings

=item S<    B<'RDA'> > RDA software configuration

=item S<    B<'REG'> > Agent registry entries

=item S<    B<'RUN'> > Run-time properties

=item S<    B<'SET'> > Collector setup properties

=item S<    B<'STA'> > Collector status properties

=item S<    B<'VAR'> > SDCL variables

=back

=cut

# Static property constructor
sub new
{ my ($cls, $blk, $var, $nam, $mod, $dft) = @_;
  my ($cnv, $ctl, $grp);

  # Determine the property group
  ($grp, $nam) = ($nam =~ m/^([A-Z]+|\-)\.(.*)$/i && exists($tb_grp{$1}))
    ? ($1,   $2)
    : (q{-}, $nam);
  $ctl = $tb_grp{$grp};

  # Validate the type and the mode
  die get_string('BAD_TYPE', $var)
    unless defined($var) && exists($tb_mod{$var});
  if (defined($mod))
  { if (length($mod) > 1)
    { $cnv = substr($mod, 1);
      die get_string('BAD_CONVERSION', $cnv) unless $cnv =~ $tb_cnv{$var};
      $mod = substr($mod, 0, 1);
    }
    else
    { $cnv = $tb_dft{$var};
    }
    die get_string('BAD_MODE', $mod) unless $mod =~ $tb_mod{$var};
  }
  else
  { $cnv = $tb_dft{$var};
    $mod = 'V';
  }

  # Create the property object and return its reference
  return bless {
    blk  => $blk,
    cnv  => $cnv,
    dft  => $dft,
    grp  => $grp,
    mod  => $mod,
    nam  => $ctl->[0] ? uc($nam) : $nam,
    var  => $var,
    _get => (index($ctl->[2], $mod) < 0) ? \&_get_error : $ctl->[4],
    _set => (index($ctl->[3], $mod) < 0) ? \&_set_error : $ctl->[5],
    }, ref($cls) || $cls;
}

# Dynamic property constructor
sub new_dynamic
{ my ($cls, $blk, $var, $nam, $mod, $dft, $flg, $sep) = @_;
  my ($cnv);

  # Validate the type and the mode
  die get_string('BAD_TYPE', $var)
    unless defined($var) && exists($tb_mod{$var});
  if (defined($mod))
  { if (length($mod) > 1)
    { $cnv = substr($mod, 1);
      die get_string('BAD_CONVERSION', $cnv) unless $cnv =~ $tb_cnv{$var};
      $mod = substr($mod, 0, 1);
    }
    else
    { $cnv = $tb_dft{$var};
    }
    die get_string('BAD_MODE', $mod) unless $mod =~ $tb_mod{$var};
  }
  else
  { $cnv = $tb_dft{$var};
    $mod = 'V';
  }

  # Create the property object and return its reference
  return bless {
    blk  => $blk,
    cnv  => $cnv,
    dft  => $dft,
    flg  => $flg,
    grp  => q{-},
    mod  => $mod,
    nam  => q{?},
    sep  => defined($sep) ? $sep : q{.},
    var  => $var,
    _dyn => 1,
    _nam => $nam,
    }, ref($cls) || $cls;
}

# Get the property name
sub _get_name
{ my ($slf) = @_;

  return $slf->{'var'}.'{'.$slf->{'grp'}.q{.}.$slf->{'nam'}.q{/}.$slf->{'mod'}
    .$slf->{'cnv'}.'}';
}

# Resolve dynamic group and name
sub _resolve
{ my ($slf, $flg) = @_;
  my ($ctl, $mod, $nam);

  $mod = $slf->{'mod'};
  $nam = join($slf->{'sep'}, grep {defined($_) && length($_)}
                             map {$_->eval_as_string} @{$slf->{'_nam'}});
  if ($nam =~ m/^([A-Z]+|\-)\.(.*)$/i && exists($tb_grp{uc($1)}))
  { $ctl = $tb_grp{$slf->{'grp'} = uc($1)};
    $slf->{'nam'} = $ctl->[0] ? uc($2) : $2;
  }
  else
  { $ctl = $tb_grp{$slf->{'grp'} = q{-}};
    $slf->{'nam'} = $ctl->[0] ? uc($nam) : $nam;
  }
  $slf->{'_get'} = (index($ctl->[2], $mod) < 0) ? \&_get_error : $ctl->[4];
  $slf->{'_set'} = (index($ctl->[3], $mod) < 0) ? \&_set_error : $ctl->[5];
  return 0 if $nam =~ $ctl->[1];
  return 1 if $flg && $slf->{'flg'};
  die get_string('BAD_PROPERTY', $nam);
}

=head2 S<$h-E<gt>dump([$level[,$text[,$trace]]])>

This method returns a string containing the value dump. You can provide an
indentation level, a prefix text, and a trace indicator as extra parameters.

=cut

sub dump  ## no critic (Builtin)
{ my ($slf, $lvl, $txt) = @_;

  $lvl = 0   unless defined($lvl);
  $txt = q{} unless defined($txt);

  return dump_object($slf, {}, $lvl, $txt);
}

sub dump_object
{ my ($slf, $tbl, $lvl, $txt) = @_;

  return q{  } x $lvl.$txt.(exists($slf->{'_dyn'})
    ? 'Dynamic_Property'
    : 'Property='._get_name($slf));
}

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

This method indicates whether the value can be used as a left value.

=cut

sub is_lvalue
{ return shift->{'var'};
}

=head1 ASSIGN AND EVAL METHODS

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

This method assigns a new value to the current value. It evaluates the new
value unless the flag is set. It returns the new value.

=cut

sub assign_item
{ my ($slf, $tbl) = @_;
  my ($new, $typ, $val);

  _resolve($slf) if exists($slf->{'_dyn'});
  $typ = $slf->{'var'};
  &{$slf->{'_set'}}($slf, $new =
    ($typ eq q{@}) ? [map {$_->as_data} splice(@{$tbl}, 0)] :
    ($typ eq q{%}) ? {map {$_->as_data} splice(@{$tbl}, 0)} :
                     _as_data($val = shift(@{$tbl})));
  $slf->{'blk'}->{'ctx'}->trace_data(_get_name($slf), $new);
  return;
}

sub assign_var
{ my ($slf, $val) = @_;
  my ($ctx, $new, $typ);

  _resolve($slf) if exists($slf->{'_dyn'});
  $ctx = $slf->{'blk'}->{'ctx'};
  $typ = $slf->{'var'};
  if ($typ eq q{$})
  { &{$slf->{'_set'}}($slf, $new = $ctx->set_last($val)->is_list
      ? scalar @{$val}
      : _as_data($val));
  }
  elsif ($typ eq q{@})
  { &{$slf->{'_set'}}($slf, $new = $ctx->set_last($val)->is_list
      ? [map {$_->as_data} @{$val}]
      : [$val->as_data]);
  }
  elsif ($typ eq q{%})
  { &{$slf->{'_set'}}($slf, $new = $ctx->set_last($val)->is_list
      ? {map {ref($_) ? $_->as_data : $_} @{$val}}
      : {$val->as_data});
  }
  $ctx->trace_data(_get_name($slf), $new);
  return;
}

sub _as_data
{ my ($val) = @_;

  ($val) = $val->as_data if ref($val);
  return $val;
}

sub _get_error
{ die get_string('BAD_VALUE', _get_name(@_));
}

sub _set_error
{ die get_string('BAD_ASSIGN', _get_name(@_));
}

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

This method evaluates a property. When the flag is set, it executes code
values.

=cut

sub eval_value
{ my ($slf, $flg) = @_;
  my ($dft, @tbl);

  # Evaluate the property
  @tbl = &{$slf->{'_get'}}($slf, $flg)
    unless exists($slf->{'_dyn'}) && _resolve($slf, 1);
  return ($slf->{'var'} eq q{$})
    ? RDA::Value::Scalar::new_from_data(&{$tb_fmt{$slf->{'cnv'}}}(@tbl))
    : RDA::Value::List::new_from_data(@tbl)
    unless (scalar @tbl) == 0 && defined($slf->{'dft'});

  # Return the default value when missing
  $dft = $slf->{'dft'}->eval_value($flg);
  $dft = RDA::Value::List->new($dft) unless $dft->is_list;
  return ($slf->{'var'} eq q{$}) ? $dft->[0] : $dft;
}

# --- Conversion mechanims ----------------------------------------------------

sub _fmt_val_comma
{ return join(q{,}, @_);
}

sub _fmt_val_dot
{ return join(q{.}, @_);
}

sub _fmt_val_first
{ return $_[0];
}

sub _fmt_val_last
{ return $_[-1];
}

sub _fmt_val_none
{ return join(q{}, @_);
}

sub _fmt_val_pipe
{ return join(q{|}, @_);
}

sub _fmt_val_quote
{ return join(q{ }, map {RDA::Object::Rda->quote($_)} @_);
}

sub _fmt_val_space
{ return join(q{ }, @_);
}

sub _fmt_val_text
{ return join(q{, }, @_);
}

# --- Find object mechanim ----------------------------------------------------

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

  # Treat a request without creating the property
  return ($slf->eval_value) unless $typ;

  # Get the variable value, creating the property when needed
  die get_string('INCOMPATIBLE')
    unless !defined($slf->{'var'})  ## no critic (Unless)
        || $slf->{'var'} eq $typ
        || $slf->{'var'} eq q{$};
  $val = $slf->eval_value(1);
  return ($val, [$slf->{'blk'}->{'ctx'}, $slf->{'nam'}, $val]);
}

# --- AS properties -----------------------------------------------------------

my %tb_as = (
  BAT     => sub {RDA::Object::Rda->as_bat(@_)},
  BATCH   => sub {RDA::Object::Rda->as_bat(@_, 1)},
  CMD     => sub {RDA::Object::Rda->as_cmd(@_)},
  COMMAND => sub {RDA::Object::Rda->as_cmd(@_, 1)},
  DATA    => sub {RDA::Object::decode($_[0])},
  EXE     => sub {RDA::Object::Rda->as_exe(@_)},
  IT      => sub {$_[0]},
  STRING  => sub {substr(RDA::Object::encode($_[0]), 1, -1)},
  );

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

  $dft = $slf->{'dft'};
  $dft = defined($dft) ? $dft->eval_as_string : q{};
  $nam = $slf->{'nam'};
  return (exists($tb_as{$nam}) ? &{$tb_as{$nam}}($dft) : $dft.q{.}.lc($nam));
}

# --- Auxiliary properties ----------------------------------------------------

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

  return ($slf->{'blk'}->get_top('aux')->get_element($slf->{'mod'},
    $slf->{'nam'}));
}

sub _set_aux
{ my ($slf, $val) = @_;
  my ($dft);

  return $slf->{'blk'}->get_top('aux')->set_element($slf->{'mod'},
    $slf->{'nam'}, $val,
    defined($dft = $slf->{'dft'}) ? $dft->eval_as_string : undef);
}

# --- Collector definition properties -----------------------------------------

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

  return ($slf->{'blk'}->get_collector->get_element($slf->{'mod'},
    $slf->{'nam'}));
}

sub _set_collector
{ my ($slf, $val) = @_;
  my ($dft);

  return $slf->{'blk'}->get_collector->set_element($slf->{'mod'},
    $slf->{'nam'}, $val,
    defined($dft = $slf->{'dft'}) ? $dft->eval_as_string : undef);
}

# --- Operating system command properties -------------------------------------

sub _get_command
{ my ($slf) = @_;
  my ($sys);

  $sys = $slf->{'blk'}->get_top('SYS') || $slf->{'blk'}->get_agent->get_system;
  return ($sys->get_exec($slf->{'nam'}));
}

sub _set_command
{ my ($slf, $val) = @_;
  my ($sys);

  $sys = $slf->{'blk'}->get_top('SYS') || $slf->{'blk'}->get_agent->get_system;
  return $sys->set_exec($slf->{'nam'}, $val);
}

# --- Software configuration directory group definitions ----------------------

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

  return ($slf->{'blk'}->get_config->get_group($slf->{'nam'}));
}

# --- Auxiliary context properties --------------------------------------------

sub _get_context
{ my ($slf) = @_;
  my ($ctx);

  ($ctx) = $slf->{'blk'}->get_top('aux')->get_element('V', 'K_CONTEXT');
  $ctx = defined($ctx)
    ? $slf->{'blk'}->get_collector('def')->find($ctx, 1)
    : $slf->{'blk'}->get_collector('run')->find('SETUP', 1);
  return ($ctx->get_element($slf->{'mod'}, $slf->{'nam'}));
}

sub _set_context
{ my ($slf, $val) = @_;
  my ($ctx, $dft);

  ($ctx) = $slf->{'blk'}->get_top('aux')->get_element('V', 'K_CONTEXT');
  $ctx = defined($ctx)
    ? $slf->{'blk'}->get_collector('def')->find($ctx, 1)
    : $slf->{'blk'}->get_collector('run')->find('SETUP', 1);
  return $ctx->set_element($slf->{'mod'},
    $slf->{'nam'}, $val,
    defined($dft = $slf->{'dft'}) ? $dft->eval_as_string : undef);
}

# --- Counter properties ------------------------------------------------------

sub _get_counter
{ my ($slf) = @_;
  my ($dft, $val);

  $val = $slf->{'blk'}->get_top('cnt')->{$slf->{'nam'}} || 0;
  return (defined($dft = $slf->{'dft'})
    ? sprintf($dft->eval_as_string, $val)
    : $val);
}

# --- Current objects ---------------------------------------------------------

my %tb_cur = (
  B_NO_DIALOG => sub {return shift->{'blk'}->get_collector->is_isolated},
  B_NO_OUTPUT => sub {return shift->{'blk'}->get_agent->is_quiet},
  B_SAVE      => sub {return shift->{'blk'}->get_collector->should_save},
  D_DATA      => sub {return shift->{'blk'}->get_collector('dat')},
  D_CURRENT   => sub {return shift->{'blk'}->get_output->get_current},
  D_DIRECTORY => sub {return shift->{'blk'}->get_dir},
  K_CONTEXT   => sub {return shift->{'blk'}->get_top('aux')->get_element('V',
                        'K_CONTEXT')},
  K_GROUP     => sub {my ($slf) = @_;
                      return $slf->{'blk'}->get_collector('set')->find(
                        $slf->{'blk'}->get_group, 1)->get_path;
                     },
  K_MODULE    => sub {return shift->{'blk'}->get_definition->get_path},
  K_NAME      => sub {return shift->{'blk'}->get_top('nam')},
  M_MODULE    => sub {return shift->{'blk'}->get_top('oid')},
  M_PACKAGE   => sub {return shift->{'blk'}->get_package('oid')},
  N_EGID      => sub {my ($slf) = @_;
                      my @tbl = split(/ /, $));
                      return shift(@tbl);
                     },
  N_EUID      => sub {$>},
  N_GID       => sub {my ($slf) = @_;
                      my @tbl = split(/ /, $();
                      my $gid = shift(@tbl);
                      return ($gid) if $slf->{'var'} eq q{$};
                      return @tbl;
                     },
  N_LEVEL     => sub {return shift->{'blk'}->get_collector->get_degree},
  N_OWNER     => sub {return shift->{'blk'}->get_output->get_owner},
  N_UID       => sub {return $<},
  O_ACCESS    => sub {return shift->{'blk'}->get_access},
  O_COLLECTOR => sub {return shift->{'blk'}->get_collector('def')},
  O_DEFAULT   => sub {return shift->{'blk'}->get_collector('dft')},
  O_ENV       => sub {my ($slf) = @_;
                      my $val = $slf->{'blk'}->get_top('ENV') ||
                        $slf->{'blk'}->get_agent->get_env;
                      return () unless defined($val);
                      return $val;
                     },
  O_GROUP     => sub {my ($slf) = @_;
                      return $slf->{'blk'}->get_collector('set')->find(
                        $slf->{'blk'}->get_group, 1);
                     },
  O_LAST      => sub {return shift->{'blk'}->get_output->get_info('lst')},
  O_LOCK      => sub {return shift->{'blk'}->get_lock},
  O_LOG       => sub {return shift->{'blk'}->get_collector->get_log},
  O_MODULE    => sub {return shift->{'blk'}->get_definition},
  O_REPORT    => sub {return shift->{'blk'}->get_report},
  O_REQUEST   => sub {return shift->{'blk'}->get_agent('req')},
  O_RUN       => sub {return shift->{'blk'}->get_collector('run')},
  O_SETUP     => sub {return shift->{'blk'}->get_collector('set')},
  O_STATUS    => sub {return shift->{'blk'}->get_collector('sta')},
  O_TARGET    => sub {return
                        shift->{'blk'}->get_collector->get_target->get_current},
  O_VIRTUAL   => sub {return shift->{'blk'}->get_system->get_virtual},
  W_ABBR      => sub {return shift->{'blk'}->get_output->get_abbr},
  W_AGENT     => sub {return shift->{'blk'}->get_agent('oid')},
  W_AVAILABLE => sub {my ($slf) = @_;
                      my ($val, @tbl);
                      $val = $slf->{'blk'}->get_package('sct');
                      @tbl = grep {$val->{$_} == 0} keys(%{$val});
                      return scalar @tbl if $slf->{'var'} eq q{$};
                      return (sort @tbl);
                     },
  W_COLLECTOR => sub {return shift->{'blk'}->get_collector('oid')},
  W_GROUP     => sub {return shift->{'blk'}->get_group},
  W_MODULE    => sub {return shift->{'blk'}->get_definition->get_oid},
  W_NEXT      => sub {return @{shift->{'blk'}->get_package('nxt')}},
  W_NODE      => sub {return shift->{'blk'}->get_agent('nod')},
  W_PREFIX    => sub {return shift->{'blk'}->get_output->get_prefix},
  W_PREVIOUS  => sub {my ($slf) = @_;
                      my $val = $slf->{'blk'}->get_package('sct');
                      my @tbl = grep {$val->{$_} > 0} keys(%{$val});
                      return (scalar @tbl) if $slf->{'var'} eq q{$};
                      return (sort @tbl);
                     },
  W_SECTIONS  => sub {my ($slf) = @_;
                      my @tbl = keys(%{$slf->{'blk'}->get_package('sct')});
                      return (scalar @tbl) if $slf->{'var'} eq q{$};
                      return (sort @tbl);
                     },
  W_SHLIB     => sub {my ($slf) = @_;
                      return (scalar $slf->{'blk'}->get_config->get_shlib)
                        if $slf->{'var'} eq q{$};
                      return $slf->{'blk'}->get_config->get_shlib;
                     },
  );

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

  $nam = $slf->{'nam'};
  return () unless exists($tb_cur{$nam});
  return (&{$tb_cur{$nam}}($slf));
}

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

  _set_error($slf) unless $slf->{'nam'} eq 'W_NEXT';

  die get_string('INCOMPATIBLE') unless ref($val) eq 'ARRAY';
  return $slf->{'blk'}->get_package->set_info('nxt', $val);
}

# --- Collector DFT definition properties -------------------------------------

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

  return ($slf->{'blk'}->get_collector('dft')->get_element($slf->{'mod'},
    $slf->{'nam'}));
}

sub _set_default
{ my ($slf, $val) = @_;
  my ($dft);

  return $slf->{'blk'}->get_collector('dft')->set_element($slf->{'mod'},
    $slf->{'nam'}, $val,
    defined($dft = $slf->{'dft'}) ? $dft->eval_as_string : undef);
}

# --- Environment properties --------------------------------------------------

sub _get_env
{ my ($slf) = @_;
  my ($env);

  $env = $slf->{'blk'}->get_top('ENV') || $slf->{'blk'}->get_agent->get_env;
  return ($env->get_value($slf->{'nam'})) if $slf->{'var'} eq q{$};
  return ($env->split_value($slf->{'nam'}, $tb_env{$slf->{'mod'}}));
}

sub _set_env
{ my ($slf, $val) = @_;
  my ($env);

  $env = $slf->{'blk'}->get_top('ENV') || $slf->{'blk'}->get_agent->get_env;
  return $env->set_value($slf->{'nam'}, $val);
}

# --- Module group definition properties --------------------------------------

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

  return ($slf->{'blk'}->get_collector('set')->find($slf->{'blk'}->get_group,
    1)->get_element($slf->{'mod'}, $slf->{'nam'}));
}

sub _set_group
{ my ($slf, $val) = @_;
  my ($dft);

  return $slf->{'blk'}->get_collector('set')->find($slf->{'blk'}->get_group,
    1)->set_element($slf->{'mod'}, $slf->{'nam'}, $val,
    defined($dft = $slf->{'dft'}) ? $dft->eval_as_string : undef);
}

# --- Counter incrementation properties ---------------------------------------

sub _get_incr
{ my ($slf) = @_;
  my ($dft, $val);

  $val = ++$slf->{'blk'}->get_top('cnt')->{$slf->{'nam'}};
  return (defined($dft = $slf->{'dft'})
    ? sprintf($dft->eval_as_string, $val)
    : $val);
}

# --- Limit definition properties ---------------------------------------------

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

  return ($slf->{'blk'}->get_collector('lim')->get_element($slf->{'mod'},
    $slf->{'nam'}));
}

sub _set_limit
{ my ($slf, $val) = @_;
  my ($dft);

  return $slf->{'blk'}->get_collector('lim')->set_element($slf->{'mod'},
    $slf->{'nam'}, $val,
    defined($dft = $slf->{'dft'}) ? $dft->eval_as_string : undef);
}

# --- Module definition properties --------------------------------------------

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

  if ($slf->{'nam'} =~ m/^(\w+)\/(.*)$/)
  { if ($1 eq 'PRF')
    { return ($slf->{'blk'}->get_collector->get_change($2))
        if $slf->{'mod'} eq 'V';
      die get_string('INVALID_MODE');
    }
    return ($slf->{'blk'}->get_agent->get_item($1)->get_element($slf->{'mod'},
      $2));
  }
  return ($slf->{'blk'}->get_definition->get_element($slf->{'mod'},
    $slf->{'nam'}));
}

sub _set_module
{ my ($slf, $val) = @_;
  my ($dft);

  if ($slf->{'nam'} =~ m/^(\w+)\/(.*)$/)
  { die get_string('READ_ONLY') if $1 eq 'PRF';
    return ($slf->{'blk'}->get_agent->get_item($1)->set_element($slf->{'mod'},
      $2, $val,
      defined($dft = $slf->{'dft'}) ? $dft->eval_as_string : undef));
  }
  return $slf->{'blk'}->get_definition->set_element($slf->{'mod'},
    $slf->{'nam'}, $val,
    defined($dft = $slf->{'dft'}) ? $dft->eval_as_string : undef);
}

# --- Target name generation properties ---------------------------------------

sub _get_next
{ my ($slf) = @_;
  my ($dft);

  return ($slf->{'blk'}->get_collector->get_next($slf->{'nam'},
    defined($dft = $slf->{'dft'}) ? $dft->eval_as_string : undef));
}

# --- Operating system indicators ---------------------------------------------

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

  return ((uc($slf->{'blk'}->get_config->get_os) eq $slf->{'nam'}) ? 1 : 0);
}

# --- Report directories ------------------------------------------------------

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

  return ($slf->{'blk'}->get_collector->get_dir($slf->{'nam'}));
}

# --- Profile change properties -----------------------------------------------

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

  return () unless ($def = $slf->{'blk'}->get_top('def'));
  $def = $def->get_path;
  return () unless $def =~ s/^SETUP\.//;
  return ($slf->{'blk'}->get_collector->get_change($def.q{.}.$slf->{'nam'}));
}

# --- RDA properties ----------------------------------------------------------

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

  return ($slf->{'blk'}->get_config->get_value($slf->{'nam'}));
}

# --- RDA registry entries ----------------------------------------------------

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

  return (ref($slf->{'dft'})
    ? $slf->{'blk'}->get_agent->get_registry('REG.'.$slf->{'nam'},
        sub {shift->eval_as_data(1)}, $slf->{'dft'})
    : $slf->{'blk'}->get_agent->get_registry('REG.'.$slf->{'nam'}));
}

# --- Run-time properties -----------------------------------------------------

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

  return ($slf->{'blk'}->get_collector('run')->get_element($slf->{'mod'},
    $slf->{'nam'}));
}

sub _set_run
{ my ($slf, $val) = @_;
  my ($dft);

  return $slf->{'blk'}->get_collector('run')->set_element($slf->{'mod'},
    $slf->{'nam'}, $val,
    defined($dft = $slf->{'dft'}) ? $dft->eval_as_string : undef);
}

# --- Collector SET definition properties -------------------------------------

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

  return ($slf->{'blk'}->get_collector('set')->get_element($slf->{'mod'},
    $slf->{'nam'}));
}

sub _set_setup
{ my ($slf, $val) = @_;
  my ($dft);

  return $slf->{'blk'}->get_collector('set')->set_element($slf->{'mod'},
    $slf->{'nam'}, $val,
    defined($dft = $slf->{'dft'}) ? $dft->eval_as_string : undef);
}

# --- Collector STA definition properties -------------------------------------

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

  return ($slf->{'blk'}->get_collector('sta')->get_element($slf->{'mod'},
    $slf->{'nam'}));
}

sub _set_status
{ my ($slf, $val) = @_;
  my ($dft);

  return $slf->{'blk'}->get_collector('sta')->set_element($slf->{'mod'},
    $slf->{'nam'}, $val,
    defined($dft = $slf->{'dft'}) ? $dft->eval_as_string : undef);
}

# --- System Environment properties -------------------------------------------

sub _get_system
{ my ($slf) = @_;
  my ($sys);

  $sys = $slf->{'blk'}->get_system;
  return ($sys->get_value($slf->{'nam'})) if $slf->{'var'} eq q{$};
  return ($sys->split_value($slf->{'nam'}, $tb_env{$slf->{'mod'}}));
}

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

  return $slf->{'blk'}->get_system->set_value($slf->{'nam'}, $val);
}

# --- Variable properties -----------------------------------------------------

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

  return ($slf->{'blk'}->get_context->get_value(
    $slf->{'var'}.$slf->{'nam'})->eval_value($flg));
}

1;

__END__

=head1 SEE ALSO

L<RDA::Agent|RDA::Agent>,
L<RDA::Object|RDA::Object>,
L<RDA::Object::Env|RDA::Object::Env>,
L<RDA::Object::Output|RDA::Object::Output>,
L<RDA::Object::Target|RDA::Object::Target>,
L<RDA::SDCL::Block|RDA::SDCL::Block>,
L<RDA::SDCL::Context|RDA::SDCL::Context>,
L<RDA::SDCL::Value|RDA::SDCL::Value>,
L<RDA::SDSL::Module|RDA::SDSL::Module>,
L<RDA::SDSL::Setting|RDA::SDSL::Setting>,
L<RDA::Text|RDA::Text>,
L<RDA::Value::Scalar|RDA::Value::Scalar>,
L<RDA::Value::List|RDA::Value::List>

=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