# Item.pm: Class Used for Managing Items

package RDA::Object::Item;

# $Id: Item.pm,v 1.32 2015/08/28 09:10:39 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/Object/Item.pm,v 1.32 2015/08/28 09:10:39 RDA Exp $
#
# Change History
# 20150828  MSC  Support sections in module settings.

=head1 NAME

RDA::Object::Item - Class Used for Managing Data Items

=head1 SYNOPSIS

 require RDA::Object::Item;

=head1 DESCRIPTION

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

The following methods are available:

=cut

use strict;

BEGIN
{ use Exporter;
  use IO::File;
  use RDA::Text qw(debug get_string);
  use RDA::Handle::Data;
  use RDA::Object;
  use RDA::Object::Rda qw($CREATE $DIR_PERMS $FIL_PERMS);
  use RDA::Object::View;
}

# Define the global public variables
use vars qw($DUMP $STRINGS $VERSION @DELETE @DUMP @EXPORT_OK @ISA %SDCL);
$DUMP      = 0;
$VERSION   = sprintf('%d.%02d', q$Revision: 1.32 $ =~ /(\d+)\.(\d+)/);
@DELETE    = qw(chl);
@DUMP      = (
  obj => {'RDA::Object::Item' => 1},
  str => {par => 0, top => 0},
  );
@EXPORT_OK = qw(decode_value encode_value);
@ISA       = qw(RDA::Object Exporter);
%SDCL      = (
  inc => [qw(RDA::Object)],
  met => {
    'apply'        => {ret => 1},
    'clean'        => {ret => 0},
    'clear'        => {ret => 0},
    'clear_temp'   => {ret => 1},
    'clone'        => {ret => 0},
    'compact'      => {ret => 0},
    'extract'      => {ret => 0},
    'find'         => {ret => 0},
    'get_childs'   => {ret => 1},
    'get_desc'     => {ret => 0},
    'get_element'  => {ret => 1},
    'get_first'    => {ret => 0},
    'get_hash'     => {ret => 0},
    'get_local'    => {ret => 1},
    'get_names'    => {ret => 1},
    'get_parents'  => {ret => 1},
    'get_path'     => {ret => 0},
    'get_prime'    => {ret => 0},
    'get_primary'  => {ret => 0},
    'get_property' => {ret => 1},
    'get_text'     => {ret => 1},
    'get_top'      => {ret => 0},
    'get_value'    => {ret => 1},
    'grep'         => {ret => 1},
    'is_defined'   => {ret => 0},
    'record'       => {ret => 0},
    'reset'        => {ret => 0},
    'save_content' => {ret => 0},
    'search'       => {ret => 1},
    'set_desc'     => {ret => 0},
    'set_info'     => {ret => 0},
    'set_raw'      => {ret => 1},
    'set_temp'     => {ret => 1},
    'set_value'    => {ret => 1},
    'transfer'     => {ret => 0},
    'validate'     => {ret => 0},
    },
  );

# Define the global private constants
my $ITM = q{RDA::Object::Item};
my $REF = qr/^(?:ARRAY|HASH)$/;  ## no critic (Fixed)
my $SEP = q{#} x 79;

my $B_VAL = 1;
my $B_DSC = 2;

# Define the global private variables
my %tb_cnv = (
  D => \&_val_local_directory,
  F => \&_val_local_file,
  );
my %tb_fmt = (
  B => \&_fmt_boolean,
  G => \&_fmt_gmttime,
  I => \&_fmt_item,
  R => \&_fmt_real,
  );
my %tb_loc = (
  B => \&_val_boolean,
  D => \&_val_local_directory,
  F => \&_val_local_file,
  G => \&_val_gmt_time,
  I => \&_val_item,
  K => \&_val_keylist,
  M => \&_val_module,
  N => \&_val_number,
  R => \&_val_real,
  S => \&_val_status,
  T => \&_val_text,
  V => \&_val_version,
  W => \&_val_word,
  );
my %tb_sta = map {$_ => $_} qw(done obsolete partial pending skip);
my %tb_typ = (
  B => 'boolean',
  D => 'directory',
  F => 'file',
  G => 'GMTtime',
  I => 'item',
  K => 'keylist',
  M => 'module',
  N => 'number',
  R => 'real',
  S => 'status',
  T => 'text',
  V => 'version',
  W => 'word',
  );
my %tb_val = (
  B => \&_val_boolean,
  D => \&_val_directory,
  F => \&_val_file,
  G => \&_val_gmt_time,
  I => \&_val_item,
  K => \&_val_keylist,
  M => \&_val_module,
  N => \&_val_number,
  R => \&_val_real,
  S => \&_val_status,
  T => \&_val_text,
  V => \&_val_version,
  W => \&_val_word,
  );

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

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

The top item constructor. You can provide the agent reference, the object
identifier, and optional title as arguments.

=head2 S<$h = $obj-E<gt>new($oid)>

The subitem object constructor. You can provide the object identifier as
an argument.

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

=over 12

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

=item S<    B<'chl' > > Subitem object hash (T,S)

=item S<    B<'cur' > > Current property values (T,S)

=item S<    B<'dsc' > > Property descriptions (T,S)

=item S<    B<'grp' > > Groups already loaded (T)

=item S<    B<'log' > > Change log (S)

=item S<    B<'oid' > > Object identifier (T) / Item name (S)

=item S<    B<'old' > > Old property values (T,S)

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

=item S<    B<'raw' > > Raw value indicator (S)

=item S<    B<'tie' > > Tie value indicator (S)

=item S<    B<'top' > > Top object reference (T,S)

=item S<    B<'ttl' > > Object title (T)

=item S<    B<'trc' > > Trace indicator (T)

=back

=cut

sub new
{ my ($cls, $arg, $oid, $ttl) = @_;
  my ($slf);

  if (ref($cls))
  { # Validate the object name
    die get_string('BAD_OID', $arg) unless $arg =~ m/^[A-Za-z]\w*$/;

    # Create the subitem object
    $slf = bless {
      chl => {},
      cur => {},
      dsc => {},
      oid => uc($arg),
      old => {},
      raw => {},
      tie => {},
      top => $cls->{'top'},
      }, ref($cls);
    $slf->{'par'} = $cls unless exists($cls->{'agt'});
  }
  else
  { # Validate the arguments
    die get_string('BAD_OID', $oid) unless $oid =~ m/^[A-Za-z]\w*$/;
    die get_string('NO_AGENT', $oid) unless ref($arg);

    # Create the top item object
    $slf = bless {
      agt => $arg,
      chl => {},
      cur => {},
      dsc => {},
      grp => {},
      oid => lc($oid),
      old => {},
      ttl => defined($ttl) ? $ttl : '%s Configuration',
      trc => ($arg->get_level < 20) ? 0 : 1,
      }, $cls;
    $slf->{'top'} = $slf;
  }

  # Return the object reference
  return $slf;
}

=head2 S<$h-E<gt>apply($buf)>

This method applies a patch on the item tree. Values are validated. It returns
the errors encountered during the operation.

=cut

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

  return patch($slf, RDA::Handle::Data->new($buf));
}

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

This method returns the object as a string.

=cut

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

  return q{[}.(exists($slf->{'par'}) ? $slf->get_path : $slf->{'oid'}).q{]};
}

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

This method takes a backup of the object properties and returns the backup
reference. When requested, it also transforms the values in temporary
values. Unless the flag is set, it treats its subobjects.

=cut

sub backup
{ my ($slf, $tmp, $flg) = @_;
  my ($bkp, $ref, $val);

  # Create the backup hash
  $bkp = {
    cur  => clone_value($slf->{'cur'}),
    dsc  => clone_value($slf->{'dsc'}),
    oid  => $slf->{'oid'},
    old  => clone_value($slf->{'old'}),
    raw  => {%{$slf->{'raw'}}},
    };

  # Transform the values in temporary values
  if ($tmp)
  { foreach my $key (keys(%{$slf->{'old'}}), keys(%{$slf->{'cur'}}))
    { $slf->{'old'}->{$key} = undef;
    }
  }

  # Treat subobjects
  unless ($flg)
  { foreach my $nam (keys(%{$slf->{'chl'}}))
    { $bkp->{'chl'}->{$nam} = $slf->{'chl'}->{$nam}->backup($tmp, $flg);
    }
  }

  # Return the backup information
  return $bkp;
}

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

This method removes all temporary values from the item object. Unless the flag
is set, it clears its subobjects. It returns the object reference.

=cut

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

  # Clean subobjects
  unless ($flg)
  { foreach my $cfg (values(%{$slf->{'chl'}}))
    { $cfg->clean;
    }
  }

  # Clean object attributes
  foreach my $key (keys(%{$slf->{'old'}}))
  { if (defined($old = $slf->{'old'}->{$key}))
    { $slf->{'cur'}->{$key} = $old;
      $slf->{'raw'}->{$key} = 1;
    }
    else
    { delete($slf->{'cur'}->{$key});
      delete($slf->{'raw'}->{$key});
      delete(_decode_attr($slf, 'dsc')->{$key});
    }
  }
  $slf->{'old'} = {};
  return $slf;
}

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

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

=cut

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

  # Clear subobjects
  unless ($flg)
  { foreach my $cfg (values(%{$slf->{'chl'}}))
    { $cfg->clear;
    }
  }

  # Clear object attributes
  $slf->{'cur'} = {};
  $slf->{'dsc'} = {};
  $slf->{'old'} = {};
  $slf->{'raw'} = {};

  # Return the object reference
  return $slf;
}

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

This method returns a clone of the item tree. When the flag is set, it adds
a change log to the cloned tree. It returns the clone reference.

=cut

sub clone
{ my ($src, $flg) = @_;
  my (%tbl);

  return _clone_properties(\%tbl,
    _clone_item(\%tbl, $src, exists($src->{'par'}) ? $src->{'par'} : undef),
    $flg);
}

sub _clone_item
{ my ($tbl, $src, $par, $flg) = @_;
  my ($dst, $pth);

  # Clone the object
  if (exists($src->{'agt'}))
  { $dst = bless {
      agt => $src->{'agt'},
      cur => $src->{'cur'},
      dsc => clone_value($src->{'dsc'}),
      grp => $src->{'grp'},
      oid => $src->{'oid'},
      old => $src->{'old'},
      ttl => $src->{'ttl'},
      trc => $src->{'trc'},
      }, ref($src);
    $dst->{'top'} = $dst;
  }
  else
  { $dst = bless {
      cur => $src->{'cur'},
      dsc => clone_value($src->{'dsc'}),
      oid => $src->{'oid'},
      old => $src->{'old'},
      raw => {%{$src->{'raw'}}},
      tie => {},
      top => $src->{'top'},
    }, ref($src);
    $dst->{'par'} = ref($par) ? $par : $src->{'par'} if exists($src->{'par'});
  }

  # Clone the child objects
  $dst->{'chl'} = {map {$_ => _clone_item($tbl, $src->{'chl'}->{$_}, $dst)}
                      keys(%{$src->{'chl'}})};

  # Cache the item reference
  $tbl->{$pth} = $dst if defined($pth = $dst->get_path);

  # Return a reference to the cloned object
  return $dst;
}

sub _clone_properties
{ my ($tbl, $dst, $flg) = @_;

  # Clone its properties
  $dst->{'cur'} = clone_value($dst->{'cur'}, $tbl, $flg);
  $dst->{'old'} = clone_value($dst->{'old'}, $tbl, $flg);

  # Add a change log when requested
  $dst->{'log'} = {} if $flg;

  # Clone the child object properties
  foreach my $obj (values(%{$dst->{'chl'}}))
  { _clone_properties($tbl, $obj, $flg);
  }

  # Return a reference to the cloned object
  return $dst;
}

sub _clone_ref
{ my ($tbl, $obj) = @_;
  my ($pth);

  return exists($tbl->{$pth = $obj->get_path}) ? $tbl->{$pth} : $obj;
}

sub clone_value
{ my ($val, $tbl, $flg) = @_;
  my ($ref);

  $ref = ref($val);
  return
    ($ref eq 'ARRAY')      ? [map {clone_value($_)} @{$val}] :
    ($ref eq 'HASH')       ? {map {$_=>clone_value($val->{$_})} keys(%{$val})} :
    ($tbl && $ref eq $ITM) ? _clone_ref($tbl, $val) :
                             $val;
}

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

This method removes all empty nodes from the object tree. It returns the object
reference.

=cut

sub compact
{ my ($slf) = @_;
  my ($tbl);

  foreach my $key (keys(%{$tbl = $slf->get_top->{'chl'}}))
  { delete($tbl->{$key}) unless _has_content($tbl->{$key});
  }
  return $slf;
}

sub _has_content
{ my ($slf) = @_;
  my ($cnt, $tbl);

  $cnt = 0;
  foreach my $key (keys(%{$tbl = $slf->{'chl'}}))
  { if (_has_content($tbl->{$key}))
    { $cnt++;
    }
    else
    { delete($tbl->{$key});
    }
  }
  return $cnt || keys(%{$slf->{'cur'}}) || keys(%{$slf->{'old'}});
}

=head2 S<$h-E<gt>convert($ofh,$tag)>

This method saves the item tree in XML format. It closes the file handle at
save completion. It returns the object reference.

=cut

sub convert
{ my ($slf, $ofh, $str) = @_;
  my ($cur);

  print {$ofh} qq{<$str>\n};
  _cnv_item($ofh, $slf, $slf->get_path);
  print {$ofh} qq{</$str>\n};
  $ofh->close;
  return $slf;
}

sub _cnv_item
{ my ($ofh, $slf, $str) = @_;
  my ($cnt, $typ, $val, @chl, @tbl);

  # Save the object properties
  $cnt = 0;
  @chl = keys(%{$slf->{'chl'}});
  foreach my $key (sort keys(%{$slf->{'cur'}}))
  { if (exists($slf->{'old'}->{$key}))
    { next unless defined($val = $slf->{'old'}->{$key});
      $val = decode_value($slf, \$val, 1);
      next unless _is_valid($slf, $key, \$val);
    }
    elsif (exists($slf->{'raw'}->{$key}))
    { next unless defined($val = $slf->{'cur'}->{$key});
      $val = decode_value($slf, \$val, 1);
      next unless _is_valid($slf, $key, \$val);
    }
    else
    { $val = $slf->{'cur'}->{$key};
    }
    print {$ofh} qq{<sdp_item id='$str'>\n} if $cnt++ == 0 && $str;
    $typ = $tb_typ{substr($key, 0, 1)};
    print {$ofh} qq{<sdp_property id='$key' type='$typ'>\n}
      ._cnv_value($val, $typ, q{})
      .qq{</sdp_property>\n};
  }
  print {$ofh} qq{</sdp_item>\n} if $cnt;

  # Save subobjects
  foreach my $oid (sort @chl)
  { _cnv_item($ofh, $slf->{'chl'}->{$oid}, $str ? "$str.$oid" : $oid);
  }
  return;
}

sub _cnv_key
{ return q{ key='}._cnv_txt(shift).q{'};
}

sub _cnv_txt
{ my ($txt) = @_;

  $txt =~ s/([^\040\041\043-\045\047\052\054\056-\072\075\077-\176])/
    sprintf('&#x%X;', ord($1))/ge;
  return $txt;
}

sub _cnv_value
{ my ($val, $typ, $att) = @_;

  my $ref = ref($val);
  return
    ($ref eq 'ARRAY') ?
      qq{<sdp_value$att type='array'>\n}.
      join(q{}, map {_cnv_value($_, $typ, q{})} @{$val}).
      "</sdp_value>\n" :
    ($ref eq 'HASH')  ?
      qq{<sdp_value$att type='hash'>\n}.
      join(q{}, map {_cnv_value($val->{$_}, $typ, _cnv_key($_))}
               sort keys(%{$val})).
      qq{</sdp_value>\n} :
    ($ref) ?
      q{<sdp_value type='item'>}.$val->get_path.q{</sdp_value>} :
    defined($val) ?
      qq{<sdp_value$att type='$typ'>}._cnv_txt($val).qq{</sdp_value>\n} :
    qq{<sdp_value$att type='undef'/>\n};
}

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

This method returns a string containing the object 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, $str) = @_;
  my ($pre);

  return $slf->SUPER::dump($lvl, $str) if $DUMP;

  $lvl = 0 unless defined($lvl);
  $pre = q{  } x $lvl;
  return _dump($slf, $lvl,
    (defined($str) && length($str)) ? $pre.$str.qq{\n} : q{});
}

sub _dump
{ my ($slf, $lvl, $str) = @_;
  my ($buf, $pre);

  $pre = q{  } x $lvl++;
  $buf = $str.$pre.q{[}.$slf->get_path.q{]};
  foreach my $nam (sort keys(%{$slf->{'cur'}}))
  { $buf .= qq{\n};
    $buf .= RDA::Object::dump_data($slf->{'cur'}->{$nam}, $lvl,
      exists($slf->{'old'}->{$nam}) ? qq{-$nam = } : qq{$nam = });
    $buf .= q{ (raw)} if $slf->{'raw'}->{$nam};
  }
  --$lvl;
  foreach my $nam (sort keys(%{$slf->{'chl'}}))
  { $buf .= _dump($slf->{'chl'}->{$nam}, $lvl, qq{\n\n});
  }
  return $buf;
}

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

This method extracts the recorded changes from the item tree.

=cut

sub extract
{ my ($slf, @nam) = @_;
  my ($buf, $log, $nam, $val, @var);

  # Extract property changes
  $buf = q{};
  if (($log = delete($slf->{'log'})) && (@var = keys(%{$log})))
  { foreach my $var (@var)
    { $nam = join(q{.}, @nam, $var);
      if ($log->{$var} & $B_VAL)  ## no critic (Bit)
      { $val = exists($slf->{'old'}->{$var}) ? $slf->{'old'}->{$var} :
               exists($slf->{'cur'}->{$var}) ? $slf->{'cur'}->{$var} :
                                                undef;
        $buf .=
          (!defined($val))              ? qq{v=$nam\n} :
          exists($slf->{'raw'}->{$var}) ? qq{R=$nam=$val\n} :
                                          qq{V=$nam=}.encode_value($val).qq{\n};
      }
      if ($log->{$var} & $B_DSC)  ## no critic (Bit)
      { $buf .= exists($slf->{'dsc'}->{$var})
          ? qq{D=$nam=}.encode_value($slf->{'dsc'}->{$var}).qq{\n}
          : qq{d=$nam\n};
      }
    }
  }

  # Extract the changes in the child objects
  foreach my $key (keys(%{$slf->{'chl'}}))
  { $buf .= $slf->{'chl'}->{$key}->extract(@nam, $key);
  }

  # Return the changes
  return $buf;
}

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

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

=cut

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

  if (defined($str))
  { $str = [split(/\./, uc($str))] unless ref($str) eq 'ARRAY';
    foreach my $oid (@{$str})
    { unless (exists($slf->{'chl'}->{$oid}))
      { return unless $flg;
        $slf->{'chl'}->{$oid} = $slf->new($oid);
      }
      $slf = $slf->{'chl'}->{$oid};
    }
  }
  return $slf;
}

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

This method returns the list of child objects in an array context. In a scalar
context, it returns the child hash reference.

=cut

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

  return (values(%{$slf->{'chl'}})) if wantarray;
  return $slf->{'chl'};
}

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

This method returns the list of parent item objects, sorted by their distance
from the current item object.

=cut

sub get_parents
{ my ($slf) = @_;
  my (@tbl);

  push(@tbl, $slf = $slf->{'par'}) while exists($slf->{'par'});
  return @tbl;
}

=head2 S<$h-E<gt>get_path([$base])>

This method returns the absolute path to an item object unless you specify a
base object. When the base object is a parent, it returns a path relative to
that base object.

=cut

sub get_path
{ my ($slf, $bas) = @_;
  my ($str);

  $bas = $slf unless ref($bas) eq $ITM;
  unless (exists($slf->{'agt'}))
  { $str = $slf->{'oid'};
    while (exists($slf->{'par'}))
    { $slf = $slf->{'par'};
      return $str if $slf == $bas;
      $str = $slf->{'oid'}.q{.}.$str
    }
    $slf = $slf->{'top'};
  }
  return $str;
}

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

This method returns a reference to the top object.

=cut

sub get_top
{ return shift->{'top'};
}

=head2 S<$h-E<gt>is_included($base)>

This method indicates whether the item object is included in the base object.

=cut

sub is_included
{ my ($slf, $bas) = @_;

  for (;;)  ## no critic (Loop)
  { return 1 if $slf == $bas;
    return 0 unless exists($slf->{'par'});
    $slf = $slf->{'par'};
  }
}

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

This method loads the item definition. Unless the flag is set, it closes the
file handle at load completion. It returns the object reference.

=cut

sub load
{ my ($slf, $ifh, $flg) = @_;
  my ($agt, $buf, $cnt, $cur, $key, $lin, $lvl, $val);

  $agt = $slf->{'agt'};
  $cnt = 0;
  $cur = $slf;
  $lin = q{};
  $lvl = defined($agt) ? $agt->get_level : 0;

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

    # Treat the line
    $buf = $lin;
    if ($lin =~ s/^\133(\w+(\.\w+)*)\135$//)  # Object
    { $cur = $slf->find($1, 1);
    }
    elsif (!defined($cur))
    { debug(get_string('SkipLine', $cnt, $buf))
        unless $lvl < 20;  ## no critic (Unless)
      $lin = q{};
    }
    elsif ($lin =~ s/^([A-Z]_\w+)=//)         # Property definition
    { $key = uc($1);
      $cur->{'cur'}->{$key} = $lin;
      $cur->{'raw'}->{$key} = 1;
      $lin = q{};
    }
    elsif ($lin =~ s/^\?=\173//)              # Property descriptions
    { $cur->{'dsc'} = $lin;
      $lin = q{};
    }

    # Report invalid lines
    debug(get_string('BadLine', $cnt, $buf))
      if $lin && $lin !~ /^\s*\#/ && $lvl >= 30;
    $lin = q{};
  }
  $ifh->close unless $flg;
  return $slf;
}

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

  $val = [];
  unless ($$str =~ m/^\051/)
  { for (;;)  ## no critic (Loop)
    { push(@{$val}, decode_value($slf, $str));
      last unless $$str =~ s/^,\s*//;
    }
  }
  $$str = q{)} unless $$str =~ s/^\051//;
  return $val;
}

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

  $val = {};
  unless ($$str =~ m/^\175/)
  { for (;;)  ## no critic (Loop)
    { $key = decode_value($slf, $str);
      unless ($$str =~ s/^\s*(,|=>)\s*//)
      { $$str = q{,};
        last;
      }
      $val->{$key} = decode_value($slf, $str);
      last unless $$str =~ s/^,\s*//;
    }
  }
  $$str = '}' unless $$str =~ s/^\175//;
  return $val;
}

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

  return $typ
    ? $slf->{'top'}->{'agt'}->get_item($typ)->find($nam, 1)
    : $slf->{'top'}->find($nam, 1);
}

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

  return
    ($$str =~ s/^"(.*?)"//)
      ? RDA::Object::decode($1) :
    ($$str =~ s/^\133((\w+)\/)?(\w+(\.\w+)*)\135//)
      ? _decode_item($slf, $3, $2) :
    ($$str =~ s/^undef//)
      ? undef :
    ($flg && $$str =~ s/^(.*)//)
      ? $1 :
    ($$str =~ s/^(.*?)(\s*\=\>|[,\051\175])/$2/)
      ? $1 :
    q{};
}

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

  return
    ($$str =~ s/^\050//) ? _decode_array($slf, $str) :
    ($$str =~ s/^\173//) ? _decode_hash($slf, $str) :
                           _decode_scalar($slf, $str, $flg);
}

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

This method merge all properties of the source object in the current
object. Unless the flag is set, it treats its subobjects. It returns the
object reference.

=cut

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

  _merge($slf, $src, $flg) if $src;
  return $slf;
}

sub _merge
{ my ($slf, $src, $flg) = @_;
  my ($dsc, $val);

  # Decode the description
  _decode_attr($slf, 'dsc');
  $dsc = _decode_attr($src, 'dsc');

  # Merge the properties
  foreach my $key (keys(%{$src->{'cur'}}))
  { next unless defined($val = $src->{'cur'}->{$key});
    delete($slf->{'old'}->{$key});
    $slf->{'cur'}->{$key} = exists($src->{'raw'}->{$key})
      ? $val
      : encode_value($val);
    $slf->{'log'}->{$key} |= $B_VAL  ## no critic (Bit)
      if exists($slf->{'log'});
    $slf->{'raw'}->{$key} = 1;
    if (exists($dsc->{$key}))
    { $slf->{'dsc'}->{$key} = $dsc->{$key};
      $slf->{'log'}->{$key} |= $B_DSC  ## no critic (Bit)
        if exists($slf->{'log'});
    }
  }

  # Merge subobjects
  unless ($flg)
  { foreach my $nam (keys(%{$src->{'chl'}}))
    { $slf->{'chl'}->{$nam} = $slf->new($nam)
        unless exists($slf->{'chl'}->{$nam});
      _merge($slf->{'chl'}->{$nam}, $src->{'chl'}->{$nam});
    }
  }
  return;
}

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

This method patches the item tree. Values are validated. It returns the errors
encountered during the operation.

It closes the file handle at patch completion.

=cut

sub patch
{ my ($slf, $ifh) = @_;
  my ($cnt, $key, $lin, $typ, $val, @err);

  if ($ifh)
  { $cnt = 0;
    while (defined($lin = $ifh->getline))
    { # Trim spaces and join continuation lines
      ++$cnt;
      $lin =~ s/^\s+//;
      $lin =~ s/[\r\s]+$//;

      # Treat the line
      ($typ, $key, $val) = split(/=/, $lin, 3);
      next unless $typ && $key;
      $key = uc($key);
      eval {
        if ($typ eq 'V')
        { $slf->set_value($key, decode_value($slf, \$val));
        }
        elsif ($typ eq 'R')
        { $slf->set_raw($key, decode_value($slf, \$val));
        }
        elsif ($typ eq 'D')
        { $slf->set_desc($key, _decode_scalar($slf, \$val, -1));
        }
        elsif ($typ eq 'v')
        { $slf->set_value($key);
        }
        elsif ($typ eq 'd')
        { $slf->set_desc($key);
        }
        elsif ($typ =~ m/^#/)
        { next;
        }
      };

      # Report invalid lines
      if ($@)
      { push(@err, get_string('Error', $cnt, $lin, $@));
      }
      elsif ($val && $val !~ /^\s*\#/)
      { push(@err, get_string('BadLine', $cnt, $lin));
      }
    }
    $ifh->close();
  }
  return @err;
}

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

This method starts the recording of the value and description changes done in
the item tree. Previous recordings are lost.

=cut

sub record  ## no critic (Ambiguous)
{ my ($slf) = @_;

  $slf->{'log'} = {};
  foreach my $obj (values(%{$slf->{'chl'}}))
  { $obj->record;
  }
  return $slf;
}

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

This method resets the item tree.

=cut

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

  $slf = $slf->get_top;

  # Clear subobjects
  for (values(%{$slf->{'chl'}}))
  { $_->delete_object;
  }

  # Clear object attributes
  $slf->{'chl'} = {};
  $slf->{'cur'} = {};
  $slf->{'old'} = {};
  $slf->{'raw'} = {};

  # Return the object reference
  return $slf;
}

=head2 S<$h-E<gt>restore($backup)>

This method restore the object properties from a backup. It returns the object
reference.

=cut

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

  # Validate the restore request
  die get_string('BAD_RESTORE', $slf->{'oid'})
    unless ref($bkp) eq 'HASH' && $slf->{'oid'} eq $bkp->{'oid'};

  # Restore subobjects
  if (ref($bkp->{'chl'}) eq 'HASH')
  { foreach my $nam (keys(%{$bkp->{'chl'}}))
    { $slf->find($nam, 1)->restore(delete($bkp->{'chl'}->{$nam}));
    }
  }

  # Restore the information
  $slf->{'cur'} = $bkp->{'cur'};
  $slf->{'dsc'} = $bkp->{'dsc'};
  $slf->{'old'} = $bkp->{'old'};
  $slf->{'raw'} = $bkp->{'raw'};
  undef %{$bkp};

  # Return the object reference
  return $slf;
}

=head2 S<$h-E<gt>search($pattern)>

This method returns the references of all item objects with an object
identifier that matches the regular expression

=cut

sub search
{ my ($slf, $pat) = @_;
  my (@tbl);

  $pat =~ s/#[imsx]+$//;
  $pat = RDA::Object::View->is_match($pat);

  _search($slf, \@tbl, $pat, exists($slf->{'agt'}));
  return @tbl;
}

sub _search
{ my ($slf, $tbl, $pat, $flg) = @_;
  my ($nam);

  # Examine the object
  push(@{$tbl}, $slf)
    unless $slf->{'oid'} !~ $pat || $flg;  ## no critic (Unless)

  # Examine subobjects
  foreach my $key (sort keys(%{$slf->{'chl'}}))
  { _search($slf->{'chl'}->{$key}, $tbl, $pat);
  }
  return;
}

=head2 S<$h-E<gt>transfer($source[,$pattern])>

This method transfers all properties of the source object in the current
object. It ignores properties whose name matches the regular expression
provided as a second argument. It returns the object reference.

=cut

sub transfer
{ my ($slf, $src, $pat) = @_;
  my ($val);

  if ($src)
  { $pat = q{^$} unless defined($pat);;
    _decode_attr($src, 'dsc');
    foreach my $key (keys(%{$src->{'cur'}}))
    { next unless $key !~ $pat  ## no critic (Unless)
               && defined($val = $src->{'cur'}->{$key});
      delete($slf->{'old'}->{$key});
      $slf->{'cur'}->{$key} = $val;
      $slf->{'dsc'}->{$key} = $src->{'dsc'}->{$key}
        if exists($src->{'dsc'}->{$key});
      $slf->{'raw'}->{$key} = 1
        if exists($src->{'raw'}->{$key});
    }
  }
  return $slf;
}

=head1 ITEM MANAGEMENT METHODS

=head2 S<$h-E<gt>load_content($dir[,defaults])>

It loads the item content from the specified directory, when it exists. You can
specify an array of alternate identifiers as an extra argument. It returns the
top object reference.

=cut

sub load_content
{ my ($slf, $dir, $dft) = @_;
  my ($ifh, $trc);

  $slf = $slf->{'top'};

  # Load the file
  $ifh = IO::File->new;
  $trc = $slf->{'trc'};
  if ($ifh->open('<'.RDA::Object::Rda->cat_file($dir, $slf->{'oid'}.'.cfg')))
  { $slf->{'agt'}->trace(get_string($dft ? 'LoadDefault' : 'LoadContent',
      $slf->{'oid'})) if $trc;  # Text:LoadContent Text:LoadDefault
    $slf->load($ifh);
  }
  elsif (ref($dft) eq 'ARRAY')
  { foreach my $oid (@{$dft})
    { $oid = lc($oid);
      if ($ifh->open('<'.RDA::Object::Rda->cat_file($dir, "$oid.cfg")))
      { $slf->{'agt'}->trace(get_string('LoadDefault', $oid)) if $trc;
        $slf->load($ifh);
        last;
      }
    }
  }

  # Return the object reference
  return $slf;
}

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

This method saves an item tree. It includes all subobjects. It closes the file
handle at save completion. It returns the top object reference.

=cut

sub save
{ my ($slf, $ofh, $top) = @_;
  my ($cur);

  $slf = $slf->{'top'};
  binmode($ofh);
  if ($cur = $slf->find($top))
  { local $^W = 0;
    print {$ofh} "$SEP\n# Oracle Remote Diagnostic Agent - "
      .sprintf($slf->{'ttl'}, $slf->{'oid'})
      ."\n$SEP\n\n";
    _save($ofh, $cur, $top);
  }
  $ofh->close;
  return $slf;
}

sub _save
{ my ($ofh, $slf, $pth) = @_;
  my ($cnt, $str, $val, @tbl);

  # Save the object properties
  $cnt = 0;
  foreach my $key (sort keys(%{$slf->{'cur'}}))
  { if (exists($slf->{'old'}->{$key}))
    { next unless defined($str = $slf->{'old'}->{$key});
    }
    elsif (exists($slf->{'raw'}->{$key}))
    { $str = $slf->{'cur'}->{$key}
    }
    else
    { next unless defined($val = $slf->{'cur'}->{$key});
      $str = encode_value($val);
    }
    next unless !exists($slf->{'tie'}->{$key})  ## no critic (Unless)
      || $slf->{'tie'}->{$key} || _is_valid($slf, $key, \$val);
    print {$ofh} "[$pth]\n" if $cnt++ == 0 && $pth;
    print {$ofh} "$key=$str\n";
  }
  print {$ofh} _encode_attr($slf, 'dsc') if $cnt;

  # Save subobjects
  foreach my $oid (sort keys(%{$slf->{'chl'}}))
  { _save($ofh, $slf->{'chl'}->{$oid}, $pth ? "$pth.$oid" : $oid);
  }
  return;
}

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

  my $ref = ref($val);
  return
    ($ref eq 'ARRAY') ?
      q{(}.join(q{,}, map {encode_value($_)} @{$val}).q{)} :
    ($ref eq 'HASH')  ?
      '{'.join(q{,},
            map {_encode_scalar($_).q{=>}.encode_value($val->{$_})}
                sort keys(%{$val})).'}' :
    _encode_scalar($val);
}

sub _encode_item
{ my ($val) = @_;
  my ($top);

  return q{[}.$val->get_path.q{]};
}

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

  return ref($val) ? _encode_item($val) : RDA::Object::encode($val);
}

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

This method saves the item tree content in the specified directory. It returns
the path to the generated file.

=cut

sub save_content
{ my ($slf, $dir) = @_;
  my ($ofh, $pth, $stk);

  $slf = $slf->{'top'};
  $stk = $slf->{'agt'}->should_align;

  # Save the content
  $ofh = IO::File->new;
  $pth = RDA::Object::Rda->cat_file(
    RDA::Object::Rda->create_dir($dir, $DIR_PERMS, 0, $stk),
    $slf->{'oid'}.'.cfg');
  $ofh->open($pth, $CREATE, $FIL_PERMS)
    or die get_string('ERR_CREATE', $pth, $!);
  $slf->{'agt'}->trace(get_string('SaveContent', $slf->{'oid'}))
    if $slf->{'trc'};
  $slf->save($ofh);
  push(@{$stk}, $pth) if $stk;

  # Return the path to the generated file
  return $pth;
}

=head1 PROPERTY METHODS

The property names start with a type. Valid type prefixes are:

=over 8

=item B<    B_ > Boolean value

=item B<    D_ > Directory

=item B<    F_ > File

=item B<    I_ > Item object

=item B<    K_ > Key list

=item B<    M_ > Module

=item B<    N_ > Number

=item B<    O_ > (Used internally for objects)

=item B<    T_ > Text value

=item B<    V_ > Version

=item B<    W_ > Word

=back

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

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

=cut

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

  @tbl = split(/\./, uc($nam));
  $key = pop(@tbl);
  return (ref($cur = find($slf, \@tbl))
    && exists(_decode_attr($cur, 'dsc')->{$key}))
    ? $cur->{'dsc'}->{$key}
    : $dft;
}

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

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

=over 8

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

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

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

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

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

=item S<    B<'M'>> Indicates whether the property is missing.

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

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

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

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

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

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

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

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

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

=back

=cut

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

  $typ = uc($mod);
  return $slf->clear_temp($nam, $mod eq 'c')         if $typ eq 'C';
  return $slf->get_desc($nam, $dft)                  if $typ eq 'D';
  return $slf->is_defined($nam)                      if $typ eq 'E';
  return $slf->find($nam, $mod eq 'i')               if $typ eq 'I';
  return $slf->get_local($nam, $dft, $mod eq 'l')    if $typ eq 'L';
  return !$slf->is_defined($nam)                     if $typ eq 'M';
  return $slf->get_property($nam, $dft, $mod eq 'p') if $typ eq 'P';
  return $slf->get_text($nam, $dft, $mod eq 't')     if $typ eq 'T';
  return $slf->get_value($nam, $dft, $mod eq 'v')    if $typ eq 'V';
  return encode_value(
    scalar $slf->get_value($nam, $dft, $mod eq 'x')) if $typ eq 'X';
  return;
}

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

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

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

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

=cut

sub get_first
{ return [get_value(@_)]->[0];
}

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

This method returns the value of the given object property and ensures that the
value is a hash reference.

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

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

=cut

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

  die get_string('BAD_REF')
    unless ref($val = $slf->get_value($nam, {}, $flg)) eq 'HASH';
  return $val;
}

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

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

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

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

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

=cut

sub get_local
{ my ($slf, $nam, $dft, $flg) = @_;
  my ($cfg, $key, $val, @tbl);

  $nam = [$nam] unless ref($nam);
  foreach my $itm (@{$nam})
  { @tbl = split(/\./, uc($itm));
    $key = pop(@tbl);
    if (ref($cfg = find($slf, \@tbl)))
    { if (exists($cfg->{'raw'}->{$key}))
      { next unless defined($val = $cfg->{'cur'}->{$key});
        $val = decode_value($slf, \$val, 1);
        if (_is_valid($cfg, $key, \$val, 1))
        { delete($cfg->{'raw'}->{$key});
          $cfg->{'cur'}->{$key} = $val ;
        }
        else
        { next unless $flg;
        }
        $dft = $val;
        last;
      }
      if (exists($cfg->{'cur'}->{$key}))
      { $dft = $cfg->{'cur'}->{$key};
        _is_local($cfg, $key, \$dft);
        last;
      }
    }
  }
  if (wantarray)
  { return @{$dft} if ref($dft) eq 'ARRAY';
    return ($dft) if defined($dft);
    return ();
  }
  return $dft;
}

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

This function returns the list of object property names.

=cut

sub get_names
{ my ($slf) = @_;
  my ($tbl);

  $tbl = $slf->{'cur'};
  return (grep {defined($tbl->{$_})} keys(%{$tbl}));
}

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

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

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

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

=cut

sub get_primary
{ return [get_local(@_)]->[0];
}

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

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

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

=cut

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

  # Search the property
  @tbl = split(/\./, uc($nam));
  $nam = pop(@tbl);
  $slf = find($slf, \@tbl) if @tbl;
  $dft = _get_property($slf, {$slf->get_path, 1}, $nam, $dft, $flg) if $slf;

  # Return the value
  return (ref($dft) eq 'ARRAY') ? $dft->[0] : $dft;
}

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

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

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

=cut

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

  # Search the property
  @tbl = split(/\./, uc($nam));
  $nam = pop(@tbl);
  $slf = find($slf, \@tbl) if @tbl;
  $dft = _get_property($slf, {$slf->get_path, 1}, $nam, $dft, $flg) if $slf;

  # Return the value
  if (wantarray)
  { return @{$dft} if ref($dft) eq 'ARRAY';
    return ($dft)  if defined($dft);
    return ();
  }
  return $dft;
}

sub _get_property
{ my ($slf, $tbl, $nam, $dft, $flg) = @_;
  my ($pth, $val);

  # Look locally for the property
  if (exists($slf->{'raw'}->{$nam}))
  { if (defined($val = $slf->{'cur'}->{$nam}))
    { $val = decode_value($slf, \$val, 1);
      if (_is_valid($slf, $nam, \$val))
      { delete($slf->{'raw'}->{$nam});
        return $slf->{'cur'}->{$nam} = $val ;
      }
      return $val if $flg
    }
  }
  elsif (exists($slf->{'cur'}->{$nam}))
  { return $slf->{'cur'}->{$nam};
  }

  # Analyze the item properties
  foreach my $key (sort grep {m/^I_/} keys(%{$slf->{'cur'}}))
  { foreach my $itm ($slf->get_value($key))
    { next if exists($tbl->{$pth = $itm->get_path});
      $tbl->{$pth} = 1;
      return $val if defined($val = _get_property($itm, $tbl, $nam));
    }
  }

  # Return the default value
  return $dft;
}

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

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

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

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

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

=cut

sub get_text
{ my ($slf, $nam, $dft, $flg) = @_;
  my ($cfg, $key, $ref, $typ, $val, @tbl);

  # Get the value
  $nam = [$nam] unless ref($nam);
  foreach my $itm (@{$nam})
  { @tbl = split(/\./, uc($itm));
    $key = pop(@tbl);
    $typ = substr($key, 0, 1);
    if (ref($cfg = find($slf, \@tbl)))
    { if (exists($cfg->{'raw'}->{$key}))
      { next unless defined($val = $cfg->{'cur'}->{$key});
        $val = decode_value($slf, \$val, 1);
        if (_is_valid($cfg, $key, \$val))
        { delete($cfg->{'raw'}->{$key});
          $cfg->{'cur'}->{$key} = $val ;
        }
        else
        { next unless $flg;
        }
        $dft = $val;
        last;
      }
      if (exists($cfg->{'cur'}->{$key}))
      { $dft = $cfg->{'cur'}->{$key};
        last;
      }
    }
  }

  # Transform the value
  $dft = _apply($tb_fmt{$typ}, $dft) if exists($tb_fmt{$typ});

  # Return the value
  if (wantarray)
  { return @{$dft} if ref($dft) eq 'ARRAY';
    return ($dft)  if defined($dft);
    return ();
  }
  return $dft;
}

sub _apply
{ my ($fct, $val) = @_;
  my ($ref);

  $ref = ref($val);
  return
    ($ref eq 'ARRAY') ? [map {_apply($fct, $_)} @{$val}] :
    ($ref eq 'HASH')  ? {map {$_ => _apply($fct, $val->{$_})} keys(%{$val})} :
    defined($val)     ? &$fct($val) :
                        undef;
}

sub _fmt_boolean
{ return get_string((shift) ? 'True' : 'False');  # Text:False Text:True
}

sub _fmt_gmttime
{ return RDA::Object::Rda->get_gmtime(shift);
}

sub _fmt_item
{ return shift->as_string
}

sub _fmt_real
{ my ($str);

  $str = sprintf('%f', shift);
  $str =~ s/(\.\d+?)0+$/$1/;
  return $str;
}

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

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

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

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

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

=cut

sub get_value
{ my ($slf, $nam, $dft, $flg) = @_;
  my ($cfg, $key, $val, @tbl);

  $nam = [$nam] unless ref($nam);
  foreach my $itm (@{$nam})
  { @tbl = split(/\./, uc($itm));
    $key = pop(@tbl);
    if (ref($cfg = find($slf, \@tbl)))
    { if (exists($cfg->{'raw'}->{$key}))
      { next unless defined($val = $cfg->{'cur'}->{$key});
        $val = decode_value($slf, \$val, 1);
        if (_is_valid($cfg, $key, \$val))
        { delete($cfg->{'raw'}->{$key});
          $cfg->{'cur'}->{$key} = $val ;
        }
        else
        { next unless $flg;
        }
        $dft = $val;
        last;
      }
      if (exists($cfg->{'cur'}->{$key}))
      { $dft = $cfg->{'cur'}->{$key};
        last;
      }
    }
  }
  if (wantarray)
  { return @{$dft} if ref($dft) eq 'ARRAY';
    return ($dft)  if defined($dft);
    return ();
  }
  return $dft;
}

=head2 S<$h-E<gt>grep($pattern,$options)>

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

=over 9

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

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

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

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

=item B<    'w' > Returns references of items where a match is found.

=back

=cut

sub grep  ## no critic (Builtin)
{ my ($slf, $pat, $opt) = @_;
  my ($inv, $itm, $obj, $one, $rec, @tbl);

  # Determine the pattern
  $pat =~ s/#[imsx]+$//;
  $pat = RDA::Object::View->is_match($pat);

  # Determine the options
  $opt = q{} unless defined($opt);
  $one = index($opt, 'f') >= 0;
  $itm = index($opt, 'w') >= 0;
  $obj = index($opt, 'o') >= 0 || $itm;
  $inv = index($opt, 'v') >= 0;
  $rec = index($opt, 'r') >= 0;

  # Return the grep results
  _grep($slf, \@tbl, $pat, q{}, $inv, $itm, $obj, $one, $rec);
  return @tbl;
}

sub _grep  ## no critic (Args)
{ my ($slf, $tbl, $pat, $nam, $inv, $itm, $obj, $one, $rec) = @_;
  my ($flg);

  # Scan the object property names
  foreach my $key (sort keys(%{$slf->{'cur'}}))
  { $flg = ($key =~ $pat);
    if ($inv ? !$flg : $flg)
    { push(@{$tbl}, $itm ? $slf : $obj ? substr($nam, 0, -1) : $nam.$key);
      return 1 if $one;
      last if $obj;
    }
  }

  # Look in subobjects
  if ($rec)
  { foreach my $oid (sort keys(%{$slf->{'chl'}}))
    { return 1 if _grep($slf->{'chl'}->{$oid}, $tbl, $pat, "$nam$oid.",
        $inv, $itm, $obj, $one, $rec);
    }
  }

  # Continue the search
  return 0;
}

=head2 S<$h-E<gt>is_defined($name,...)>

This method indicates if one of the specified object property is defined.

=cut

sub is_defined
{ my ($slf, @nam) = @_;
  my ($cur, $key, @tbl);

  foreach my $nam (@nam)
  { @tbl = split(/\./, uc($nam));
    $key = pop(@tbl);
    return ref($cur->{'cur'}->{$key}) || 'SCALAR'
      if defined($cur = $slf->find(\@tbl))
      && exists($cur->{'cur'}->{$key})
      && defined($cur->{'cur'}->{$key});
  }
  return q{};
}

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

This method indicates whether a description text is missing for an existing
object property. When a text is provided, it uses it for resolving a missing
description.

=cut

sub needs_desc
{ my ($slf, $nam, $txt) = @_;
  my ($cur, $key, $old, @tbl);

  if ($nam)
  { @tbl = split(/\./, uc($nam));
    $key = pop(@tbl);
    if (ref($cur = $slf->find(\@tbl))
      && exists($cur->{'cur'}->{$key})
      && !exists(_decode_attr($cur, 'dsc')->{$key}))
    { return 1 unless defined($txt);
      $cur->{'dsc'}->{$key} = $txt ;
      $cur->{'log'}->{$key} |= $B_DSC  ## no critic (Bit)
        if exists($cur->{'log'});
    }
  }
  return 0;
}

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

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

=cut

sub set_desc
{ my ($slf, $nam, $txt) = @_;
  my ($cur, $key, $old, @tbl);

  if ($nam)
  { @tbl = split(/\./, uc($nam));
    $key = pop(@tbl);
    die get_string('BAD_PROPERTY', $nam)
      unless ref($cur = $slf->find(\@tbl)) && exists($cur->{'cur'}->{$key});
    $old = delete(_decode_attr($cur, 'dsc')->{$key});
    $cur->{'dsc'}->{$key} = $txt if defined($txt);
    $cur->{'log'}->{$key} |= $B_DSC  ## no critic (Bit)
      if exists($cur->{'log'});
  }
  return $old;
}

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

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

=over 8

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

=item S<    B<'E'>> Sets an encoded value using C<set_temp>.

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

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

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

=back

=cut

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

  return $slf->set_desc($nam, $val)         if $mod eq 'D';
  return $slf->edit_temp($nam, $val)        if $mod eq 'E';
  return $slf->set_raw($nam, $val, $dsc)    if $mod eq 'R';
  return $slf->set_temp($nam, $val)         if $mod eq 'T';
  return $slf->set_value($nam, $val, $dsc)  if $mod eq 'V';
  return $slf->edit_value($nam, $val, $dsc) if $mod eq 'X';
  return;
}

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

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

It returns the previous value. When the object property is not defined, it
returns an undefined value.

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

=cut

sub set_raw
{ my ($slf, $nam, $val, $dsc) = @_;
  my ($cur, $flg, $key, $old, $raw, @tbl);

  if ($nam)
  { @tbl = split(/\./, uc($nam));
    $key = pop(@tbl);
    die get_string('BAD_NAME', $nam) unless $key =~ m/^[A-Z]_/;
    if (defined($val))
    { $cur = $slf->find(\@tbl, 1);
      $old = $cur->{'cur'}->{$key};
      $raw = $cur->{'raw'}->{$key};
      $cur->{'cur'}->{$key} = encode_value($val);
      $cur->{'raw'}->{$key} = 1;
      $cur->{'log'}->{$key} |= $B_VAL  ## no critic (Bit)
        if exists($cur->{'log'});
      if (defined($dsc))
      { _decode_attr($cur, 'dsc')->{$key} = $dsc;
        $cur->{'log'}->{$key} |= $B_DSC  ## no critic (Bit)
          if exists($cur->{'log'});
      }
      delete($cur->{'old'}->{$key});
      delete($cur->{'tie'}->{$key});
    }
    elsif (defined($cur = $slf->find(\@tbl)))
    { $old = delete($cur->{'cur'}->{$key});
      $raw = delete($cur->{'raw'}->{$key});
      $cur->{'log'}->{$key} |= $B_VAL  ## no critic (Bit)
        if exists($cur->{'log'});
      delete(_decode_attr($cur, 'dsc')->{$key});
      delete($cur->{'old'}->{$key});
      delete($cur->{'tie'}->{$key});
    }
    else
    { return;
    }
    if ($raw && defined(wantarray))
    { $old = decode_value($slf, \$old, 1);
      $old = undef unless _is_valid($cur, $key, \$old);
    }
  }
  if (wantarray)
  { return @{$old} if ref($old) eq 'ARRAY';
    return ($old)  if defined($old);
    return ();
  }
  return $old;
}

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

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

It returns the previous value. When the object property is not defined, it
returns an undefined value.

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

=cut

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

  return set_value($slf, $key, decode_value($slf, \$val, 1), $dsc);
}

sub set_value
{ my ($slf, $nam, $val, $dsc) = @_;
  my ($cur, $flg, $key, $old, @tbl);

  if ($nam)
  { @tbl = split(/\./, uc($nam));
    $key = pop(@tbl);
    die get_string('BAD_NAME', $nam) unless $key =~ m/^[A-Z]_/;
    if (defined($val))
    { if (ref($val) =~ $REF)
      { $flg = 1;
      }
      else
      { $val = [$val];
      }
      $cur = $slf->find(\@tbl, 1);
      die get_string('BAD_VALUE', $nam, encode_value($val))
        unless _is_valid($cur, $key, \$val);
      $old = $cur->{'cur'}->{$key};
      $cur->{'cur'}->{$key} = $flg ? $val : $val->[0];
      $cur->{'log'}->{$key} |= $B_VAL  ## no critic (Bit)
        if exists($cur->{'log'});
      if (defined($dsc))
      { _decode_attr($cur, 'dsc')->{$key} = $dsc;
        $cur->{'log'}->{$key} |= $B_DSC  ## no critic (Bit)
          if exists($cur->{'log'});
      }
      delete($cur->{'old'}->{$key});
      delete($cur->{'tie'}->{$key});
    }
    elsif (defined($cur = $slf->find(\@tbl)))
    { $old = delete($cur->{'cur'}->{$key});
      $cur->{'log'}->{$key} |= $B_VAL  ## no critic (Bit)
        if exists($cur->{'log'});
      delete(_decode_attr($cur, 'dsc')->{$key});
      delete($cur->{'old'}->{$key});
      delete($cur->{'tie'}->{$key});
    }
    else
    { return;
    }
    if (delete($cur->{'raw'}->{$key}) && defined(wantarray))
    { $old = decode_value($slf, \$old, 1);
      $old = undef unless _is_valid($cur, $key, \$old);
    }
  }
  if (wantarray)
  { return @{$old} if ref($old) eq 'ARRAY';
    return ($old)  if defined($old);
    return ();
  }
  return $old;
}

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

This method returns the value of the given object property without
transformation. When the property does not exist or when the existing value has
a different type from the default value, it assigns the default value to it.

=cut

sub tie_value
{ my ($slf, $nam, $dft, $raw) = @_;
  my ($cur, $key, $ref, $val, @tbl);

  if ($nam)
  { @tbl = split(/\./, uc($nam));
    $key = pop(@tbl);
    die get_string('BAD_NAME', $nam) unless $key =~ m/^[A-Z]_/;
    if (ref($cur = find($slf, \@tbl, defined($dft))))
    { if (delete($cur->{'raw'}->{$key}))
      { $val = delete($cur->{'cur'}->{$key});
        $val = decode_value($slf, \$val, 1);
        return _tie_value($cur, $key, $cur->{'cur'}->{$key} = $val, $dft, $raw)
          if $raw || _is_valid($cur, $key, \$val);
      }
      elsif (exists($cur->{'cur'}->{$key}) && defined($cur->{'cur'}->{$key}))
      { return _tie_value($cur, $key, $cur->{'cur'}->{$key}, $dft, $raw);
      }
      if (defined($dft))
      { die get_string('BAD_VALUE', $nam, encode_value($dft))
          unless $raw || _is_valid($cur, $key, \$dft);
        $cur->{'cur'}->{$key} = $dft;
        $cur->{'tie'}->{$key} = $raw if ref($dft);
        delete($cur->{'old'}->{$key});
      }
    }
  }
  return $dft;
}

sub _tie_value
{ my ($slf, $key, $val, $dft, $raw) = @_;
  my ($ref);

  if (($ref = ref($dft)) && ref($val) ne $ref)
  { die get_string('BAD_REF') unless $ref =~ $REF;
    $slf->{'cur'}->{$key} = $val = $dft;
    $slf->{'tie'}->{$key} = $raw;
  }
  elsif (ref($val) =~ $REF)
  { $slf->{'tie'}->{$key} = $raw;
  }
  delete($slf->{'old'}->{$key});
  return $val;
}

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

This method unties the value of the given object property.

=cut

sub untie_value
{ my ($slf, $nam) = @_;
  my ($cur, $key, $val, @tbl);

  if ($nam)
  { @tbl = split(/\./, uc($nam));
    $key = pop(@tbl);
    die get_string('BAD_NAME', $nam) unless $key =~ m/^[A-Z]_/;
    if (ref($cur = find($slf, \@tbl)) && exists($cur->{'tie'}->{$key}))
    { return $slf->clear_temp($nam)
        if exists($slf->{'old'}->{$key});
      if (defined($val = $slf->{'cur'}->{$key}))
      { die get_string('BAD_VALUE', $nam, encode_value($val))
          unless $cur->{'tie'}->{$key} || _is_valid($slf, $key, \$val);
        $slf->{'cur'}->{$key} = encode_value($val);
        $slf->{'raw'}->{$key} = 1;
      }
      delete($cur->{'tie'}->{$key});
    }
  }
  return;
}

=head2 S<RDA::Object::Item-E<gt>validate($name,$value)>

This method indicates if the specified value is acceptable for an object
property. It returns an error message in case of problems, otherwise, it
returns an empty string.

=cut

sub validate
{ my ($slf, $nam, $val, $flg) = @_;
  my ($key, @tbl);

  # Identify the object property
  return q{} unless $nam;
  @tbl = split(/\./, uc($nam));
  $key = pop(@tbl);
  return get_string('BAD_NAME', $nam) unless $key =~ m/^[A-Z]_/;

  # Validate the key/value combination
  return _is_valid($slf, $key, \$val, $flg)
    ? q{}
    : get_string('BAD_VALUE', $nam, encode_value($val));
}

=head1 TEMPORARY PROPERTY VALUE MANAGEMENT METHODS

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

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

=cut

sub clear_temp
{ my ($slf, $nam, $flg) = @_;
  my ($cur, $key, $old, @tbl);

  # Restore the original setting value
  if ($nam)
  { @tbl = split(/\./, uc($nam));
    $key = pop(@tbl);
    die get_string('BAD_NAME', $nam) unless $key =~ m/^[A-Z]_/;
    if (defined($cur = $slf->find(\@tbl)))
    { if (exists($cur->{'old'}->{$key}))
      { if (defined($old = delete($cur->{'old'}->{$key})))
        { $cur->{'cur'}->{$key} = $old;
          $cur->{'raw'}->{$key} = 1;
          if (defined(wantarray))
          { $old = decode_value($slf, \$old, 1);
            $old = undef unless _is_valid($cur, $key, \$old);
          }
        }
        else
        { delete($cur->{'cur'}->{$key});
          delete($cur->{'raw'}->{$key});
          delete(_decode_attr($cur, 'dsc')->{$key});
        }
        delete($cur->{'tie'}->{$key});
      }
      elsif (defined(wantarray))
      { if (exists($cur->{'raw'}->{$key}))
        { $old = $cur->{'cur'}->{$key};
          $old = decode_value($slf, \$old, 1);
          $old = undef unless _is_valid($cur, $key, \$old);
        }
        elsif (exists($cur->{'cur'}->{$key}))
        { $old = $cur->{'cur'}->{$key};
        }
      }
    }
  }

  # Return the previous value
  if (wantarray)
  { return @{$old} if ref($old) eq 'ARRAY';
    return ($old)  if defined($old);
    return ();
  }
  return $old;
}

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

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

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

=cut

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

  return set_temp($slf, $key, decode_value($slf, \$val, 1));
}

sub set_temp  ## no critic (Complex)
{ my ($slf, $nam, $val, $raw) = @_;
  my ($cur, $flg, $key, $old, @tbl);

  if ($nam)
  { @tbl = split(/\./, uc($nam));
    $key = pop(@tbl);
    die get_string('BAD_NAME', $nam) unless $key =~ m/^[A-Z]_/;
    if (defined($val))
    { $cur = $slf->find(\@tbl, 1);
      $old =
        delete($cur->{'raw'}->{$key}) ? $cur->{'cur'}->{$key} :
        exists($cur->{'cur'}->{$key}) ? encode_value($cur->{'cur'}->{$key}) :
                                        undef;
      if ($raw)
      { $cur->{'cur'}->{$key} = encode_value($val);
        $cur->{'raw'}->{$key} = 1;
      }
      else
      { if (ref($val) =~ $REF)
        { $flg = 1;
        }
        else
        { $val = [$val];
        }
        die get_string('BAD_VALUE', $nam, encode_value($val))
          unless _is_valid($cur, $key, \$val);
        $cur->{'cur'}->{$key} = $flg ? $val : $val->[0];
      }
    }
    elsif (defined($cur = $slf->find(\@tbl)))
    { $old =
        exists($cur->{'raw'}->{$key}) ? $cur->{'cur'}->{$key} :
        exists($cur->{'cur'}->{$key}) ? encode_value($cur->{'cur'}->{$key}) :
                                        undef;
      $cur->{'cur'}->{$key} = undef;
      $cur->{'raw'}->{$key} = 1;
    }
    else
    { return;
    }
    $cur->{'old'}->{$key} = $old unless exists($cur->{'old'}->{$key});
    if (defined(wantarray) && defined($old))
    { $old = decode_value($slf, \$old, 1);
      $old = undef unless _is_valid($cur, $key, \$old);
    }
  }
  if (wantarray)
  { return @{$old} if ref($old) eq 'ARRAY';
    return ($old)  if defined($old);
    return ();
  }
  return $old;
}

# -- Attribute routines -------------------------------------------------------

sub _decode_attr
{ my ($slf, $key) = @_;
  my ($dsc, $tbl);

  # Return existing description hash
  return $dsc if ref($dsc = $slf->{$key}) eq 'HASH';

  # Decode the description hash
  $tbl = {};
  unless ($dsc =~ m/^\175/)
  { for (;;)  ## no critic (Loop)
    { $tbl->{$1} = RDA::Object::decode($2)
        if $dsc =~ s/^(\w+)=>"(.*?)"//;
      last unless $dsc =~ s/^,\s*//;
    }
  }
  return $slf->{$key} = $tbl;
}

sub _encode_attr
{ my ($slf) = @_;
  my ($dsc, @tbl);

  if (!ref($dsc = $slf->{'dsc'}))
  { $dsc =~ s/",/",\\\n /g;
    return "?=\173".$dsc.qq{\n\n};
  }
  elsif (@tbl = keys(%{$dsc}))
  { return "?=\173".join(",\\\n   ",
      map {$_.q{=>}._encode_scalar($dsc->{$_})} sort @tbl)."\175\n\n"
  }
  return qq{\n};
}

# -- Validation routines ------------------------------------------------------

sub _is_local
{ my ($cur, $key, $val) = @_;
  my ($ref, $typ);

  if (exists($tb_cnv{$typ = substr($key, 0, 1)}))
  { $ref = ref($$val);
    if ($ref eq 'ARRAY')
    { _valid_array($cur, $key, $tb_cnv{$typ}, $$val, {});
    }
    elsif ($ref eq 'HASH')
    { _valid_hash($cur, $key, $tb_cnv{$typ}, $$val, {});
    }
    elsif (defined($val))
    { &{$tb_cnv{$typ}}($val, $cur);
    }
  }
  return;
}

sub _is_valid
{ my ($cur, $key, $val, $flg) = @_;
  my ($ref, $tbl, $typ);

  $tbl = $flg ? \%tb_loc : \%tb_val;
  $typ = substr($key, 0, 1);
  if (exists($tbl->{$typ}))
  { $ref = ref($$val);
    if ($ref eq 'ARRAY')
    { return 0 unless _valid_array($cur, $key, $tbl->{$typ}, $$val, {});
    }
    elsif ($ref eq 'HASH')
    { return 0 unless _valid_hash($cur, $key, $tbl->{$typ}, $$val, {});
    }
    elsif (defined($val))
    { return 0 if &{$tbl->{$typ}}($val, $cur);
    }
  }
  return 1;
}

sub _valid_array
{ my ($cur, $key, $fct, $ptr, $tbl) = @_;
  my ($ref);

  $tbl->{$ptr} = 0;
  foreach my $val (@{$ptr})
  { if ($ref = ref($val))
    { die get_string('BAD_LOOP', $key) if exists($tbl->{$val});
      if ($ref eq 'ARRAY')
      { return 0 unless _valid_array($cur, $key, $fct, $val, $tbl);
      }
      elsif ($ref eq 'HASH')
      { return 0 unless _valid_hash($cur, $key, $fct, $val, $tbl);
      }
    }
    elsif (defined($val))
    { return 0 if &$fct(\$val, $cur);
    }
  }
  delete($tbl->{$ptr});
  return 1;
}

sub _valid_hash
{ my ($cur, $key, $fct, $ptr, $tbl) = @_;
  my ($ref);

  $tbl->{$ptr} = 0;
  foreach my $val (values(%{$ptr}))
  { if ($ref = ref($val))
    { die get_string('BAD_LOOP', $key) if exists($tbl->{$val});
      if ($ref eq 'ARRAY')
      { return 0 unless _valid_array($cur, $key, $fct, $val, $tbl);
      }
      elsif ($ref eq 'HASH')
      { return 0 unless _valid_hash($cur, $key, $fct, $val, $tbl);
      }
    }
    elsif (defined($val))
    { return 0 if &$fct(\$val, $cur);
    }
  }
  delete($tbl->{$ptr});
  return 1;
}

# Normalize a Boolean value (B)
sub _val_boolean
{ my ($val) = @_;

  if ($$val =~ m/\s*y(es)?/i)
  { $$val = 1;
  }
  elsif ($$val =~ m/\s*n(o)?/i)
  { $$val = 0;
  }
  else
  { $$val = $$val ? 1 : 0;
  }
  return 0;
}

# Validate a directory (D)
sub _val_directory
{ my ($val) = @_;

  return 1 unless defined($$val) && length($$val);
  return ! -d ($$val = RDA::Object::Rda->clean_native([$$val, q{}]));
}

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

  return 1 unless defined($$val) && length($$val);
  return ! -d ($$val = RDA::Object::Rda->clean_path([$$val, q{}]));
}

# Validate a file (F)
sub _val_file
{ my ($val) = @_;

  return 1 unless defined($$val) && length($$val);
  return ! -f ($$val = RDA::Object::Rda->clean_native($$val));
}

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

  return 1 unless defined($$val) && length($$val);
  return ! -f ($$val = RDA::Object::Rda->clean_path($$val));
}

# Validate a GMT time stamp (G)
sub _val_gmt_time
{ my ($val) = @_;

  return 1 unless $$val =~ m/^\s*(\d+(?:\.\d+)?)\s*$/;
  $$val = $1;
  return 0;
}

# Validate a key list (K)
sub _val_keylist
{ my ($val) = @_;

  return 1 if ref($$val) || $$val !~ m/^\s*((?:\w+\.)*\w+)\s*$/;
  $$val = $1;
  return 0;
}

# Validate an item object (I)
sub _val_item
{ my ($val, $cur) = @_;
  my ($ref, $top);

  if ($ref = ref($$val))
  { return 1 unless $ref eq $ITM;
  }
  else
  { return 1 unless $$val =~ m/^\133(?:(\w+)\/)?((?:\w+\.)*\w+)\135$/;
    return 0 unless ref($cur) eq $ITM;
    $$val = _decode_item($cur, $2, $1);
  }
  $top = $$val->{'top'};
  return $top != $cur->{'top'};
}

# Validate a module name (M)
sub _val_module
{ my ($val) = @_;

  return 1
    if ref($$val)
    || $$val !~ m/^\s*((?:[A-Za-z]+:)*[A-Za-z][A-Za-z\d]*)(?:\-\w+)*\s*$/;
  $$val = $1;
  return 0;
}

# Normalize and validate an unsigned integer number (N)
sub _val_number
{ my ($val) = @_;

  return 1 unless $$val =~ m/^\s*(\d+)\s*$/;
  $$val = $1 + 0;
  return 0;
}

# Normalize and validate a real number (R)
sub _val_real
{ my ($val) = @_;

  return 1
    unless $$val =~ m/^\s*(([-+])?(\d+(\.\d*)?|\.\d+)([eE][\+\-]?\d+)?)\s*$/;
  $$val = $1 + 0;
  return 0;
}

# Validate a status (S)
sub _val_status
{ my ($val) = @_;

  return 1 unless exists($tb_sta{$$val});
  $$val = $tb_sta{$$val};
  return 0;
}

# Validate a text value (T)
sub _val_text
{ my ($val) = @_;

  return ref($$val);
}

# Validate a version (V)
sub _val_version
{ my ($val) = @_;

  return 1 unless $$val =~ m/^\s*(\d+(\.\d+)+)\s*$/;
  $$val = $1;
  return 0;
}

# Validate a word (W)
sub _val_word
{ my ($val) = @_;

  return 1 if ref($$val) || $$val !~ m/^\s*(\w*)\s*$/;
  $$val = $1;
  return 0;
}

1;

__END__

=head1 SEE ALSO

L<RDA::Agent|RDA::Agent>,
L<RDA::Handle::Data|RDA::Handle::Data>,
L<RDA::Object|RDA::Object>,
L<RDA::Object::Rda|RDA::Object::Rda>,
L<RDA::Object::View|RDA::Object::View>,
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