# Setting.pm: Class Used for Objects to Setup Settings

package RDA::SDSL::Setting;

# $Id: Setting.pm,v 1.26 2015/05/09 14:46:01 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/SDSL/Setting.pm,v 1.26 2015/05/09 14:46:01 RDA Exp $
#
# Change History
# 20150508  MSC  Change the display and tracing.

=head1 NAME

RDA::SDSL::Setting - Class Used for Objects to Setup Settings

=head1 SYNOPSIS

 require RDA::SDSL::Setting;

=head1 DESCRIPTION

The objects of the C<RDA::SDSL::Setting> class are used to manage the setup of
a setting.

The following methods are available:

=cut

use strict;

BEGIN
{ use Exporter;
  use IO::File;
  use RDA::Text qw(debug get_string);
  use RDA::Agent qw($INTERRUPT);
  use RDA::Object;
  use RDA::Object::Message;
  use RDA::Object::Rda;
  use RDA::Object::View;
  use RDA::Object::Windows;
  use RDA::Object::Xml;
}

# Define the global public variables
use vars qw($DMP_DEF $DMP_INP $DMP_NXT $DMP_SET $STRINGS $VERSION @DUMP @ISA);
$DMP_DEF = 0;
$DMP_INP = 0;
$DMP_NXT = 0;
$DMP_SET = 0;
$VERSION = sprintf('%d.%02d', q$Revision: 1.26 $ =~ /(\d+)\.(\d+)/);
@DUMP    = (
  obj => {'RDA::Value::Array'    => 1,
          'RDA::Value::Assoc'    => 1,
          'RDA::Value::Code'     => 1,
          'RDA::Value::Global'   => 1,
          'RDA::Value::Hash'     => 1,
          'RDA::Value::Internal' => 1,
          'RDA::Value::List'     => 1,
          'RDA::Value::Operator' => 1,
          'RDA::Value::Pointer'  => 1,
          'RDA::Value::Property' => 1,
          'RDA::Value::Scalar'   => 1,
          'RDA::Value::Variable' => 1,
         },
  );
@ISA     = qw(Exporter);

# Define the global private constants
my $FMT_DFT = '  %-*s  ';
my $FMT_NUM = '  %*d  ';
my $FMT_STR = '  %-*s  ';

my $EMP = q{};
my $SEP = " +--------\n";

# Define the global private variables
my $re_cfg = qr/^<<(CONFIG):((\w+\.)*\w+):(\d+)(P?):(.*)$/i;
my $re_ext = qr/^<<EXTERN:([\w\/]+):(\w+):(.*)$/i;
my $re_mrc = qr/^<<MRC:(\w+):(\*?(\w+\.)*\w+)(:(.*))?$/i;
my $re_lst = qr/^<<(LIST):((\w+\.)*\w+):(\-?\d+):(.*)$/i;
my $re_pth = qr/^<<PATH:([CDFMS]):(.*)$/i;
my $re_reg = qr/^<<(REG|REG32|REG64):([^:]+):(\w+)(:(.*))?$/i;
my $re_src = qr/^<<(SEARCH):((\w+\.)*\w+):([bdnprtw1-9]*):(.*)$/i;
my $re_xml = qr/^<<XML:((\w+\.)*\w+):(\w*):(.*)$/i;

my %tb_dft = (
  'B' => \&_dft_boolean,
  'C' => \&_dft_comment,
  'D' => \&_dft_dir,
  'E' => \&_dft_event,
  'F' => \&_dft_file,
  'I' => \&_dft_item,
  'L' => \&_dft_loop,
  'M' => \&_dft_menu,
  'N' => \&_dft_number,
  'S' => \&_dft_setup,
  'T' => \&_dft_text,
  );
my %tb_dsp = (
  'B' => \&_dsp_help,
  'D' => \&_dsp_help,
  'F' => \&_dsp_help,
  'I' => \&_dsp_help,
  'M' => \&_dsp_menu,
  'N' => \&_dsp_help,
  'T' => \&_dsp_help,
  );
my %tb_flt = (
  'B' => [\&_flt_scalar],
  'C' => [\&_flt_scalar],
  'D' => [\&_flt_scalar],
  'E' => [\&_flt_scalar],
  'F' => [\&_flt_scalar],
  'I' => [\&_flt_item],
  'L' => [\&_flt_loop, \&_flt_scalar],
  'M' => [\&_flt_scalar],
  'N' => [\&_flt_scalar],
  'S' => [\&_flt_scalar],
  'T' => [\&_flt_scalar],
  );
my %tb_get = (
  'B' => \&_get_boolean,
  'D' => \&_get_dir,
  'F' => \&_get_file,
  'L' => \&_get_loop,
  'M' => \&_get_menu,
  'N' => \&_get_number,
  'T' => \&_get_text,
  );
my %tb_res = (
  'B' => \&_res_boolean,
  'C' => \&_res_comment,
  'D' => \&_res_dir,
  'E' => \&_res_event,
  'F' => \&_res_file,
  'I' => \&_res_none,
  'L' => \&_res_loop,
  'M' => \&_res_menu,
  'N' => \&_res_number,
  'S' => \&_res_setup,
  'T' => \&_res_text,
  );
my %tb_val = (
  'B' => \&_val_boolean,
  'D' => \&_val_dir,
  'F' => \&_val_file,
  'I' => \&_val_item,
  'L' => \&_val_loop,
  'M' => \&_val_menu,
  'N' => \&_val_number,
  'T' => \&_val_text,
  );

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

=head2 S<$h = RDA::SDSL::Setting-E<gt>new($nam)>

The object constructor. It takes the setting name as an argument.

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

=over 12

=item S<    B<'_add'> > Additional menu item definition

=item S<    B<'_aft'> > After text

=item S<    B<'_alt'> > Array of alternative settings

=item S<    B<'_ask'> > Interaction control indicator

=item S<    B<'_aux'> > Auxiliary properties

=item S<    B<'_bef'> > Before text

=item S<    B<'_bkp'> > Attribute backup hash

=item S<    B<'_brk'> > Value that indicates the end of a loop

=item S<    B<'_cas'> > Case sensitivity indicator

=item S<    B<'_clr'> > Clear string

=item S<    B<'_cls'> > Class name

=item S<    B<'_col'> > Optional multi-column indicator

=item S<    B<'_ctx'> > Validation context

=item S<    B<'_def'> > Alternative item name

=item S<    B<'_del'> > Value to request a hash key deletion

=item S<    B<'_dft'> > Default value list

=item S<    B<'_dsc'> > Description string

=item S<    B<'_dup'> > Duplication value error message

=item S<    B<'_end'> > String that indicates the end of a value list

=item S<    B<'_err'> > Setting error text

=item S<    B<'_fam'> > Optional list of operating system families

=item S<    B<'_fmt'> > Optional formatting directives

=item S<    B<'_hlp'> > Setting help text

=item S<    B<'_inp'> > Setting prompt string

=item S<    B<'_itm'> > Menu item definition

=item S<    B<'_lvl'> > Required setting level

=item S<    B<'_key'> > Hash key

=item S<    B<'_man'> > Setting manual text

=item S<    B<'_mnu'> > Menu item definition

=item S<    B<'_nam'> > Effective setting name

=item S<    B<'_nxt'> > Array of next values (iterative mode)

=item S<    B<'_one'> > Value to convert a value list in a single value

=item S<    B<'_opt'> > Optional setting flag

=item S<    B<'_par'> > Name of the parent item

=item S<    B<'_pck'> > Pick indicator

=item S<    B<'_raw'> > Raw value indicator

=item S<    B<'_ref'> > Setting validation reference

=item S<    B<'_rsp'> > Valid menu responses

=item S<    B<'_set'> > Definition name

=item S<    B<'_syn'> > Menu response synonyms

=item S<    B<'_typ'> > Setting type

=item S<    B<'_val'> > Setting validation type

=item S<    B<'_var'> > Lists of additional settings

=item S<    B<'_vis'> > Flag to control character echo during input

=item S<    B<'.add'> > Information associated to the extra item

=item S<    B<'.als'> > Input alias hash

=item S<    B<'.alt'> > Alternative menu selector format

=item S<    B<'.ask'> > Interaction control

=item S<    B<'.cnt'> > Retry counter

=item S<    B<'.ctx'> > Effective validation context

=item S<    B<'.cur'> > Current value

=item S<    B<'.fmt'> > Menu selector format

=item S<    B<'.eof'> > Indicates when to accept a default at the end of file

=item S<    B<'.itm'> > Menu item description hash

=item S<    B<'.key'> > Current attribute

=item S<    B<'.lgt'> > Maximum length of the menu item selectors

=item S<    B<'.mnu'> > Array of displayed menu items

=item S<    B<'.nam'> > Effective setting names related to extra items

=item S<    B<'.nxt'> > Array of next values (block mode)

=item S<    B<'.pck'> > Array of pick values

=item S<    B<'.prv'> > Array of previous values

=item S<    B<'.rsp'> > Menu response hash

=item S<    B<'.syn'> > Menu response synonym hash

=item S<    B<'.sav'> > Saved elements

=back

The following keys are used to store SDCL expressions:

=over 12

=item S<    B<'-add'> > Additional menu item definition

=item S<    B<'-aft'> > After text

=item S<    B<'-ask'> > Interaction control value

=item S<    B<'-bef'> > Before text

=item S<    B<'-cas'> > Case sensitivity indicator

=item S<    B<'-clr'> > Clear string

=item S<    B<'-cls'> > Class name

=item S<    B<'-col'> > Multi-column indicator

=item S<    B<'-ctx'> > Validation context

=item S<    B<'-def'> > Alternative item name

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

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

=item S<    B<'-dsc'> > Description string

=item S<    B<'-dup'> > Duplication value error message

=item S<    B<'-end'> > String that indicates the end of a value list or a loop

=item S<    B<'-err'> > Setting error text

=item S<    B<'-hlp'> > Setting help text

=item S<    B<'-inp'> > Setting prompt string

=item S<    B<'-itm'> > Menu item definition

=item S<    B<'-mnu'> > Menu items sequence

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

=item S<    B<'-one'> > Value to convert a value list in a single value

=item S<    B<'-opt'> > Optional setting indicator

=item S<    B<'-par'> > Name of the parent item

=item S<    B<'-pck'> > Pick indicator

=item S<    B<'-raw'> > Raw value indicator

=item S<    B<'-ref'> > Setting validation reference

=item S<    B<'-rsp'> > Menu responses

=item S<    B<'_syn'> > Menu response synonyms

=item S<    B<'-vis'> > Character echo indicator

=back

Internal keys are prefixed by an underscore, a period, or a dash.

=cut

sub new
{ my ($cls, $nam) = @_;

  return bless {
    _ask => 1,
    _aux => {},
    _bkp => {},
    _cas => 1,
    _clr => $EMP,
    _col => 0,
    _del => $EMP,
    _dft => [],
    _dsc => $nam,
    _itm => $EMP,
    _lvl => 0,
    _mnu => $EMP,
    _nam => $nam,
    _nxt => [],
    _opt => 0,
    _pck => 0,
    _set => $nam,
    _typ => 'T',
    _var => [{}, []],
    _vis => 1,
    '.prv' => [],
    }, ref($cls) || $cls;
}

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

This method deletes the setting object.

=cut

sub delete_object
{ undef %{$_[0]};
  undef $_[0];
  return;
}

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

This method returns the setting details. Only settings that have an C<inp>,
C<hlp>, or C<man> property are considered. Otherwise, it returns an empty list.

=cut

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

  # Treat an item setting
  if ($slf->{'_typ'} eq 'I')  # Text:ItemSelect  Text:ListSelect
  { return () unless $slf->{'_vis'};
    return ( $slf->{'_nam'},
      exists($slf->{'-lvl'}) ? $slf->{'-lvl'}->eval_as_number : $slf->{'_lvl'},
      q{"}.(exists($slf->{'_bef'})
        ? $slf->{'_bef'}
        : get_string($slf->{'_end'} ? 'ListSelect'
                                    : 'ItemSelect', uc($slf->{'_cls'}))).q{"},
      exists($slf->{'_man'}) ? $slf->{'_man'} :
      exists($slf->{'_hlp'}) ? $slf->{'_hlp'} :
      exists($slf->{'-hlp'}) ? '<dynamic help>' :
                               undef
    )
  }

  # Detect another relevant setting
  return () unless $slf->{'_typ'} ne 'C' &&  ## no critic (Unless)
    (exists($slf->{'_inp'}) || exists($slf->{'_man'}) || $slf->{'_pck'} ||
     exists($slf->{'_hlp'}));

  # Provide the setting details
  return ( $slf->{'_nam'},
    exists($slf->{'-lvl'}) ? $slf->{'-lvl'}->eval_as_number : $slf->{'_lvl'},
    (exists($slf->{'_inp'}) || $slf->{'_pck'}) ? _get_detail($slf) : undef,
    exists($slf->{'_man'}) ? $slf->{'_man'} :
    exists($slf->{'_hlp'}) ? $slf->{'_hlp'} :
    exists($slf->{'-hlp'}) ? '<dynamic help>' :
                             undef
  );
}

sub _get_detail  ## no critic (Complex)
{ my ($slf) = @_;
  my (@tbl);

  if ($slf->{'_typ'} eq 'M')
  { my ($cnt, $key, $lgt, $max, $str, $val, @itm, @key, %tbl);

    return unless exists($slf->{'_itm'});

    push(@tbl, $slf->{'_bef'}) if exists($slf->{'_bef'});
    if (exists($slf->{'_exe'}) && _has_aux($slf->{'_exe'}, 'AUX.itm'))
    { push(@tbl, '[Dynamic menu]');
    }
    elsif ($slf->{'_itm'} =~ m/([\@\$]\{.*\}|^<<MRC:)/i)
    { push(@tbl, '[Dynamic menu]');
    }
    else
    { if ($slf->{'_itm'} =~ m/^\s*\133/)
      { ($cnt, @itm) = (0, _decode_list($slf->{'_itm'},
          q{\133}, q{\135}));  ## no critic (Interpolation)
        while (($key, $val) = splice(@itm, 0, 2))
        { last unless defined($val);
          push(@key, ++$cnt);
          $tbl{$cnt} = $val;
        }
      }
      elsif ($slf->{'_itm'} =~ m/^\s*\050/)
      { @itm = _decode_list($slf->{'_itm'},
          q{\050}, q{\051});  ## no critic (Interpolation)
        while (($key, $val) = splice(@itm, 0, 2))
        { last unless defined($val);
          push(@key, $key);
          $tbl{$key} = $val;
        }
      }
      else
      { _spl_menu(\%tbl, \@key, $slf->{'_itm'});
      }
      $max = 0;
      foreach my $itm (sort keys(%tbl))
      { $max = $lgt if ($lgt = length($itm)) > $max;
      }
      if ($slf->{'_mnu'} =~ m/^<<n(umber)?$/i)
      { @key = sort {$a <=> $b} keys(%tbl);
      }
      elsif ($slf->{'_mnu'} =~ m/^<<t(ext)?$/i)
      { @key = sort keys(%tbl);
      }
      foreach my $itm (@key)
      { $str = sprintf('  %-*s  ', $max, $itm);
        $str =~ s/\s/\\040/g;
        push(@tbl, $str.$tbl{$itm});
      }
    }
    push(@tbl, $slf->{'_aft'}) if exists($slf->{'_aft'});
  }
  return
    join(qq{\\n}, @tbl, q{"}.(exists($slf->{'_inp'}) ? $slf->{'_inp'} :
                              $slf->{'_pck'}         ? get_string('PickInput') :
                                                       $EMP).q{"});
}

sub _decode_list
{ my ($str, $beg, $end) = @_;
  my (@tbl);

  $str =~ s/^\s*$beg\s*//;
  for (;;)  ## no critic (Loop)
  { if ($str =~ s/^(\w+)\s*(,|\=>)\s*/,/)
    { push(@tbl, $1);
    }
    elsif ($str =~ s/^(['"])(.*?)\1\s*//)
    { push(@tbl, $2);
    }
    return @tbl if $str =~ m/^$end/;
    last unless $str =~ s/^(,|=>)\s*//;
  }
  push(@tbl, $str);
  return @tbl;
}

sub _has_aux
{ my ($exe, $nam) = @_;

  for (@{$exe})
  { return 1 if m/\{$nam[:\}]/;
  }
  return 0;
}

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

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

=cut

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

  $ref = ref($slf);
  @tbl = eval "\@$ref\:\:DUMP";  ## no critic (Eval)
  return RDA::Object::dump_obj($slf, {@tbl}, $lvl, $txt);
}

=head2 S<$h-E<gt>is_valid($family)>

This method indicates whether the setting is applicable for the specified
operating system family.

=cut

sub is_valid
{ my ($slf, $fam) = @_;

  # Accept it directly if there is no restriction
  return 1 unless exists($slf->{'_fam'});

  # Check if the family is included in the list
  for (@{$slf->{'_fam'}})
  { return 1 if $_ eq $fam;
  }

  # Otherwise, reject it
  return 0;
}

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

This method resets the setting for restarting the module setup. It returns the
object reference.

=cut

sub reset  ## no critic (Builtin)
{ my ($slf) = @_;

  foreach my $key (keys(%{$slf}))
  { delete($slf->{$key}) if $key =~ m/^\./;
  }
  return $slf;
}

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

This method assigns a new value to the given object key when the value is
defined. Otherwise, it deletes the object attribute.

It returns the previous value.

=cut

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

  if (defined($val))
  { ($slf->{$key}, $val) = ($val, $slf->{$key});
  }
  else
  { $val = delete($slf->{$key});
  }
  return $val;
}

=head2 S<$h-E<gt>setup($module,$level,$list[,$trace])>

This method gets the setting value. When appropriate, it adds additional
settings to the input list.

=cut

sub setup  ## no critic (Complex)
{ my ($slf, $mod, $lvl, $lst, $trc) = @_;
  my ($ask, $dbg, $def, $flg, $inp, $nam, $pre, $typ, $val);

  # Restore object attributes
  foreach my $key (keys(%{$val = $slf->{'_bkp'}}))
  { $slf->set_info($key, delete($val->{$key}));
  }
  _dump_setting($slf, 'INIT') if $DMP_SET;

  # Determine the current definition
  eval {
    $def = $mod->get_definition(exists($slf->{'-def'})
      ? $slf->{'-def'}->eval_as_string
      : $slf->{'_def'});
    };
    return _abort_setup($mod, $trc, $@, 'def') if $@;
  _dump_text($slf, 'DEFINITION: '.$def->get_path.' in '
    .$def->get_top->get_info('ttl')) if $DMP_DEF;

  # Prepare the setup
  $typ = $slf->{'_typ'};
  unless (exists($slf->{'.sav'}))
  { # Initialize setting properties
    $flg = $mod->is_isolated;
    $slf->{'_aux'}->{'B_NO_DIALOG'} = [0, $flg ? 1 : 0];

    # Execute the associate logic
    if (exists($slf->{'_exe'}))
    { eval {&{$slf->{'_exe'}->[0]}($mod, $slf->{'_exe'},
                                   get_string('ERR_EXE', $slf->{'_set'}))};
      if ($@)
      { $mod->trace_logic($@, $trc);
        return;
      }
      _dump_setting($slf, 'PREPARE') if $DMP_SET;
    }

    # Convert values
    foreach my $key (qw(col lvl opt pck raw vis))
    { next unless exists($slf->{"-$key"});
      eval {$slf->{"_$key"} = $slf->{"-$key"}->eval_as_number};
      return _abort_setup($mod, $trc, $@, $key) if $@;
    }
    foreach my $key (qw(cas clr del end inp key nam))
    { next unless exists($slf->{"-$key"});
      eval {$slf->{"_$key"} = $slf->{"-$key"}->eval_as_string};
      return _abort_setup($mod, $trc, $@, $key) if $@;
    }
    if ($slf->{'_pck'})
    { $slf->{'_end'} = $EMP unless defined($slf->{'_end'});
      $slf->{'_err'} = get_string('PickError') unless $slf->{'_err'};
      $slf->{'_inp'} = get_string('PickInput') unless $slf->{'_inp'};
      $slf->{'_mnu'} = '<<N';
    }

    # Get the default values
    eval {
      $slf->{'.key'} = undef;
      $slf->{'.ask'} = ($flg || $lvl < $slf->{'_lvl'})
        ? 0
        : (exists($slf->{'_inp'}) && exists($tb_get{$typ}));
      $slf->{'_aux'}->{'B_NO_DIALOG'} = [0, 1] unless $slf->{'.ask'};
      $slf->{'.key'} = 'dft';
      $val = &{$tb_dft{$typ}}($slf, _get_defaults($slf, $mod, $def, $typ),
        $mod, $flg, $trc);
      };
    return _abort_setup($mod, $trc, $@, $slf->{'.key'}) if $@;
    if ($val)
    { _dump_setting($slf, 'SKIP') if $DMP_SET;
      unshift(@{$lst}, @{$slf->{'_alt'}}) if exists($slf->{'_alt'});
      _dump_text($slf, 'NEXT: '.join(', ',@{$lst})) if $DMP_NXT;
      debug($trc, get_string('NoAssign')) if $trc;
      return;
    }
    _dump_setting($slf, 'ASK') if $DMP_SET;
  }

  # Ask the setting value
  eval {
    if ($ask = $slf->{'.ask'})
    { &{$tb_dsp{$typ}}($slf, $mod) if exists($tb_dsp{$typ});
      _nxt_val($slf, []);
      while ($ask)
      { $inp = $mod->resolve_string($inp, 1) if defined($inp = $slf->{'_inp'});
        if (ref($ask) eq 'CODE')
        { ($val, $ask) = &$ask($slf, $mod, $inp, $lst);
        }
        else
        { $val = $slf->{'_vis'} ? _ask_setting($slf, $mod, $inp) :
                                  _ask_password($slf, $mod, $inp);
          if (!defined($val))
          { _dump_text($slf, 'INPUT: undef') if $DMP_INP;
            $ask = 0;
            $val = $slf->{'_nxt'} if defined($slf->{'_end'});
          }
          elsif (defined($slf->{'_end'}) && $val eq $slf->{'_end'})
          { _dump_text($slf, "END: '$val'") if $DMP_INP;
            ($val, $ask) = ($slf->{'_nxt'}, 0);
          }
          elsif ($val eq q{?})
          { _dump_text($slf, 'REFRESH') if $DMP_INP;
            &{$tb_dsp{$typ}}($slf, $mod) if exists($tb_dsp{$typ});
          }
          else
          { $val = uc($val) unless $slf->{'_cas'};
            _dump_text($slf, "INPUT: '$val'") if $DMP_INP;
            ($val, $ask) = &{$tb_get{$typ}}($slf, $mod, $val, $lst);
          }
        }
      }
    }
    else
    { $val = &{$tb_val{$typ}}($slf, $mod, $lst);
    }
    };
  return _abort_setup($mod, $trc, $@) if $@;
  _dump_text($slf, 'NEXT: '.join(', ',@{$lst})) if $DMP_NXT;

  # Create or update the setting and return its effective name
  $nam = $slf->{'_nam'};
  $pre = $EMP;
  $val = $val->[0] if ref($val) eq 'ARRAY' && (scalar @{$val}) == 1;
  $dbg = _debug_scalar($val, $def) if $trc;
  if ($nam =~ s/^-//)
  { $def = $mod->find($pre = $1) if $nam =~ s/^([A-Z][A-Z\d]*\/(\w+\.)*)//;
    $nam =~ s/[\W_]+/_/g;
    debug($trc, q{-}.$pre.$nam.q{=}.$dbg) if $trc;
    if (length($nam))
    { eval {
        if (defined($val))
        { $def->set_temp($nam, $val);
        }
        else
        { $def->clear_temp($nam);
        }
        };
      debug($trc, $@) if $@ && $trc;
    }
    return;
  }
  if ($nam =~ s/^&//)
  { $nam =~ s/[\W_]+/_/g;
    debug($trc, q{&}.$nam.q{=}.$dbg) if $trc;
    eval {$mod->exec_code($nam, $val)};
    debug($trc, $@) if $@ && $trc;
    return;
  }
  $def = $mod->find($pre = $1) if $nam =~ s/^([A-Z][A-Z\d]*\/(\w+\.)*)//;
  $nam =~ s/[\W_]+/_/g;
  if (length($nam))
  { eval {
      if (exists($slf->{'_key'}))
      { $typ = $slf->{'_key'};
        if (defined($val))
        { debug($trc, $pre.$nam.'{\''.$typ.'\'}='.$dbg) if $trc;
          $mod->get_tie($def, $nam, $slf->{'_raw'})->{$typ} = $val;
        }
        else
        { debug($trc, $pre.$nam.'{\''.$typ.'\'} '.get_string('Deleted'))
            if $trc;
          delete($mod->get_tie($def, $nam, $slf->{'_raw'})->{$typ});
        }
      }
      elsif ($slf->{'_raw'})
      { $def->set_raw($nam, $val);
        debug($trc, $pre.$nam.'(raw)='.$dbg) if $trc;
      }
      else
      { $def->set_value($nam, $val);
        debug($trc, $pre.$nam.q{=}.$dbg) if $trc;
      }
      $def->set_desc($nam, exists($slf->{'-dsc'})
        ? $slf->{'-dsc'}->eval_as_string
        : $slf->{'_dsc'})
        if defined($val) && $nam !~ m/^\-/;
      };
    debug($trc, $@) if $@ && $trc;
  }
  return $nam;
}

sub _abort_setup
{ my ($mod, $trc, $txt, $key) = @_;
  my ($err, $rec);

  die $txt if $txt =~ m/^$INTERRUPT/;

  $rec = $mod->add_error($txt)->pop_error;
  if ($trc && defined($err = $rec->[0]))
  { $err =~ s/:$//;
    $rec->[0] = defined($key)
      ? get_string('Error', $err, $key)
      : $err;
    debug(join(qq{\n}, $trc, $mod->format_error($rec, -1, q{ })));
  }
  return;
}

# Ask the user value
sub _ask_setting
{ my ($slf, $mod, $inp) = @_;
  my ($buf, $cur, $end);

  $buf = _fmt_str($inp, 1);
  if (length($cur = $slf->{'.cur'}))
  { $cur =~ s/\\/\\134/g;
    $buf .= _fmt_str(get_string('Default', $cur), 1);
  }
  return _ask_lin($mod, $buf.".P0\n>\\040\n\n", $slf->{'_clr'}, $slf->{'_del'},
    $slf->{'.cur'}, $slf);
}

sub _ask_lin
{ my ($mod, $txt, $clr, $del, $dft, $ctl) = @_;
  my ($lin, $rsp);

  $rsp = $mod->submit(q{.},
    RDA::Object::Message->new('ASK.ASK_LINE')->add_data($txt));

  # Treat a response error
  unless ($rsp->is_success)
  { die "$INTERRUPT\n" if $rsp->is_info eq $INTERRUPT;
    return unless ref($ctl);
    $ctl->{'.cur'} = defined($ctl->{'_end'}) ? $ctl->{'_end'} : $EMP;
    return (delete($ctl->{'.eof'}) && length($dft)) ? $dft : undef;
  }

  # Treat a response line
  if (length($lin = $rsp->get_data))
  { return ($lin eq $clr) ? $EMP :
           ($lin eq $del) ? undef :
                            $lin;
  }

  # Consume the default
  $ctl->{'.cur'} = defined($ctl->{'_end'}) ? $ctl->{'_end'} : $EMP if ref($ctl);
  return $dft;
}

sub _ask_password
{ my ($slf, $mod, $inp) = @_;
  my ($rsp);

  $rsp = $mod->submit(q{.},
    RDA::Object::Message->new('ASK.ASK_PASSWORD', prompt => $inp));
  die "$INTERRUPT\n" if $rsp->is_info eq $INTERRUPT;
  return $rsp->get_first('password');
}

# Display a setting value
sub _debug_array
{ my ($val, $def) = @_;

  return q{(}.join(q{,}, map{_debug_scalar($_, $def)} @{$val}).q{)};
}

sub _debug_hash
{ my ($val, $def) = @_;

  return '{'.join(q{,}, map{$_.q{=>}._debug_scalar($val->{$_}, $def)}
                        sort keys(%{$val})).'}';
}

sub _debug_scalar
{ my ($val, $def) = @_;
  my ($ref);

  $ref = ref($val);
  return
    ($ref eq 'ARRAY')              ? _debug_array($val) :
    ($ref eq 'HASH')               ? _debug_hash($val) :
    ($ref eq 'RDA::Object::Item')  ? q{[}.$val->get_path($def).q{]} :
    $ref                           ? $val->as_string :
    defined($val)                  ? "'$val'" :
                                     'undef';
}

# Dump setup information
sub _dump_setting
{ my ($slf, $stp) = @_;
  my ($buf);

  $buf = $slf->dump(0, ' | ['.$slf->{'_set'}.'] '.$stp.': ');
  $buf =~ s/\n/\n | /g;
  $buf = $SEP.$buf.qq{\n}.$SEP;
  return syswrite($RDA::Text::TRACE, $buf, length($buf));
}

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

  $buf = $SEP.' | ['.$slf->{'_set'}.'] '.$txt.qq{\n}.$SEP;
  return syswrite($RDA::Text::TRACE, $buf, length($buf));
}

# Get the defaults
sub _get_defaults
{ my ($slf, $mod, $def, $typ) = @_;
  my ($flt, $key, $val);

  $flt = $tb_flt{$typ}->[exists($slf->{'_inp'}) ? -1 : 0];

  if ($def->is_defined($slf->{'_set'}))
  { return [grep {&$flt($_)}
      $def->get_value($slf->{'_set'}, [], $slf->{'_raw'})]
      unless exists($slf->{'_key'});
    return (ref($val = $val->{$key}) eq 'ARRAY')
      ? [grep {&$flt($_)} @{$val}]
      : [grep {&$flt($_)} $val]
      if ref($val = $def->get_value($slf->{'_set'})) eq 'HASH'
      && exists($val->{$key = $slf->{'_key'}});
  }
  return $slf->{'-dft'}->is_defined
    ? [grep {&$flt($_)} $slf->{'-dft'}->eval_as_data]
    : []
    if exists($slf->{'-dft'});
  return []
    unless exists($slf->{'_dft'}) && defined($val = $slf->{'_dft'});
  unless (ref($val) eq 'ARRAY')
  { $val = &{$tb_res{$typ}}($mod, $val);
    $val = [$val] unless ref($val) eq 'ARRAY';
  }
  return [grep {&$flt($_)} @{$val}];
}

# --- Default handling routines -----------------------------------------------

# No default value
sub _dft_none  ## no critic (Unused)
{ my ($slf, $dft) = @_;

  $slf->{'_dft'} = $dft;
  return 0;
}

# Default display
sub _dsp_help
{ my ($slf, $mod) = @_;

  return _dsp_key($slf, $mod, 'hlp', 2);
}

# Default filter
sub _flt_scalar
{ my ($val) = @_;

  return defined($val) && !ref($val);
}

# No replacement
sub _res_none
{ my ($mod, $dft) = @_;

  return $dft;
}

# --- Boolean setting handling routines ---------------------------------------

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

  if (@{$dft})
  { $slf->{'.prv'} = [$dft->[0] ? get_string('Y') : get_string('N')];
  }
  else
  { return 1 if $slf->{'_opt'};
    $slf->{'.prv'} = [get_string('N')];
  }
  return 0;
}

sub _get_boolean
{ my ($slf, $mod, $val, $lst) = @_;

  return (_tst_boolean($slf, $val, $lst), 0);
}

sub _res_boolean
{ my ($mod, $dft) = @_;

  return $mod->resolve_string($dft);
}

sub _tst_boolean
{ my ($slf, $val, $lst) = @_;
  my ($pat);

  $pat = get_string('Yes');
  if (defined($val) && $val =~ m/\s*$pat/i)
  { _add_nxt($lst, $slf->{'_var'}, 'true');
    return 1;
  }
  else
  { _add_nxt($lst, $slf->{'_var'}, 'false');
    return 0;
  }
}

sub _val_boolean
{ my ($slf, $mod, $lst) = @_;

  return _tst_boolean($slf, $slf->{'.prv'}->[0], $lst);
}

# --- Comment setting handling routines ---------------------------------------

sub _dft_comment
{ my ($slf, $dft, $mod, $flg) = @_;
  my ($buf);

  unless ($flg)
  { foreach my $key (qw(aft bef))
    { next unless exists($slf->{"-$key"});
      $slf->{'.key'} = $key;
      $slf->{"_$key"} = $slf->{"-$key"}->eval_as_string;
    }

    # Display the comment
    $buf = $EMP;
    $buf .= _fmt_str($slf->{'_bef'}, 1) if exists($slf->{'_bef'});
    $buf .= _fmt_str($slf->{'_inp'}, 1) if exists($slf->{'_inp'});
    $buf .= $slf->{'_col'}
      ? join(qq{\n}, q{.C 2}, @{$dft}).qq{\n\n}
      : join($EMP, map {_fmt_txt($_, 1)} @{$dft})
      if @{$dft};
    $buf .= _fmt_str($slf->{'_aft'}, 1) if exists($slf->{'_aft'});

    # When applicable, wait for the confirmation
    $slf->{'_vis'}
      ? _ask_lin($mod, $buf.".N1\n", $EMP, $EMP)
      : _dsp_txt($mod, $buf, 1);
  }

  # Detect if the setup must be aborted
  if (exists($slf->{'_val'}))
  { die get_string('ABORTED') if $slf->{'_val'} eq 'F';
    die "Aborted\n"           if $slf->{'_val'} eq 'E';
  }

  # Refuse the default values
  return 1;
}

sub _res_comment
{ my ($mod, $dft) = @_;

  return
    ($dft =~ $re_cfg) ? _rpl_cfg($mod, $1, $2, $4, $5, $6) :
    ($dft =~ $re_ext) ? _rpl_ext($mod, $1, $2, $3) :
    ($dft =~ $re_mrc) ? _rpl_mrc($mod, $1, $2, $5) :
    ($dft =~ $re_lst) ? _rpl_lst($mod, $1, $2, $4, $5) :
    ($dft =~ $re_reg) ? _rpl_reg($mod, $1, $2, $3, $5) :
    ($dft =~ $re_xml) ? _rpl_xml($mod, $1, $3, $4) :
                        $mod->resolve_string($dft);
}

# --- Directory setting handling routines -------------------------------------

sub _dft_dir  ## no critic (Complex)
{ my ($slf, $dft, $mod) = @_;
  my ($flg, $val);

  # Check optionality
  return 1
    unless ($flg = defined($slf->{'_end'}))  ## no critic (Unless)
        || @{$dft} || !$slf->{'_opt'};

  # Determine the validation context
  $slf->{'.key'} = 'ctx';
  delete($slf->{'.ctx'});
  if (exists($slf->{'-ctx'}))
  { $val = $slf->{'-ctx'}->eval_as_string;
  }
  elsif (exists($slf->{'_ctx'}))
  { $val = $slf->{'_ctx'};
    $val =~ s/\//\001/g;
    $val = RDA::Object::Rda->clean_path([map
      {($_ eq q{..}) ? RDA::Object::Rda->up_dir : $_}
      split(/\001/, $val)], 1)
      if length($val = $mod->resolve_string($val));
  }
  else
  { $val = undef;
  }

  # Reject invalid elements
  if (defined($val) && length($val))
  { $val = $EMP if $val =~ m/^[\\\/]$/;
    $slf->{'.ctx'} = $val;
    if (exists($slf->{'_alt'}))
    { $dft = [grep {-d (RDA::Object::Rda->is_absolute($_)
        ? $_
        : RDA::Object::Rda->cat_dir($val, $_))} @{$dft}] unless $slf->{'_raw'};
      return 1 unless $flg || @{$dft};
    }
  }
  else
  { $dft = [grep {-d $_} @{$dft}] unless $slf->{'_raw'};
    return 1
      unless $flg || @{$dft} || !exists($slf->{'_alt'});  ## no critic (Unless)
  }

  # Get the default list
  $slf->{'.prv'} = $flg
    ? [map {_chk_case($slf, $_)} @{$dft}]
    : [_chk_case($slf, $dft->[0])];
  return 0;
}

sub _get_dir
{ my ($slf, $mod, $val, $lst) = @_;
  my ($err, $nxt, $pth);

  # Reject an error
  return ($val, $slf->{'.cnt'})
    if (($err = _tst_dir($slf, $mod, \$val, \$pth))
                             && _dsp_val($slf, $mod, 1, 'err'))
    || (_chk_val($slf, $val) && _dsp_val($slf, $mod, 1, 'dup'));

  # Accept other value
  if ($nxt = defined($slf->{'_end'}))
  { _nxt_val($slf, $val);
  }
  elsif (defined($val) && length($val))
  { _add_nxt($lst, $slf->{'_var'}, $err ? 'invalid' : 'exists');
  }
  else
  { _add_nxt($lst, $slf->{'_var'}, 'missing');
  }
  return ($val, $nxt);
}

sub _res_dir
{ my ($mod, $dft) = @_;

  if ($dft =~ $re_cfg)
  { $dft = RDA::Object::Rda->cat_dir($dft)
      if length($dft = _rpl_cfg($mod, $1, $2, $4, $5, $6));
  }
  elsif ($dft =~ $re_pth)
  { die get_string('BAD_PATH') if uc($1) ne 'D';
    $dft = _rpl_pth($mod, uc($1), $2);
  }
  elsif ($dft =~ $re_ext)
  { $dft = _rpl_ext($mod, $1, $2, $3);
  }
  elsif ($dft =~ $re_lst)
  { $dft = _rpl_lst($mod, $1, $2, $4, $5);
  }
  elsif ($dft =~ $re_reg)
  { $dft = RDA::Object::Rda->cat_dir($dft)
      if length($dft = _rpl_reg($mod, $1, $2, $3, $5));
  }
  elsif ($dft =~ $re_src)
  { $dft = _rpl_src($mod, $1, $2, $4, $5, '-d');
  }
  elsif ($dft =~ $re_xml)
  { $dft = RDA::Object::Rda->cat_dir($dft)
      if length($dft = _rpl_xml($mod, $1, $3, $4));
  }
  else
  { $dft = _rpl_pth($mod, 'D', $dft);
  }
  return $dft;
}

sub _tst_dir  ## no critic (Complex)
{ my ($slf, $mod, $val, $pth) = @_;
  my ($dir, $ref);

  # Adjust the value
  if (ref($val))
  { # Resolve variables
    unless (RDA::Object::Rda->is_vms)
    { $$val =~ s/\$\{(\w+)\}/_resolve($mod, $1)/eg;
      $$val =~ s/\$(\w+)/_resolve($mod, $1)/eg;
    }
    $$val =~ s/\%(\w+)\%/_resolve($mod, $1)/eg;

    # Apply formatting
    if (exists($slf->{'_fmt'}))
    { if ($slf->{'_fmt'} =~ m/<<L(short)?/)
      { $$val = RDA::Object::Rda->short($$val, 1);
      }
      elsif ($slf->{'_fmt'} =~ m/<<N(ative)?/)
      { $$val = RDA::Object::Rda->native($$val);
      }
      elsif ($slf->{'_fmt'} =~ m/<<S(hort)?/)
      { $$val = RDA::Object::Rda->short($$val);
      }
    }

    # Use the adjusted value for the validation
    $dir = $$val;
  }
  else
  { $dir = $val;
  }
  return 0 unless length($dir) || $slf->{'_clr'} eq $EMP;

  # Apply the context
  $dir = RDA::Object::Rda->is_absolute($dir)
    ? $dir
    : RDA::Object::Rda->cat_dir($slf->{'.ctx'}, $dir)
    if exists($slf->{'.ctx'});
  $$pth = $dir if ref($pth);

  # Apply validation code
  return !$mod->eval_value($slf->{'-ref'}, $dir) if exists($slf->{'-ref'});

  # Test the directory/file
  return 1 unless -d $dir;
  if (exists($slf->{'_ref'}))
  { $ref = uc($mod->resolve_string($slf->{'_ref'}));
    return 1
      unless index($ref, 'A') < 0                     ## no critic (Unless)
          || RDA::Object::Rda->is_absolute($dir);
    return 1 unless index($ref, 'L') < 0 || -l $dir;  ## no critic (Unless)
    return 1 unless index($ref, 'R') < 0 || -r $dir;  ## no critic (Unless)
    return 1 unless index($ref, 'W') < 0 || -w $dir;  ## no critic (Unless)
    return 1 unless index($ref, 'X') < 0 || -x $dir;  ## no critic (Unless)
  }
  return 0;
}

sub _val_dir
{ my ($slf, $mod, $lst) = @_;
  my ($pth, $val);

  if (defined($slf->{'_end'}))
  { foreach my $itm (@{$slf->{'.prv'}})
    { _dsp_val($slf, $mod, 0, 'err') if _tst_dir($slf, $mod, $itm);
      _dsp_val($slf, $mod, 0, 'dup') if _chk_val($slf, $itm, 1);
    }
  }
  elsif (!(defined($val = $slf->{'.prv'}->[0]) && length($val)))
  { _add_nxt($lst, $slf->{'_var'}, 'missing');
  }
  elsif (_tst_dir($slf, $mod, $val, \$pth))
  { _add_nxt($lst, $slf->{'_var'}, 'invalid')
      unless _dsp_val($slf, $mod, 0, 'err');
  }
  else
  { _add_nxt($lst, $slf->{'_var'}, (-d $pth) ? 'exists' : 'invalid');
  }
  return $slf->{'.prv'};
}

# --- Event setting handling routines -----------------------------------------

sub _dft_event
{ my ($slf, $dft, $mod) = @_;

  # Add the event to the module event stack
  $mod->log(join(q{|}, @{$dft}));

  # Refuse the default value
  return 1;
}

sub _res_event
{ my ($mod, $dft) = @_;

  return $mod->resolve_string($dft);
}

# --- File setting handling routines ------------------------------------------

sub _dft_file  ## no critic (Complex)
{ my ($slf, $dft, $mod) = @_;
  my ($flg, $val);

  # Check optionality
  return 1
    unless ($flg = defined($slf->{'_end'}))  ## no critic (Unless)
        || @{$dft} || !$slf->{'_opt'};

  # Determine the validation context
  $slf->{'.key'} = 'ctx';
  delete($slf->{'.ctx'});
  if (exists($slf->{'-ctx'}))
  { $val = $slf->{'-ctx'}->eval_as_string;
  }
  elsif (exists($slf->{'_ctx'}))
  { $val = $slf->{'_ctx'};
    $val =~ s/\//\001/g;
    $val = RDA::Object::Rda->clean_path([map
      {($_ eq q{..}) ? RDA::Object::Rda->up_dir : $_}
      split(/\001/, $val)], 1)
      if length($val = $mod->resolve_string($val));
  }
  else
  { $val = undef;
  }

  # Reject invalid elements
  if (defined($val) && length($val))
  { $val = $EMP if $val =~ m/^[\\\/]$/;
    $slf->{'.ctx'} = $val;
    if (exists($slf->{'_alt'}))
    { $dft = [grep {-f (RDA::Object::Rda->is_absolute($_)
        ? $_
        : RDA::Object::Rda->cat_file($val, $_))} @{$dft}]
        unless $slf->{'_raw'};
      return 1 unless $flg || @{$dft};
    }
  }
  else
  { $dft = [grep {-f $_} @{$dft}] unless $slf->{'_raw'};
    return 1
      unless $flg || @{$dft} || !exists($slf->{'_alt'});  ## no critic (Unless)
  }

  # Get the default list
  $slf->{'.prv'} = $flg
    ? [map {_chk_case($slf, $_)} @{$dft}]
    : [_chk_case($slf, $dft->[0])];
  return 0;
}

sub _get_file
{ my ($slf, $mod, $val, $lst) = @_;
  my ($err, $nxt, $pth);

  # Reject an error
  return ($val, $slf->{'.cnt'})
    if (($err = _tst_file($slf, $mod, \$val, \$pth))
                             && _dsp_val($slf, $mod, 1, 'err'))
    || (_chk_val($slf, $val) && _dsp_val($slf, $mod, 1, 'dup'));

  # Accept other value
  if ($nxt = defined($slf->{'_end'}))
  { _nxt_val($slf, $val);
  }
  elsif (defined($val) && length($val))
  { _add_nxt($lst, $slf->{'_var'}, $err      ? 'invalid' :
                                   (-e $pth) ? 'exists' :
                                               'invalid');
  }
  else
  { _add_nxt($lst, $slf->{'_var'}, 'missing');
  }
  return ($val, $nxt);
}

sub _res_file
{ my ($mod, $dft) = @_;

  if ($dft =~ $re_cfg)
  { $dft = RDA::Object::Rda->cat_file($dft)
      if length($dft = _rpl_cfg($mod, $1, $2, $4, $5, $6));
  }
  elsif ($dft =~ $re_ext)
  { $dft = _rpl_ext($mod, $1, $2, $3);
  }
  elsif ($dft =~ $re_pth)
  { get_string('BAD_PATH') if uc($1) eq 'D';
    $dft = _rpl_pth($mod, uc($1), $2);
  }
  elsif ($dft =~ $re_lst)
  { $dft = _rpl_lst($mod, $1, $2, $4, $5);
  }
  elsif ($dft =~ $re_reg)
  { $dft = RDA::Object::Rda->cat_file($dft)
      if length($dft = _rpl_reg($mod, $1, $2, $3, $5));
  }
  elsif ($dft =~ $re_src)
  { $dft = _rpl_src($mod, $1, $2, $4, $5, '-f');
  }
  elsif ($dft =~ $re_xml)
  { $dft = RDA::Object::Rda->cat_file($dft)
      if length($dft = _rpl_xml($mod, $1, $3, $4));
  }
  else
  { $dft = _rpl_pth($mod, 'F', $dft);
  }
  return $dft;
}

sub _tst_file  ## no critic (Complex)
{ my ($slf, $mod, $val, $pth) = @_;
  my ($fil, $ref);

  # Adjust the value
  if (ref($val))
  { # Resolve variables
    unless (RDA::Object::Rda->is_vms)
    { $$val =~ s/\$\{(\w+)\}/_resolve($mod, $1)/eg;
      $$val =~ s/\$(\w+)/_resolve($mod, $1)/eg;
    }
    $$val =~ s/\%(\w+)\%/_resolve($mod, $1)/eg;

    # Apply formatting
    if (exists($slf->{'_fmt'}))
    { if ($slf->{'_fmt'} =~ m/<<L(short)?/)
      { $$val = RDA::Object::Rda->short($$val, 1);
      }
      elsif ($slf->{'_fmt'} =~ m/<<N(ative)?/)
      { $$val = RDA::Object::Rda->native($$val);
      }
      elsif ($slf->{'_fmt'} =~ m/<<S(hort)?/)
      { $$val = RDA::Object::Rda->short($$val);
      }
    }

    # Use the adjusted value for the validation
    $fil = $$val;
  }
  else
  { $fil = $val;
  }
  return 0 unless length($fil) || $slf->{'_clr'} eq $EMP;

  # Apply the context
  $fil = RDA::Object::Rda->is_absolute($fil)
    ? $fil
    : RDA::Object::Rda->cat_file($slf->{'.ctx'}, $fil)
    if exists($slf->{'.ctx'});
  $$pth = $fil if ref($pth);

  # Test the directory/file
  return !$mod->eval_value($slf->{'-ref'}, $fil) if exists($slf->{'-ref'});
  return !-f $fil unless exists($slf->{'_ref'});
  $ref = uc($mod->resolve_string($slf->{'_ref'}));
  return 1 unless index($ref, 'A') < 0              ## no critic (Unless)
      || RDA::Object::Rda->is_absolute($fil);
  return 1 unless index($ref, 'B') < 0 || -b $fil;  ## no critic (Unless)
  return 1 unless index($ref, 'C') < 0 || -c $fil;  ## no critic (Unless)
  return 1 unless index($ref, 'D') < 0 || -d $fil;  ## no critic (Unless)
  return 1 unless index($ref, 'E') < 0 || -e $fil;  ## no critic (Unless)
  return 1 unless index($ref, 'F') < 0 || -f $fil;  ## no critic (Unless)
  return 1 unless index($ref, 'L') < 0 || -l $fil;  ## no critic (Unless)
  return 1 unless index($ref, 'N') < 0 || -s $fil;  ## no critic (Unless)
  return 1 unless index($ref, 'P') < 0 || -p $fil;  ## no critic (Unless)
  return 1 unless index($ref, 'R') < 0 || -r $fil;  ## no critic (Unless)
  return 1 unless index($ref, 'S') < 0 || -S $fil;  ## no critic (Unless)
  return 1 unless index($ref, 'T') < 0 || -t $fil;  ## no critic (Unless)
  return 1 unless index($ref, 'W') < 0 || -w $fil;  ## no critic (Unless)
  return 1 unless index($ref, 'X') < 0 || -x $fil;  ## no critic (Unless)
  return 1 unless index($ref, 'Z') < 0 || -z $fil;  ## no critic (Unless)
  return 0;
}

sub _val_file
{ my ($slf, $mod, $lst) = @_;
  my ($pth, $val);

  if (defined($slf->{'_end'}))
  { foreach my $itm (@{$slf->{'.prv'}})
    { _dsp_val($slf, $mod, 0, 'err') if _tst_file($slf, $mod, $itm);
      _dsp_val($slf, $mod, 0, 'dup') if _chk_val($slf, $itm, 1);
    }
  }
  elsif (!(defined($val = $slf->{'.prv'}->[0]) && length($val)))
  { _add_nxt($lst, $slf->{'_var'}, 'missing');
  }
  elsif (_tst_file($slf, $mod, $val, \$pth))
  { _add_nxt($lst, $slf->{'_var'}, 'invalid')
      unless _dsp_val($slf, $mod, 0, 'err');
  }
  else
  { _add_nxt($lst, $slf->{'_var'}, (-e $pth) ? 'exists' : 'invalid');
  }
  return $slf->{'.prv'};
}

# --- Item setting handling routines ------------------------------------------

sub _ask_item
{ my ($slf, $mod, $inp, $lst) = @_;
  my ($bkp, $cls, $col, $def, $end, $lng, $nam, $obj, $val);

  foreach my $key (qw(bef cls par))
  { next unless exists($slf->{"-$key"});
    $slf->{'.key'} = $key;
    $slf->{"_$key"} = $slf->{"-$key"}->eval_as_string;
  }
  die get_string('NO_CLASS', $slf->{'_set'}) unless exists($slf->{'_cls'});

  $end = $slf->{'_end'};
  $lng = $mod->get_info('lng');
  $nam = 'TG'.lc($cls = $slf->{'_cls'});
  return (defined($end) ? [] : undef, 0)
    unless ($obj = defined($val = $mod->get_info('dir'))
    ? $lng->load_file($nam, $val)
    : $lng->search_package($mod->get_info('grp'), $nam));
  $lng->add_usage($obj);
  $col = $lng->get_collector;
  $def = $col->get_info('run')->find('CLASS', 1);
  $bkp = $def->backup;
  $def->set_temp('B_ADMIN_END',     defined($end));
  $def->set_temp('B_ADMIN_VISIBLE', $slf->{'_vis'});
  $def->set_temp('K_ADMIN_PARENT',  $slf->{'_par'});
  $def->set_temp('T_ADMIN_BEFORE',  $slf->{'_bef'});
  $def->set_temp('T_ADMIN_VALUE',   $slf->{'.nxt'});
  $def->set_temp('W_ADMIN_COMMAND', 'select');
  $obj->set_info('ctx', $mod->get_info('ctx'));
  $obj->set_info('dpt', $mod->get_info('dpt') + 1);
  $obj->isolate if $mod->is_isolated || !$slf->{'_vis'};
  $obj->set_info('shr', $mod->get_info('shr'));
  eval {$obj->request($def, $col->get_trace('CLASS'))};
  $obj->delete_object;
  $slf->{'.nxt'} = [$def->get_value('T_ADMIN_VALUE')];
  $def->restore($bkp);
  die $@ if $@;

  if (defined($end))
  { foreach my $itm (@{$slf->{'.nxt'}})
    { _dsp_val($slf, $mod, 0, 'err') if _tst_item($slf, $itm, $cls);
      _dsp_val($slf, $mod, 0, 'dup') if _chk_item($slf, $itm);
    }
    return ([map {$mod->find($_, 1)} @{$slf->{'.nxt'}}], 0);
  }
  if (defined($nam = $slf->{'.nxt'}->[0]) && length($nam))
  { $val = $mod->find($nam);
    return ($val, $slf->{'.cnt'} ? \&_ask_item : 0)
      if _tst_item($slf, $nam, $cls) && _dsp_val($slf, $mod, 1, 'err');
    _add_nxt($lst, $slf->{'_var'}, $nam);
  }
  else
  { $val = undef;
  }
  return ($val, 0);
}

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

  if (defined($slf->{'_end'}) && $slf->{'_dup'})
  { $flg = 0;
    foreach my $prv (@{$slf->{'.nxt'}})
    { if ($val == $prv)
      { return 1 if $flg;
        $flg = 1;
      }
    }
  }
  return 0;
}

sub _dft_item
{ my ($slf, $dft, $mod) = @_;

  $slf->{'.prv'} = [];
  if (defined($slf->{'_end'}))
  { $slf->{'.nxt'} =
      [map {'COL/'.(ref($_) ? $_->get_path : $_)} @{$dft}];
  }
  elsif (@{$dft})
  { $slf->{'.nxt'} =
      [map {'COL/'.(ref($_) ? $_->get_path : $_)} $dft->[0]];
  }
  else
  { return 1 if $slf->{'_opt'};
    $slf->{'.nxt'} = [];
  }
  $slf->{'.ask'} = \&_ask_item;
  return 0;
}

sub _flt_item
{ my ($val) = @_;
  my ($ref);

  return
    ($ref = ref($val)) ? $ref eq 'RDA::Object::Item' :
    defined($val)      ? $val =~ m/^(\w+\.)*\w+$/ :
                         0;
}

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

  return !defined($val) || $val !~ m/^(?:COL\/)?(?:\w+\.)*$cls\_\w+$/;
}

sub _val_item
{ my ($slf, $mod) = @_;
  my ($cls, $def);

  $cls = $slf->{'_cls'};
  foreach my $itm (@{$slf->{'.nxt'}})
  { _dsp_val($slf, $mod, 0, 'err') if _tst_item($slf, $itm, $cls);
    _dsp_val($slf, $mod, 0, 'dup') if _chk_item($slf, $itm);
  }
  return [map {$mod->find($_, 1)} @{$slf->{'.nxt'}}];
}

# --- Loop setting handling routines ------------------------------------------

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

  # Initiate the loop operation
  unless (exists($slf->{'.sav'}))
  { $slf->{'_nam'} = q{-}.$slf->{'_nam'} unless $slf->{'_nam'} =~ m/^-/;
    $slf->{'.prv'} = exists($slf->{'_inp'})
      ? [grep {_flt_scalar($_)} @{$dft}]
      : $dft;
  }

  # Indicate how to interrupt the loop
  $slf->{'_brk'} = defined($slf->{'_end'}) ? delete($slf->{'_end'}) : q{.};
  return 0;
}

sub _flt_loop
{ my ($val) = @_;
  my ($ref);

  return ($ref = ref($val))
    ? $ref eq 'RDA::Object::Item'
    : defined($val);
}

sub _get_loop
{ my ($slf, $mod, $val, $lst) = @_;

  # Initiate the loop operation
  if (exists($slf->{'.sav'}))
  { # Purge last loop iteration
    splice(@{$lst});
  }
  else
  { # Enter in the loop
    $slf->{'.sav'} = [splice(@{$lst})];
  }

  # Detect the end of the loop
  if ($val eq $slf->{'_brk'})
  { push(@{$lst}, @{$slf->{'_alt'}}) if exists($slf->{'_alt'});
    push(@{$lst}, @{delete($slf->{'.sav'})});
    return (undef, 0)
  }

  # Reject an error
  return ($val, $slf->{'.cnt'})
    if (_tst_text($slf, $mod, \$val) && _dsp_val($slf, $mod, 1, 'err'))
    || (_chk_val($slf, $val)         && _dsp_val($slf, $mod, 1, 'dup'));

  # Start an iteration
  _add_nxt($lst, $slf->{'_var'}, 'loop');
  push(@{$lst}, $slf->{'_set'});
  return ($val, 0);
}

sub _res_loop
{ my ($mod, $dft) = @_;

  return
    ($dft =~ $re_cfg) ? _rpl_cfg($mod, $1, $2, $4, $5, $6) :
    ($dft =~ $re_ext) ? _rpl_ext($mod, $1, $2, $3) :
    ($dft =~ $re_mrc) ? _rpl_mrc($mod, $1, $2, $5) :
    ($dft =~ $re_lst) ? _rpl_lst($mod, $1, $2, $4, $5) :
    ($dft =~ $re_pth) ? _rpl_pth($mod, uc($1), $2) :
    ($dft =~ $re_reg) ? _rpl_reg($mod, $1, $2, $3, $5) :
    ($dft =~ $re_src) ? _rpl_src($mod, $1, $2, $4, $5, '-e') :
    ($dft =~ $re_xml) ? _rpl_xml($mod, $1, $3, $4) :
                        $mod->resolve_string($dft);
}

sub _val_loop
{ my ($slf, $mod, $lst) = @_;
  my ($val);

  # Initiate the loop operation
  if (exists($slf->{'.sav'}))
  { # Purge last loop iteration
    splice(@{$lst});
  }
  else
  { # Enter in the loop
    $slf->{'.sav'} = [splice(@{$lst})];
  }

  # Get the next loop value
  while (defined($val = shift(@{$slf->{'.prv'}})))
  { last unless $val eq $EMP && $slf->{'_vis'};
  }

  # Determine what is the next action
  if (defined($val))
  { # Start an iteration
    _add_nxt($lst, $slf->{'_var'}, 'loop');
    push(@{$lst}, $slf->{'_set'});
  }
  else
  { # Restore the context and exit the loop
    _add_nxt($lst, $slf->{'_var'}, 'exit');
    push(@{$lst}, @{delete($slf->{'.sav'})});
  }

  # Return the loop value
  return $val;
}

# --- Menu setting handling routines ------------------------------------------

sub _dec_menu  ## no critic (Complex)
{ my ($slf, $mod) = @_;
  my ($itm, $key, $obj, $ref, $syn, $tbl, $val, @tbl);

  # Treat the item directive
  $slf->{'.itm'} = $itm = {};
  $slf->{'.nam'} = {};
  $slf->{'.syn'} = $syn = {};
  if (exists($slf->{'-itm'}))
  { $slf->{'.key'} = 'itm';
    $obj = $slf->{'-itm'}->eval_value(1);
    if ($obj->is_list)
    { $slf->{'.mnu'} = $tbl = [];
      @tbl = @{$obj};
      while (($key, $val) = splice(@tbl, 0, 2))
      { next unless defined($key) && length($key = $key->eval_as_string);
        push(@{$tbl}, $key);
        $itm->{$key} = (defined($val) && length($val = $val->eval_as_string))
          ? $val
          : $key;
      }
    }
    elsif ($obj->is_array)
    { my ($cnt, $rsp);

      $cnt = 0;
      $slf->{'.mnu'} = $tbl = [];
      $slf->{'.rsp'} = $rsp = {};
      @tbl = @{$obj};
      while (($key, $val) = splice(@tbl, 0, 2))
      { next unless defined($key) && length($key = $key->eval_as_string);
        push(@{$tbl}, ++$cnt);
        $itm->{$cnt} = (defined($val) && length($val = $val->eval_as_string))
          ? $val
          : $key;
        $rsp->{$cnt} = $syn->{$key} = $key;
      }
      $slf->{'_aux'}->{'N_ITEMS'} = [0, $cnt];
    }
    elsif ($obj->is_hash)
    { for (keys(%{$obj}))
      { $itm->{$_} = length($val = $obj->{$_}->eval_as_string) ? $val : $_;
      }
    }
    else
    { $slf->{'.mnu'} = $tbl = [];
      @tbl = split(/\|/, $obj->eval_as_string);
      while (($key, $val) = splice(@tbl, 0, 2))
      { next unless defined($key) && length($key);
        push(@{$tbl}, $key);
        $itm->{$key} = (defined($val) && length($val)) ? $val : $key;
      }
    }
  }
  elsif (exists($slf->{'_itm'}))
  { $ref = ref($obj = $slf->{'_itm'});
    $ref = ref($obj = ($obj =~ $re_lst) ? _rpl_lst($mod, $1, $2, $4, $5) :
                      ($obj =~ $re_mrc) ? _rpl_mrc($mod, $1, $2, $5) :
                                          $mod->resolve_string($obj))
      unless $ref || !defined($obj);  ## no critic (Unless)
    ($ref, $obj) = ('ARRAY', [split(/\|/, $obj)])
      unless $ref || !defined($obj);  ## no critic (Unless)
    if ($ref eq 'ARRAY')
    { $slf->{'.mnu'} = $tbl = [];
      @tbl = @{$obj};
      while (($key, $val) = splice(@tbl, 0, 2))
      { next unless defined($key) && length($key);
        push(@{$tbl}, $key);
        $itm->{$key} = (defined($val) && length($val)) ? $val : $key;
      }
    }
    elsif ($ref eq 'HASH')
    { for (keys(%{$obj}))
      { $itm->{$_} = (defined($val = $obj->{$_}) && length($val)) ? $val : $_;
      }
    }
  }

  # Treat the menu directive
  $slf->{'.fmt'} = $FMT_DFT;
  if (exists($slf->{'-mnu'}))
  { $slf->{'.key'} = 'mnu';
    $obj = $slf->{'-mnu'}->eval_value(1);
    if ($obj->is_array)
    { $slf->{'.fmt'} = $FMT_STR;
      $slf->{'.mnu'} = $tbl = [];
      foreach my $key (@{$obj})
      { push(@{$tbl}, $val)
          if defined($key) && exists($itm->{$val = $key->eval_as_string});
      }
    }
    else
    { _dec_menu_mnu($slf, $itm, $obj->as_string);
    }
  }
  elsif (exists($slf->{'_mnu'}))
  { $ref = ref($obj = $slf->{'_mnu'});
    if ($ref eq 'ARRAY')
    { $slf->{'.fmt'} = $FMT_STR;
      $slf->{'.mnu'} = $tbl = [];
      foreach my $key (@{$obj})
      { push(@{$tbl}, $key) if defined($key) && exists($itm->{$key});
      }
    }
    elsif (defined($obj) && !$ref)
    { _dec_menu_mnu($slf, $itm, $obj);
    }
  }
  $slf->{'.mnu'} = [sort keys(%{$itm})] unless exists($slf->{'.mnu'});

  # Treat the response directive
  if (exists($slf->{'-rsp'}))
  { $slf->{'.key'} = 'rsp';
    $obj = $slf->{'-rsp'}->eval_value(1);
    if ($obj->is_array)
    { $slf->{'.rsp'} = $tbl = {};
      @tbl = @{$obj};
      while (($key, $val) = splice(@tbl, 0, 2))
      { $tbl->{$key} = (defined($val) && length($val = $val->eval_as_string))
          ? $val
          : $key
          if defined($key) && length($key = $key->eval_as_string);
      }
      $slf->{'.mnu'} = [grep {exists($tbl->{$_})} @{$slf->{'.mnu'}}];
    }
    elsif ($obj->is_hash)
    { $slf->{'.rsp'} = $tbl = {};
      for (keys(%{$obj}))
      { $tbl->{$_} = length($val = $obj->{$_}->eval_as_string) ? $val : $_;
      }
      $slf->{'.mnu'} = [grep {exists($tbl->{$_})} @{$slf->{'.mnu'}}];
    }
    else
    { _dec_menu_rsp($slf, $obj->as_string);
    }
  }
  elsif (exists($slf->{'_rsp'}))
  { $ref = ref($obj = $slf->{'_rsp'});
    if ($ref eq 'ARRAY')
    { $slf->{'.rsp'} = $tbl = {};
      @tbl = @{$obj};
      while (($key, $val) = splice(@tbl, 0, 2))
      { $tbl->{$key} = (defined($val) && length($val)) ? $val : $key
          if defined($key) && length($key);
      }
      $slf->{'.mnu'} = [grep {exists($tbl->{$_})} @{$slf->{'.mnu'}}];
    }
    elsif ($ref eq 'HASH')
    { $slf->{'.rsp'} = $tbl = {};
      for (keys(%{$obj}))
      { $tbl->{$_} = (defined($val = $obj->{$_}) && length($val)) ? $val : $_;
      }
      $slf->{'.mnu'} = [grep {exists($tbl->{$_})} @{$slf->{'.mnu'}}];
    }
    else
    { _dec_menu_rsp($slf, $obj);
    }
  }
  elsif (!exists($slf->{'.rsp'}))
  { $slf->{'.rsp'} = {map {$_ => $_} @{$slf->{'.mnu'}}};
  }

  # Treat the synonym directive
  if (exists($slf->{'-syn'}))
  { $slf->{'.key'} = 'syn';
    $obj = $slf->{'-syn'}->eval_value(1);
    if ($obj->is_array)
    { @tbl = @{$obj};
      while (($key, $val) = splice(@tbl, 0, 2))
      { $syn->{$val} = $key
          if defined($key) && length($key = $key->eval_as_string)
          && defined($val) && length($val = $val->eval_as_string)
          && exists($syn->{$key}) && $syn->{$key} eq $key
          && !exists($syn->{$val});
      }
    }
    elsif ($obj->is_hash)
    { foreach my $alt (keys(%{$obj}))
      { next unless exists($syn->{$alt}) && $syn->{$alt} eq $alt
          && defined($tbl = $obj->{$alt});
        if ($tbl->is_array)
        { foreach my $det (@{$tbl})
          { $syn->{$val} = $alt
              if defined($det) && length($val = $det->eval_as_string)
              && !exists($syn->{$val});
          }
        }
        else
        { $syn->{$val} = $alt
            if defined($tbl) && length($val = $tbl->eval_as_string)
            && !exists($syn->{$val});
        }
      }
    }
  }
  elsif (exists($slf->{'_syn'}))
  { $ref = ref($obj = $slf->{'_syn'});
    if ($ref eq 'ARRAY')
    { @tbl = @{$obj};
      while (($key, $val) = splice(@tbl, 0, 2))
      { $syn->{$val} = $key
          if defined($key) && defined($val)
          && length($key) && length($val)
          && exists($syn->{$key}) && $syn->{$key} eq $key
          && !exists($syn->{$val});
      }
    }
  }
  return;
}

sub _dec_menu_mnu
{ my ($slf, $itm, $str) = @_;

  if ($str =~ m/^<<N(?:umber)?$/)
  { $slf->{'.fmt'} = $FMT_NUM;
    $slf->{'.mnu'} = [sort {$a <=> $b} keys(%{$itm})];
  }
  elsif ($str =~ m/^<<T(?:ext)?$/)
  { $slf->{'.fmt'} = $FMT_STR;
    $slf->{'.mnu'} = [sort keys(%{$itm})];
  }
  elsif (length($str) && $str !~ m/^<<I(?:tem)?$/)
  { $slf->{'.fmt'} = $FMT_STR;
  }
  return;
}

sub _dec_menu_rsp
{ my ($slf, $str) = @_;
  my ($key, $tbl, $val, @tbl);

  if ($str eq q{^})
  { $slf->{'.rsp'} = $slf->{'.itm'};
  }
  elsif (length($str))
  { $slf->{'.rsp'} = $tbl = {};
    @tbl = split(/\|/, $str);
    while (($key, $val) = splice(@tbl, 0, 2))
    { $tbl->{$key} = (defined($val) && length($val)) ? $val : $key
        if defined($key) && length($key);
    }
  }
  else
  { $slf->{'.rsp'} = {map {$_ => $_} @{$slf->{'.mnu'}}};
  }
  return;
}

sub _dft_menu  ## no critic (Complex)
{ my ($slf, $dft, $mod) = @_;
  my ($flg, $lgt, $obj, $tbl, $val);

  # Convert values
  foreach my $key (qw(ask))
  { next unless exists($slf->{"-$key"});
    $slf->{'.key'} = $key;
    $slf->{"_$key"} = $slf->{"-$key"}->eval_as_scalar;
  }
  foreach my $key (qw(aft bef hlp one))
  { next unless exists($slf->{"-$key"});
    $slf->{'.key'} = $key;
    $slf->{"_$key"} = $slf->{"-$key"}->eval_as_string
  }

  # Check optionality
  $flg = defined($slf->{'_end'});
  return 1 unless $flg || @{$dft} || !$slf->{'_opt'};  ## no critic (Unless)

  # Parse the menu description
  _dec_menu($slf, $mod);

  # Treat trivial menus
  unless ($flg || $slf->{'_ask'}  ## no critic (Unless)
      || (scalar @{$slf->{'.mnu'}}) != 1)
  { $slf->{'.ask'} = 0;
    $slf->{'.prv'} = [$slf->{'.mnu'}->[0]];
    return 0;
  }

  # Determine the selector size
  $val = 0;
  delete($slf->{'.add'});
  delete($slf->{'.alt'});
  if (exists($slf->{'-add'}))
  { $slf->{'.key'} = 'add';
    $obj = $slf->{'-add'}->eval_value(1);
    $obj = [$obj] unless $obj->is_array;
    foreach my $itm (@{$obj})
    { my ($cod, $dsc, $nam, $rsp);

      if ($itm->is_array)
      { ($cod, $dsc, $rsp, $nam) = @{$itm->eval_as_data};
      }
      else
      { ($cod, $dsc, $rsp, $nam) = split(/\|/, $itm->eval_as_string, 5);
      }
      if (defined($dsc) && length($dsc) && ($lgt = length($cod)))
      { $val = $lgt if $lgt > $val;
        $rsp = $cod unless defined($rsp) && length($rsp);
        $slf->{'.nam'}->{$rsp} = $nam if defined($nam) && length($nam);
        $slf->{'.one'}->{$cod} = $rsp;
        $slf->{'.rsp'}->{$cod} = $rsp;
        push(@{$slf->{'.add'}}, [$cod, $dsc]);
      }
    }
  }
  elsif (exists($slf->{'_add'}))
  { unless (ref($obj = $slf->{'_add'}) eq 'ARRAY')
    { my (@rec, @tbl);

      @tbl = split(/\|/, $obj);
      $obj = [];
      push(@{$obj}, [@rec]) while (@rec = splice(@{$obj}, 0, 3));
    }
    foreach my $itm (@{$obj})
    { my ($cod, $dsc, $nam, $rsp);

      if (ref($itm) eq 'ARRAY')
      { ($cod, $dsc, $rsp, $nam) = @{$itm};
      }
      elsif (defined($itm) && length($itm))
      { ($cod, $dsc, $rsp, $nam) = split(/\|/, $itm, 5);
      }
      if (defined($dsc) && length($dsc) && ($lgt = length($cod)))
      { $val = $lgt if $lgt > $val;
        $rsp = $cod unless defined($rsp) && length($rsp);
        $slf->{'.nam'}->{$rsp} = $nam if defined($nam) && length($nam);
        $slf->{'.one'}->{$cod} = $rsp;
        $slf->{'.rsp'}->{$cod} = $rsp;
        push(@{$slf->{'.add'}}, [$cod, $dsc]);
      }
    }
  }
  foreach my $itm (@{$slf->{'.mnu'}})
  { $val = $lgt if ($lgt = length($itm)) > $val;
  }
  return 1 unless ($slf->{'.lgt'} = $val);

  # When possible, use the current setting as default
  if ($slf->{'_pck'})
  { my (@all, @dft, @rec, %dft);

    $slf->{'.pck'} =
      [@all = sort {$a <=> $b} grep {m/^\d+$/} keys(%{$slf->{'.rsp'}})];
    foreach my $itm (@{$dft})
    { if ($itm eq q{*})
      { %dft = map {$_ => 1} @all;
      }
      elsif (defined($val = _sel_pick($slf, $itm)))
      { $dft{$val} = 1;
      }
    }
    foreach my $itm (@all)
    { if (!exists($dft{$itm}))
      { push(@dft, _fmt_pick(splice(@rec))) if @rec;
      }
      elsif (@rec)
      { $rec[1] = $itm;
      }
      else
      { @rec = ($itm);
      }
    }
    push(@dft, _fmt_pick(@rec)) if @rec;
    unless (exists($slf->{'.rsp'}->{q{*}}))
    { @rec = shift(@all);
      push(@rec, pop(@all)) if @all;
      $slf->{'.als'}->{q{*}} = _fmt_pick(@rec);
    }
    $slf->{'.alt'} = $FMT_STR;
    $slf->{'.prv'} = [join(q{,}, @dft)];
  }
  else
  { my (@dft);

    foreach my $itm (@{$dft})
    { $val = ($itm eq q{^}) ? $slf->{'.mnu'}->[0] : _sel_menu($slf, $itm);
      push(@dft, $val) if defined($val);
    }
    if (defined($slf->{'_end'}))
    { $slf->{'.prv'} = [@dft];
    }
    elsif (@dft)
    { $slf->{'.prv'} = [$dft[0]];
    }
    else
    { return 1 if $slf->{'_opt'};
      $slf->{'.prv'} = [];
    }
  }
  return 0;
}

sub _dsp_menu
{ my ($slf, $mod) = @_;
  my ($buf, $fmt, $lgt);

  $buf = $EMP;
  $fmt = $slf->{'.fmt'};
  $lgt = $slf->{'.lgt'};
  $buf .= _fmt_str($slf->{'_hlp'}, 2) if exists($slf->{'_hlp'});
  $buf .= _fmt_str($slf->{'_bef'}, 1) if exists($slf->{'_bef'});
  if ($slf->{'_col'})
  { $buf .= ".C\n";
    foreach my $itm (@{$slf->{'.mnu'}})
    { $buf .= sprintf($fmt, $lgt, $itm);
      $buf .= "\001";
      $buf .= $slf->{'.itm'}->{$itm};
      $buf .= qq{\n};
    }
    if (exists($slf->{'.add'}))
    { $fmt = $slf->{'.alt'} if exists($slf->{'.alt'});
      foreach my $rec (@{$slf->{'.add'}})
      { $buf .= sprintf($fmt, $lgt, $rec->[0]);
        $buf .= "\001";
        $buf .= $rec->[1];
        $buf .= qq{\n};
      }
    }
    $buf .= qq{\n};
  }
  else
  { foreach my $itm (@{$slf->{'.mnu'}})
    { $buf .= q{.I '};
      $buf .= sprintf($fmt, $lgt, $itm);
      $buf .= qq{'\n};
      $buf .= $slf->{'.itm'}->{$itm};
      $buf .= qq{\n\n};
    }
    if (exists($slf->{'.add'}))
    { $buf .= qq{.N 1\n} if @{$slf->{'.mnu'}};
      $fmt = $slf->{'.alt'} if exists($slf->{'.alt'});
      foreach my $rec (@{$slf->{'.add'}})
      { $buf .= q{.I '};
        $buf .= sprintf($fmt, $lgt, $rec->[0]);
        $buf .= qq{'\n};
        $buf .= $rec->[1];
        $buf .= qq{\n\n};
      }
    }
  }
  $buf .= _fmt_str($slf->{'_aft'}, 1) if exists($slf->{'_aft'});
  return _dsp_txt($mod, $buf);
}

sub _fmt_pick
{ my ($min, $max) = @_;

  return defined($max) ? $min.q{-}.$max : $min;
}

sub _get_menu
{ my ($slf, $mod, $val, $lst) = @_;
  my ($nxt);

  # Treat a pick list
  if ($slf->{'_pck'})
  { if (exists($slf->{'.one'}->{$val}))
    { $val = $slf->{'.one'}->{$val};
      _add_nxt($lst, $slf->{'_var'}, $val);
      if (exists($slf->{'.nam'}->{$val}))
      { $slf->{'_bkp'}->{'_nam'} = $slf->{'_nam'}
          unless exists($slf->{'_bkp'}->{'_nam'});
        $slf->{'_nam'} = $slf->{'.nam'}->{$val};
      }
      return ($val, 0);
    }
    $nxt = $slf->_tst_pick(\$val, $lst);
    return ($val, ($nxt &&  _dsp_val($slf, $mod, 1, 'err'))
      ? $slf->{'.cnt'}
      : 0);
  }

  # Reject an error
  if ($slf->_tst_menu($mod, \$val))
  { return ($val, $slf->{'.cnt'}) if _dsp_val($slf, $mod, 1, 'err');
  }
  elsif (_chk_val($slf, $val))
  { return ($val, $slf->{'.cnt'}) if _dsp_val($slf, $mod, 1, 'dup');
  }

  # Accept other value
  if ($nxt = defined($slf->{'_end'}))
  { if (exists($slf->{'_one'}) && $val eq $slf->{'_one'})
    { _add_nxt($lst, $slf->{'_var'}, $val);
      if (exists($slf->{'.nam'}->{$val}))
      { $slf->{'_bkp'}->{'_nam'} = $slf->{'_nam'}
          unless exists($slf->{'_bkp'}->{'_nam'});
        $slf->{'_nam'} = $slf->{'.nam'}->{$val};
      }
      return ($val, 0);
    }
    _nxt_val($slf, $val);
  }
  else
  { _add_nxt($lst, $slf->{'_var'}, $val);
    if (exists($slf->{'.nam'}->{$val}))
    { $slf->{'_bkp'}->{'_nam'} = $slf->{'_nam'}
        unless exists($slf->{'_bkp'}->{'_nam'});
      $slf->{'_nam'} = $slf->{'.nam'}->{$val};
    }
  }
  return ($val, $nxt);
}

sub _res_menu
{ my ($mod, $dft) = @_;

  return $mod->resolve_string($dft);
}

sub _sel_menu
{ my ($slf, $itm) = @_;
  my $ret;

  foreach my $rsp (keys(%{$slf->{'.rsp'}}))
  { if ($itm eq $slf->{'.rsp'}->{$rsp})
    { return $rsp if $itm eq $rsp;
      $ret = $rsp;
    }
  }
  return $ret;
}

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

  foreach my $rsp (@{$slf->{'.pck'}})
  { return $rsp if $itm eq $slf->{'.rsp'}->{$rsp};
  }
  return;
}

sub _spl_menu
{ my ($tbl, $seq, $str) = @_;
  my ($key, $val, @tbl);

  @tbl = split(/\|/, $str);
  while (($key, $val) = splice(@tbl, 0, 2))
  { next unless defined($key) && length($key);
    push(@{$seq}, $key);
    $tbl->{$key} = (defined($val) && length($val)) ? $val : $key;
  }
  return;
}

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

  $$val =~ s/^\s+//;
  if (exists($slf->{'.rsp'}->{$$val}))
  { $$val = $slf->{'.rsp'}->{$$val};
    return 0;
  }
  if (exists($slf->{'.syn'}->{$$val}))
  { $$val = $slf->{'.syn'}->{$$val};
    return 0;
  }
  return 1;
}

sub _tst_pick
{ my ($slf, $val, $lst) = @_;
  my ($err, $ret, $rsp, %val);

  $err = 0;
  $rsp = $slf->{'.rsp'};
  foreach my $rng (split(/,/,
    exists($slf->{'.als'}->{$$val}) ? $slf->{'.als'}->{$$val} : $$val))
  { if ($rng !~ m/^(\d+)(\-(\d+))?$/               ## no critic (Capture)
      || !exists($rsp->{$1}))
    { ++$err;
    }
    elsif (!defined($3))                           ## no critic (Capture)
    { $val{$1} = 1;
      _add_nxt($lst, $slf->{'_var'}, $rsp->{$1});
    }
    elsif (!exists($rsp->{$3}))                    ## no critic (Capture)
    { ++$err;
    }
    else
    { foreach my $itm (@{$slf->{'.pck'}})
      { next if $itm < $1 || $itm > $3;
        $val{$itm} = 2;
        _add_nxt($lst, $slf->{'_var'}, $rsp->{$itm});
      }
    }
  }
  $$val = [map {$rsp->{$_}} sort {$a <=> $b} keys(%val)];
  return $err;
}

sub _val_menu
{ my ($slf, $mod, $lst) = @_;
  my ($val);

  if ($slf->{'_pck'})
  { $val = $slf->{'.prv'}->[0];
    _dsp_val($slf, $mod, 0, 'err') if $slf->_tst_pick(\$val, $lst);
    return $val;
  }
  if (defined($slf->{'_end'}))
  { foreach my $itm (@{$slf->{'.prv'}})
    { _dsp_val($slf, $mod, 0, 'err')
        unless exists($slf->{'.rsp'}->{$itm});
      if (exists($slf->{'_one'})
        && ($val = $slf->{'.rsp'}->{$itm}) eq $slf->{'_one'})
      { _add_nxt($lst, $slf->{'_var'}, $val);
        $slf->{'.prv'} = [$itm];
        last;
      }
      _dsp_val($slf, $mod, 0, 'dup') if _chk_val($slf, $itm, 1);
    }
  }
  elsif (@{$slf->{'.prv'}}
    && exists($slf->{'.rsp'}->{$val = $slf->{'.prv'}->[0]}))
  { _add_nxt($lst, $slf->{'_var'}, $slf->{'.rsp'}->{$val});
  }
  else
  { _dsp_val($slf, $mod, 0, 'err');
  }
  return [map {$slf->{'.rsp'}->{$_}} @{$slf->{'.prv'}}];
}

# --- Number setting handling routines ----------------------------------------

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

  $dft = [grep {m/^([-+])?\d+(\.\d*)?([eE][\+\-]?\d+)?$/} @{$dft}];
  if (defined($slf->{'_end'}))
  { $slf->{'.prv'} = $dft;
  }
  elsif (@{$dft})
  { $slf->{'.prv'} = [$dft->[0]];
  }
  else
  { return 1 if $slf->{'_opt'};
    $slf->{'.prv'} = [$EMP];
  }
  return 0;
}

sub _get_number
{ my ($slf, $mod, $val, $lst) = @_;
  my ($nxt);

  # Reject an error
  return ($val, $slf->{'.cnt'})
    if (_tst_number($slf, $mod, \$val) && _dsp_val($slf, $mod, 1, 'err'))
    || (_chk_val($slf, $val)           && _dsp_val($slf, $mod, 1, 'dup'));

  # Accept other value
  if ($nxt = defined($slf->{'_end'}))
  { _nxt_val($slf, $val);
  }
  else
  { _add_nxt($lst, $slf->{'_var'}, $val);
  }
  return ($val, $nxt);
}

sub _res_number
{ my ($mod, $dft) = @_;

  return
    ($dft =~ $re_cfg) ? _rpl_cfg($mod, $1, $2, $4, $5, $6) :
    ($dft =~ $re_ext) ? _rpl_ext($mod, $1, $2, $3) :
    ($dft =~ $re_mrc) ? _rpl_mrc($mod, $1, $2, $5) :
    ($dft =~ $re_lst) ? _rpl_lst($mod, $1, $2, $4, $5) :
    ($dft =~ $re_reg) ? _rpl_reg($mod, $1, $2, $3, $5) :
    ($dft =~ $re_xml) ? _rpl_xml($mod, $1, $3, $4) :
                        $mod->resolve_string($dft);
}

sub _tst_number
{ my ($slf, $mod, $val) = @_;
  my ($ref, $typ);

  $$val =~ s/^\s+//;
  return 1 unless $$val =~ m/^(([-+])?\d+(\.\d*)?([eE][\+\-]?\d+)?)$/;
  $$val = $1 + 0;
  return !$mod->eval_value($slf->{'-ref'}, $$val) if exists($slf->{'-ref'});
  $ref = exists($slf->{'_ref'}) ? $mod->resolve_string($slf->{'_ref'}) : $EMP;
  return 0 unless $ref =~
    m/([IR])?([\[\]])([-+]?\d+(\.\d*)?)?\,([-+]?\d+(\.\d*)?)?([\[\]])/;
  $typ = $1 || 'I';
  return ((($typ eq 'I') ? $$val == int($$val) : 1) &&
    (defined($3) ? (($2 eq q{[}) ? ($$val >= $3) : ($$val > $3)) : 1) &&
    (defined($5) ? (($7 eq q{]}) ? ($$val <= $5) : ($$val < $5)) : 1)) ? 0 : 1;
}

sub _val_number
{ my ($slf, $mod, $lst) = @_;

  if (defined($slf->{'_end'}))
  { foreach my $itm (@{$slf->{'.prv'}})
    { _dsp_val($slf, $mod, 0, 'err') if _tst_number($slf, $mod, \$itm);
      _dsp_val($slf, $mod, 0, 'dup') if _chk_val($slf, $itm, 1);
    }
  }
  elsif (_tst_number($slf, $mod, \$slf->{'.prv'}->[0]))
  { _dsp_val($slf, $mod, 0, 'err');
  }
  else
  { _add_nxt($lst, $slf->{'_var'}, $slf->{'.prv'}->[0]);
  }
  return $slf->{'.prv'};
}

# --- Setup setting handling routines -----------------------------------------

sub _dft_setup
{ my ($slf, $dft, $mod, $flg, $trc) = @_;
  my ($col, $ctx, $def, $dir, $dpt, $grp, $lng, $lvl, $obj, $shr);

  $ctx = $mod->get_info('ctx');
  $def = $mod->get_info('def');
  $dir = $mod->get_info('dir');
  $dpt = $mod->get_info('dpt') + 1;
  $grp = $mod->get_info('grp');
  $lng = $mod->get_info('lng');
  $lvl = $mod->get_info('lvl');
  $shr = $mod->get_info('shr');
  foreach my $nam (@{$dft})
  { $obj = RDA::Object::Rda->is_absolute($nam)
                    ? $lng->load_file(RDA::Object::Rda->basename($nam),
                                      RDA::Object::Rda->dirname($nam)) :
      defined($dir) ? $lng->load_file($nam, $dir) :
                      $lng->search_package($grp, $nam);
    if ($obj)
    { $lng->add_usage($obj);
      $obj->set_info('dpt', $dpt);
      $obj->set_info('ctx', $ctx);
      $obj->set_info('shr', $shr);
      $obj->isolate unless $slf->{'_vis'};
      $obj->request($def, $lvl);
      $obj->delete_object;
    }
  }
  return 1;
}

sub _res_setup
{ my ($mod, $dft) = @_;

  return
    ($dft =~ $re_cfg) ? _rpl_cfg($mod, $1, $2, $4, $5, $6) :
    ($dft =~ $re_ext) ? _rpl_ext($mod, $1, $2, $3) :
    ($dft =~ $re_mrc) ? _rpl_mrc($mod, $1, $2, $5) :
    ($dft =~ $re_reg) ? _rpl_reg($mod, $1, $2, $3, $5) :
    ($dft =~ $re_src) ? _rpl_src($mod, $1, $2, $4, $5, '-e') :
    ($dft =~ $re_xml) ? _rpl_xml($mod, $1, $3, $4) :
                        $mod->resolve_string($dft);
}

# --- Text setting handling routines ------------------------------------------

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

  if (defined($slf->{'_end'}))
  { $slf->{'.prv'} = [map {_chk_case($slf, $_)} @{$dft}];
  }
  elsif (@{$dft})
  { $slf->{'.prv'} = [_chk_case($slf, $dft->[0])];
  }
  else
  { return 1 if $slf->{'_opt'};
    $slf->{'.prv'} = [$EMP];
  }
  return 0;
}

sub _get_text
{ my ($slf, $mod, $val, $lst) = @_;
  my ($nxt);

  # Reject an error
  return ($val, $slf->{'.cnt'})
    if (_tst_text($slf, $mod, \$val) && _dsp_val($slf, $mod, 1, 'err'))
    || (_chk_val($slf, $val)         && _dsp_val($slf, $mod, 1, 'dup'));

  # Accept other value
  if ($nxt = defined($slf->{'_end'}))
  { _nxt_val($slf, $val);
  }
  else
  { _add_nxt($lst, $slf->{'_var'}, $val);
  }
  return ($val, $nxt);
}

sub _res_text
{ my ($mod, $dft) = @_;

  return
    ($dft =~ $re_cfg) ? _rpl_cfg($mod, $1, $2, $4, $5, $6) :
    ($dft =~ $re_ext) ? _rpl_ext($mod, $1, $2, $3) :
    ($dft =~ $re_mrc) ? _rpl_mrc($mod, $1, $2, $5) :
    ($dft =~ $re_lst) ? _rpl_lst($mod, $1, $2, $4, $5) :
    ($dft =~ $re_pth) ? _rpl_pth($mod, uc($1), $2) :
    ($dft =~ $re_reg) ? _rpl_reg($mod, $1, $2, $3, $5) :
    ($dft =~ $re_src) ? _rpl_src($mod, $1, $2, $4, $5, '-e') :
    ($dft =~ $re_xml) ? _rpl_xml($mod, $1, $3, $4) :
                        $mod->resolve_string($dft);
}

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

  if (exists($slf->{'-ref'}))
  { ($$val) = $$val =~ m/^([\000-\377]*)$/;
    return !$mod->eval_value($slf->{'-ref'}, $$val);
  }
  if (exists($slf->{'_ref'}))
  { ($$val) = $$val =~ m/^([\000-\377]*)$/;
    return $$val !~ $slf->{'_ref'};
  }
  return 0;
}

sub _val_text
{ my ($slf, $mod, $lst) = @_;

  if (defined($slf->{'_end'}))
  { foreach my $itm (@{$slf->{'.prv'}})
    { _dsp_val($slf, $mod, 0, 'err') if _tst_text($slf, $mod, \$itm);
      _dsp_val($slf, $mod, 0, 'dup') if _chk_val($slf, $itm, 1);
    }
  }
  elsif (_tst_text($slf, $mod, \$slf->{'.prv'}->[0]))
  { _dsp_val($slf, $mod, 0, 'err');
  }
  else
  { _add_nxt($lst, $slf->{'_var'}, $slf->{'.prv'}->[0]);
  }
  return $slf->{'.prv'};
}

# --- Auxiliary routines ------------------------------------------------------

# Add settings to the list of next settings
sub _add_nxt
{ my ($lst, $rec, $val) = @_;

  unshift(@{$lst},
    @{exists($rec->[0]->{$val}) ? $rec->[0]->{$val} : $rec->[1]})
    if defined($val);
  return;
}

# Control string capitalisation
sub _chk_case
{ my ($slf, $str) = @_;

  return (!defined($str)) ? undef :
         $slf->{'_cas'}   ? $str :
                            uc($str);
}

# Compare the value with the previous values
sub _chk_val
{ my ($slf, $val, $flg) = @_;
  my $key;

  if (defined($slf->{'_end'}) && $slf->{'_dup'})
  { foreach my $prv (@{$slf->{$flg ? '.prv' : '_nxt'}})
    { if ($val eq $prv)
      { return 1 unless $flg;
        $flg = 0;
      }
    }
  }
  return 0;
}

# Display a key
sub _dsp_key
{ my ($slf, $mod, $key, $nxt) = @_;
  my ($val);

  if (exists($slf->{"_$key"}))
  { _dsp_txt($mod, $mod->resolve_string($slf->{"_$key"}), $nxt);
  }
  elsif (exists($slf->{"-$key"}))
  { _dsp_txt($mod, $slf->{"_$key"} = $slf->{"-$key"}->eval_as_string, $nxt);
  }
  return;
}

# Display a string
sub _dsp_str
{ my ($mod, $str) = @_;

  return $mod->submit(q{.}, RDA::Object::Message->new('DISPLAY.DSP_LINE',
    line => $str));
}

# Display a formatted text
sub _dsp_txt
{ my ($mod, $str, $nxt) = @_;

  return $mod->submit(q{.}, RDA::Object::Message->new('DISPLAY.DSP_REPORT',
    page => 0)->add_data(_fmt_str($str, $nxt)));
}

# Report setting validation error
sub _dsp_val
{ my ($slf, $mod, $flg, $msg) = @_;
  my ($key, $neg, $pat, $ret);

  if (exists($slf->{'_val'}))
  { if ($flg)
    { $neg = get_string('N');
      $ret = $slf->{'_val'} ne 'W';
      _dsp_key($slf, $mod, $msg, 1);
      unless ($ret)
      { $key = _ask_lin($mod, _fmt_str(get_string('Change').qq{\\040}, 0),
          $EMP, $EMP, $neg);
        $pat = get_string('Yes');
        $ret = (defined($key) && $key =~ m/\s*$pat/i) ? 1 : 0;
      }
      _dsp_str($mod, q{});
    }
    elsif ($slf->{'_val'} eq 'F')
    { _dsp_key($slf, $mod, $msg, 1);
      die get_string('BAD_VALUE', $slf->{'_nam'});
    }
    --$slf->{'.cnt'} if defined($slf->{'.cnt'}) && $slf->{'.cnt'} > 0;
  }
  return $ret;
}

# Format a string
sub _fmt_str
{ my ($str, $nxt) = @_;

  return ($str =~ m/^\.[CIMNPQRST]/) ? $str : _fmt_txt($str, $nxt);
}

# Format a text
sub _fmt_txt
{ my ($txt, $nxt) = @_;
  my ($lin, @txt);

  return unless (@txt = ref($txt) ? @{$txt} : split(/\n/, $txt));
  $lin = pop(@txt);
  $lin = length($lin) ? ".P$nxt\n$lin\n\n" :
         ($nxt > 0)   ? ".N$nxt\n" :
                        $EMP;
  return join($EMP, map {length($_) ? ".P1\n$_\n\n" : ".N1\n"} @txt).$lin;
}

# Switch to the next value
sub _nxt_val
{ my ($slf, $val) = @_;

  if (ref($val) eq 'ARRAY')
  { $slf->{'_nxt'} = $val;
  }
  else
  { push(@{$slf->{'_nxt'}}, $val);
  }
  $slf->{'.cnt'} = (exists($slf->{'_val'}) && $slf->{'_val'} =~ m/^E(\d+)$/
    && !defined($slf->{'_end'})) ? $1 + 1 : -1;
  $val = shift(@{$slf->{'.prv'}});
  $slf->{'.eof'} = 1;
  return $slf->{'.cur'} =
    (defined($val) && $val ne $slf->{'_clr'}) ? $val :
    defined($slf->{'_end'})                   ? $slf->{'_end'} :
    exists($slf->{'_brk'})                    ? $slf->{'_brk'} :
                                                $EMP;
}

# Resolve a variable (input format)
sub _resolve
{ my ($mod, $key) = @_;
  my ($val);

  return defined($val = $mod->get_var($key))
    ? $val
    : $mod->get_info('agt')->get_env($key, $EMP);
}

# Extract the setting from a configuration file
sub _rpl_cfg
{ my ($mod, $cfg, $fil, $pos, $typ, $re) = @_;
  my ($ifh, $str);

  # Generate the regular expression
  $re = $mod->resolve_string($re);
  $re = ($cfg eq 'CONFIG') ? qr/$re/ : qr/$re/i;

  # Scan the file
  $fil = $mod->get_var($fil);
  if ($fil && ($ifh = IO::File->new)->open(q{<}.$fil))
  { while (<$ifh>)
    { s/[\r\n]+//;
      if ($_ =~ $re)
      { $str = eval "\$$pos";  ## no critic (Eval)
        last;
      }
    }
    $ifh->close;
  }

  # Return the value or an empty string
  return $EMP unless defined($str);
  $str =~ s/^(\w+)\\:/$1:/
    if $typ && (RDA::Object::Rda->is_windows || RDA::Object::Rda->is_cygwin);
  return $str;
}

# Get the setting from an external module
sub _rpl_ext
{ my ($mod, $pkg, $fct, $arg) = @_;
  my ($agt, $cmd, $str, @arg);

  # Execute the external code
  if ($pkg && $fct)
  { $pkg =~ s{\/}{::}g;
    if ($arg)
    { foreach my $itm (split(/\s*,\s*/, $arg))
      { $itm = $mod->resolve_string($itm);
        $itm =~ s/'//g;
        $itm =~ s/\\+$//;
        push(@arg, $itm);
      }
    }
    $agt = $mod->get_info('agt');
    $cmd = (scalar @arg)
      ? qq{$pkg\:\:$fct(\$agt, '}.join(q{', '}, @arg).q{')}
      : qq{$pkg\:\:$fct(\$agt)};
    eval "require $pkg";
    $str = eval $cmd unless $@;  ## no critic (Eval)
  }

  # Return the value or an empty string
  return defined($str) ? $str : $EMP;
}

# List files
sub _rpl_lst
{ my ($mod, $src, $dir, $pos, $pat) = @_;
  my ($cnt, $flg, @tbl, %tbl);

  # Decode the options
  $pat = $mod->resolve_string($pat);
  $pat = RDA::Object::View->is_match($pat, $src eq 'LIST');
  ($flg, $pos) = (1, -$pos) if $pos < 0;

  # Scan the directory
  $dir = $mod->get_var($dir);
  if ($dir && opendir(DIR, $dir))
  { foreach my $nam (readdir(DIR))
    { $tbl{eval "\$$pos"} = 1 if $nam =~ $pat;
    }
    closedir(DIR);
  }

  # Return the list
  if ($flg)
  { @tbl = sort {$a <=> $b} keys(%tbl);
  }
  else
  { @tbl = sort keys(%tbl);
  }
  $cnt = 0;
  return [map {++$cnt => $_} @tbl];
}

# Get multi-run collection information
sub _rpl_mrc
{ my ($mod, $cmd, $set, $str) = @_;
  my ($cnt, $mrc, $obj, %tbl);

  $cmd = lc($cmd);
  $set = $mod->get_var($1, $EMP) if $set =~ m/^\*(\w+)$/;
  return $EMP unless length($set) && ($mrc = $mod->get_info('mrc'));
  if ($cmd eq 'collections')
  { return [] unless length($set = $mrc->find_set(undef, $set, $EMP));
    if (defined($str))
    { $str = $mod->resolve_string($str);
      return $EMP if $str eq q{*};
      %tbl = map {lc($_) => 1} split(/\|/, $str)
    }
    return [grep {!exists($tbl{$_})}
      sort keys(%{$mrc->get_collections($set)})];
  }
  if ($cmd eq 'items')
  { return [] unless length($set = $mrc->find_set(undef, $set, $EMP));
    $cnt = 0;
    if (defined($str))
    { $str = $mod->resolve_string($str);
      return $EMP if $str eq q{*};
      %tbl = map {lc($_) => 1} split(/\|/, $str)
    }
    return [map {++$cnt => $_}  grep {!exists($tbl{$_})}
      sort keys(%{$mrc->get_collections($set)})];
  }
  return [$mrc->get_members($set, defined($str)
    ? $mod->resolve_string($str)
    : undef)]
    if $cmd eq 'members';
  return $obj->get_title($str, $EMP)
    if $cmd eq 'title' && defined($str)
    && ($obj = $mrc->get_collection("$set:$str"));
  return $EMP;
}

# Construct a path
sub _rpl_pth
{ my ($mod, $typ, $str) = @_;
  my ($cfg, $dir, $ext, $pth);

  $str =~ s/\//\001/g;
  return $EMP unless length($str = $mod->resolve_string($str));

  # Treat a directory request
  return RDA::Object::Rda->clean_path([(map
    {($_ eq q{..}) ? RDA::Object::Rda->up_dir : $_}
    split(/\001/, $str)), $EMP], 1) if $typ eq 'D';

  # Treat a file request
  return RDA::Object::Rda->clean_path([map
    {($_ eq q{..}) ? RDA::Object::Rda->up_dir : $_}
    split(/\001/, $str)], 1) if $typ eq 'F';

  # Treat a module request
  $cfg = $mod->get_info('cfg');
  $ext = ($typ eq 'S') ? '.cfg' :
         ($typ eq 'C') ? '.ctl' :
                         $EMP;
  return $cfg->cat_file($cfg->get_group('D_RDA_COL'), $1, $2.$ext)
    if $str =~ m/^([A-Z][A-Z\d]*):(.*)$/;
  return $pth
    if defined($dir = $mod->get_info('dir'))
    && -r ($pth = $cfg->cat_file($dir, $str.$ext));
  $dir = $cfg->get_group('D_RDA_COL');
  foreach my $grp (@{$mod->get_info('grp')})
  { return $pth
      if -r ($pth = $cfg->cat_file($dir, $grp, $str.$ext));
  }
  return $EMP;
}

# Extract the setting from the Windows registry
sub _rpl_reg
{ my ($mod, $typ, $key, $nam, $suf) = @_;
  my ($obj, $str);

  if (RDA::Object::Rda->is_windows || RDA::Object::Rda->is_cygwin)
  { $mod->set_info('reg',
      $obj = RDA::Object::Windows->new($mod->get_info('col')))
      unless ($obj = $mod->get_info('reg'));
    $str = ($typ eq 'REG64') ? $obj->get_registry64($key, $nam) :
           ($typ eq 'REG32') ? $obj->get_registry32($key, $nam) :
                               $obj->get_registry($key, $nam);
    return defined($suf) ? $str.$suf : $str if defined($str);
  }
  return $EMP;
}

# Search a file
sub _rpl_src
{ my ($mod, $src, $dir, $opt, $pat, $flt) = @_;
  my ($lvl, $one, $str, @tbl, %mod);

  # Decode the options
  $lvl = 0;
  $pat = $mod->resolve_string($pat);
  $pat = RDA::Object::View->is_match($pat, $src eq 'SEARCH');
  $lvl = $1 || 8 if $opt =~ m/r([1-9])?/;
  $flt = '-e' if index($opt, 'w') >= 0;
  $one = index($opt, 'f') >= 0;

  # Scan the directory
  $dir = $mod->get_var($dir);
  _grep_dir(\@tbl, $dir, $pat, $lvl, $flt, $one) if $dir && opendir(DIR, $dir);

  # Indicate that no match has been found
  return [] unless @tbl;

  # Sort the file names
  if (index($opt, 'd') >= 0)
  { @tbl =
     sort {RDA::Object::Rda->dirname($a)  cmp RDA::Object::Rda->dirname($b) ||
           RDA::Object::Rda->basename($a) cmp RDA::Object::Rda->basename($b)}
          @tbl;
  }
  elsif (index($opt, 'n') >= 0)
  { @tbl = sort {$a cmp $b} @tbl;
  }
  elsif (index($opt, 't') >= 0)
  { foreach my $nam (@tbl)
    { $mod{$nam} = (stat($nam))[9] || 0;
    }
    ## no critic (Reverse)
    @tbl = sort {$mod{$b} <=> $mod{$a} || $a cmp $b} keys(%mod);
  }

  # Return the result
  return (index($opt, 'b') >= 0) ? RDA::Object::Rda->basename($tbl[0]) :
         (index($opt, 'w') >= 0) ? RDA::Object::Rda->dirname($tbl[0]) :
         $tbl[0] if index($opt, 'f') >= 0;
  return [map {RDA::Object::Rda->basename($_)} @tbl] if index($opt, 'b') >= 0;
  return [map {RDA::Object::Rda->dirname($_)} @tbl]  if index($opt, 'w') >= 0;
  return [@tbl];
}

sub _grep_dir
{ my ($tbl, $dir, $pat, $lvl, $flt, $one) = @_;
  my ($str, $pth, @sub);

  # Read the directory content
  --$lvl;
  foreach my $nam (readdir(DIR))
  { next unless $nam =~ m/^([\000-\377]*)$/;
    $pth = RDA::Object::Rda->cat_file($dir, $nam = $1);
    if ($nam =~ $pat)
    { $str = $pth;
      $str =~ s/'/'."'".'/g;
      if (eval "$flt '$str'")  ## no critic (Eval)
      { push(@{$tbl}, $pth);
        if ($one)
        { $lvl = 0;
          last;
        }
      }
    }
    push(@sub, $pth) if $lvl > 0 && -d $pth && -r $pth && $nam !~ m/^\.+$/;
  }
  closedir(DIR);

  # Explore subdirectories
  if ($lvl > 0)
  { foreach my $sub (@sub)
    { next unless opendir(DIR, $sub);
      _grep_dir($tbl, $sub, $pat, $lvl, $flt, $one);
      return if $one && @{$tbl};
    }
  }
  return;
}

# Extract the setting from an XML file
sub _rpl_xml
{ my ($mod, $fil, $key, $qry) = @_;
  my ($obj, $tbl);

  # Get the parsed XML and perform the query
  $tbl = $mod->get_info('xml');
  $fil = $mod->get_var($fil);
  $tbl->{$fil} = RDA::Object::Xml->new($mod->get_info('col')->get_trace('XML')
    )->parse_file($fil) unless exists($tbl->{$fil});
  $obj = $tbl->{$fil};
  ($obj) = $obj->find($mod->resolve_string($qry));

  # Return the requested value
  return (!$obj) ? $EMP :
         (!$key) ? $obj->get_data :
                   $obj->get_value($key, $EMP);
}

1;

__END__

=head1 SEE ALSO

L<RDA::Agent|RDA::Agent>,
L<RDA::Object|RDA::Object>,
L<RDA::Object::Message|RDA::Object::Message>,
L<RDA::Object::Rda|RDA::Object::Rda>,
L<RDA::Object::View|RDA::Object::View>,
L<RDA::Object::Windows|RDA::Object::Windows>,
L<RDA::Object::Xml|RDA::Object::Xml>,
L<RDA::Request::ASK|RDA::Request::ASK>,
L<RDA::Request::DISPLAY|RDA::Request::DISPLAY>,
L<RDA::SDCL::Block|RDA::SDCL::Block>,
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