# Object.pm: Superclass Used for Implementing Basic RDA Object Methods

package RDA::Object;

# $Id: Object.pm,v 1.20 2015/10/22 02:35:51 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/Object.pm,v 1.20 2015/10/22 02:35:51 RDA Exp $
#
# Change History
# 20151022  MSC  Improve object deletion.

=head1 NAME

RDA::Object - Superclass Used for Implementing Basic RDA Object Methods

=head1 SYNOPSIS

 require RDA::Object;

=head1 DESCRIPTION

The objects of the C<RDA::Object> class regroups the methods common to RDA
objects.

The following methods are available:

=cut

use strict;

BEGIN
{ use Exporter;
  use RDA::Text qw(get_string);
  use RDA::Deleted;
}

# Define the global public variables
use vars qw($DELETE $STRINGS $VERSION @EXPORT_OK @ISA %SDCL);
$DELETE    = 0;
$VERSION   = sprintf('%d.%02d', q$Revision: 1.20 $ =~ /(\d+)\.(\d+)/);
@EXPORT_OK = qw(decode dump dump_caller dump_data dump_obj encode xref);
@ISA       = qw(Exporter);
%SDCL      = (
  met => {
    'as_class'  => {ret => 0},
    'as_string' => {ret => 0},
    'dump'      => {ret => 0},
    'get_oid'   => {ret => 0},
    },
  );

# Define the global private constants
my $OBJ = 'RDA::Object';
my $SEP = qq{ +--------\n};

my $RPT_LST = qq{  \001* };
my $RPT_NXT = qq{.N1\n};
my $RPT_XRF = q{  };

# Define the global private variables
my %tb_ref = (
  ARRAY  => 'ARRAY',
  CODE   => 'sub { ... }',
  GLOB   => 'GLOB',
  HASH   => 'HASH',
  LVALUE => 'HASH',
  REF    => 'REF',
  SCALAR => 'SCALAR',
  );

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

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

The object constructor. It enables you to specify initial attributes at object
creation time.

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

=over 12

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

=item S<    B<'oid' > > Object identified

=item S<    B<'par' > > Optional reference to the parent object

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

=back

=cut

sub new
{ my $cls = shift;

  # Create the object and return its reference
  return bless {@_}, ref($cls) || $cls;
}

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

This method returns the object class.

=cut

sub as_class
{ return ref(shift);
}

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

This method returns the object as a string.

=cut

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

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

=head2 S<RDA::Object::decode($value)>

This method decodes a value.

=cut

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

  $val =~ s/\\([0-3][0-7]{2}|0x[0-9A-Fa-f]{2})/chr(oct($1))/eg;
  return $val;
}

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

This method deletes the object.

=cut

sub delete_object  ## no critic (Unpack)
{ my ($ref, @tbl);

  dump_caller($_[0], 'DELETE') if $DELETE;

  # Delete associated objects
  $ref = ref($_[0]);
  @tbl = eval qq{\@$ref\:\:DELETE};  ## no critic (Eval)
  foreach my $key (@tbl)
  { my $val = delete($_[0]->{$key});
    next unless ($ref = ref($val));
    if ($ref eq 'HASH')
    { foreach my $obj (values(%{$val}))
      { eval {$obj->delete_object if ref($obj) && $obj != $_[0]};
      }
      undef %{$val};
    }
    elsif ($ref eq 'ARRAY')
    { foreach my $obj (@{$val})
      { eval {$obj->delete_object if ref($obj) && $obj != $_[0]};
      }
      undef @{$val};
    }
    elsif ($ref ne 'CODE')
    { eval {$val->delete_object};
    }
  }

  # Mark the object as deleted and delete its content
  eval {
    bless $_[0], 'RDA::Deleted';
    undef %{$_[0]};
    undef $_[0];
    };
  return;
}

sub dump_caller
{ my ($slf, $typ) = @_;
  my ($buf, $lvl, $oid, $ref, @tbl);

  # Determine the object identifier
  $oid = eval{$slf->get_oid};
  $oid = (ref($slf) !~ m/^RDA::/) ? q{?} :
         keys(%{$slf})            ? q{<no oid>} :
                                    q{<DELETED>}
    unless defined($oid);

  # Dump
  $buf = $SEP.q{ | }.$typ.q{ }.$oid.q{ / }.$slf.qq{:\n |\n};
  while (@tbl = caller(++$lvl))
  { $buf .= q{ | }.$tbl[1].q{ at line }.$tbl[2].qq{\n |   }.$tbl[3].qq{\n};
  }
  $buf .= $SEP;
  syswrite($RDA::Text::TRACE, $buf, length($buf));
  return;
}

=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 dump_obj($slf, {@tbl}, $lvl, $txt);
}

sub dump_data
{ my ($slf, $lvl, $txt) = @_;
  my ($buf, $pre, $ref);

  $lvl = 0 unless defined($lvl);
  $buf = $pre = q{  } x $lvl;
  $buf .= $txt if defined($txt);
  $ref = ref($slf);
  if ($ref eq 'ARRAY')
  { $buf .= "[\n";
    $buf .= dump_array($slf, {typ => 'Array'}, $lvl, q{});
    $buf .= "$pre]";
  }
  elsif ($ref eq 'HASH')
  { $buf .= "{\n";
    $buf .= dump_hash($slf, {typ => 'Hash'}, $lvl, q{});
    $buf .= "$pre}";
  }
  elsif ($ref eq 'SCALAR')
  { $buf .= q{\\};
    $buf .= defined(${$slf}) ? _encode(${$slf}) : 'undef';
  }
  elsif ($ref)
  { $buf .= $pre.$ref;
    eval {
      $buf .= q{(}.$slf->as_string.q{)} if $slf->can('as_string');
    };
    $buf .= "(**$slf**)" if $@;
    $buf .= qq{\n};
  }
  elsif (defined($slf))
  {$buf .= _encode($slf);
  }
  else
  { $buf .= 'undef';
  }
  return $buf;
}

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

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

  $pre = q{  } x $lvl;
  $tbl->{'flg'} = 0 unless exists($tbl->{'flg'});
  $tbl->{'typ'} = 'Hash';
  $tbl->{'slf'}->{$slf} = ref($slf).'=Hash()';
  $tbl->{'obj'}->{$OBJ} = 1;
  return $pre.$txt.qq{bless(\173\n}.dump_hash($slf, $tbl, $lvl, q{})
    .$pre.qq{\175, '}.ref($slf).q{')};
}

sub dump_array
{ my ($slf, $tbl, $lvl, $arg) = @_;
  my ($buf, $cnt, $pre, $ref, $typ);

  $pre = q{  } x ++$lvl;
  $buf = q{};
  $cnt = 0;
  $typ = $tbl->{'typ'};
  foreach my $val (@{$slf})
  { $ref = ref($val);
    if ($ref && exists($tbl->{'slf'}->{$val}))
    { $buf .= $pre.$tbl->{'slf'}->{$val}.qq{\n};
    }
    elsif ($ref eq 'ARRAY')
    { $tbl->{'slf'}->{$val} = qq{$ref=$typ($arg$cnt)};
      $buf .= $pre.qq{[\n};
      $buf .= dump_array($val, $tbl, $lvl, qq{$arg$cnt,});
      $buf .= qq{$pre]\n};
    }
    elsif (exists($tbl->{'arr'}->{$ref}))
    { $tbl->{'slf'}->{$val} = qq{$ref=$typ($arg$cnt)};
      $buf .= $pre.qq{bless([\n};
      $buf .= dump_array($val, $tbl, $lvl, qq{$arg$cnt,});
      $buf .= qq{$pre], '$ref')\n};
    }
    elsif ($ref eq 'HASH')
    { $tbl->{'slf'}->{$val} = qq{$ref=$typ($arg$cnt)};
      $buf .= $pre.qq{\173\n};
      $buf .= dump_hash($val, $tbl, $lvl, qq{$arg$cnt,});
      $buf .= qq{$pre\175\n};
    }
    elsif (exists($tbl->{'hsh'}->{$ref}))
    { $tbl->{'slf'}->{$val} = qq{$ref=$typ($arg$cnt)};
      $buf .= $pre.qq{bless(\173\n};
      $buf .= dump_hash($val, $tbl, $lvl, qq{$arg$cnt,});
      $buf .= qq{$pre\175, '$ref')\n};
    }
    elsif (exists($tbl->{'obj'}->{$ref}))
    { $tbl->{'slf'}->{$val} = qq{$ref=$typ($arg$cnt)};
      $buf .= $val->dump($lvl);
      $buf .= qq{\n};
    }
    elsif ($ref eq 'SCALAR')
    { $buf .= $pre.q{\\};
      $buf .= defined(${$val}) ? _encode(${$val}, $tbl->{'flg'}) : 'undef';
      $buf .= qq{\n};
    }
    elsif (exists($tb_ref{$ref}))
    { $buf .= $pre.$tb_ref{$ref}.qq{\n};
    }
    elsif ($ref)
    { $buf .= $pre.$ref;
      eval {
        $buf .= q{(}.$val->as_string.q{)} if $val->can('as_string');
      };
      $buf .= qq{(**$val**)} if $@;
      $buf .= qq{\n};
    }
    elsif (defined($val))
    { $buf .= $pre;
      $buf .= _encode($val, $tbl->{'flg'});
      $buf .= qq{\n};
    }
    else
    { $buf .= $pre.qq{undef\n};
    }
    ++$cnt;
  }
  return $buf;
}

sub dump_hash  ## no critic (Complex)
{ my ($slf, $tbl, $lvl, $arg) = @_;
  my ($buf, $flg, $pre, $ref, $typ, $val);

  $pre = q{  } x ++$lvl;
  $buf = q{};
  $typ = $tbl->{'typ'};
  foreach my $key (sort keys(%{$slf}))
  { $flg = $tbl->{'flg'};
    $tbl->{'flg'} = $tbl->{'mlt'}->{$key} if exists($tbl->{'mlt'}->{$key});
    $ref = ref($val = $slf->{$key});
    if ($ref && exists($tbl->{'str'}->{$key}))
    { if ($ref eq 'ARRAY')
      { $buf .= qq{$pre'$key' => [ ... ]\n};
      }
      elsif ($ref eq 'CODE')
      { $buf .= qq{$pre'$key' => sub \173 ... \175\n};
      }
      elsif ($ref eq 'HASH')
      { $buf .= qq{$pre'$key' => \173 ... \175\n};
      }
      else
      { $buf .= qq{$pre'$key' => }.$val->as_string.qq{\n};
      }
    }
    elsif ($ref && exists($tbl->{'slf'}->{$val}))
    { $buf .= qq{$pre'$key' => }.$tbl->{'slf'}->{$val}.qq{\n};
    }
    elsif ($ref eq 'ARRAY')
    { $tbl->{'slf'}->{$val} = "$ref=$typ($arg'$key')";
      $buf .= "$pre'$key' => [\n";
      $buf .= dump_array($val, $tbl, $lvl, "$arg'$key',");
      $buf .= "$pre]\n";
    }
    elsif (exists($tbl->{'arr'}->{$ref}))
    { $tbl->{'slf'}->{$val} = qq{$ref=$typ($arg'$key')};
      $buf .= qq{$pre'$key' => bless([\n};
      $buf .= dump_array($val, $tbl, $lvl, qq{$arg'$key',});
      $buf .= qq{$pre], '$ref')\n};
    }
    elsif ($ref eq 'HASH')
    { $tbl->{'slf'}->{$val} = qq{$ref=$typ($arg'$key')};
      $buf .= qq{$pre'$key' => \173\n};
      $buf .= dump_hash($val, $tbl, $lvl, qq{$arg'$key',});
      $buf .= qq{$pre\175\n};
    }
    elsif (exists($tbl->{'hsh'}->{$ref}))
    { $tbl->{'slf'}->{$val} = qq{$ref=$typ($arg'$key')};
      $buf .= qq{$pre'$key' => bless(\173\n};
      $buf .= dump_hash($val, $tbl, $lvl, qq{$arg'$key',});
      $buf .= qq{$pre\175, '$ref')\n};
    }
    elsif (exists($tbl->{'obj'}->{$ref}))
    { $tbl->{'slf'}->{$val} = qq{$ref=$typ($arg'$key')};
      $buf .= $val->dump($lvl, qq{'$key' => });
      $buf .= qq{\n};
    }
    elsif ($ref eq 'SCALAR')
    { $buf .= qq{$pre'$key' => \\};
      $buf .= defined(${$val}) ? _encode(${$val}, $tbl->{'flg'}) : 'undef';
      $buf .= qq{\n};
    }
    elsif (exists($tb_ref{$ref}))
    { $buf .= qq{$pre'$key' => }.$tb_ref{$ref}.qq{\n};
    }
    elsif ($ref)
    { $buf .= qq{$pre'$key' => $ref};
      eval {
        $buf .= q{(}.$val->as_string.q{)} if $val->can('as_string');
      };
      $buf .= qq{(**$val**)} if $@;
      $buf .= qq{\n};
    }
    elsif (defined($val))
    { $buf .= qq{$pre'$key' => };
      $buf .= _encode($val, $tbl->{'flg'});
      $buf .= qq{\n};
    }
    else
    { $buf .= qq{$pre'$key' => undef\n};
    }
    $tbl->{'flg'} = $flg;
  }
  return $buf;
}

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

  $val =~ s/([^\012\040\041\043-\176])/sprintf("\\%03o", ord($1))/eg;
  $val =~ s/\012/\\012/g unless $flg;
  return q{"}.$val.q{"}.(__PACKAGE__->is_tainted($val) ? q{ [T]} : q{});
}

=head2 S<RDA::Object::encode($value[,$flag])>

This method encodes a value. When the flag is set, it first removes trailing
spaces, carriage returns and line feeds.

=cut

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

  return q{undef} unless defined($val);
  $val =~ s/[\n\r\s]+$// if $flg;
  $val =~ s/([^\040-\041\043-\133\135-\173\175-\176])/
            sprintf("\\0x\%02X", ord($1))/eg;
  return q{"}.$val.q{"};
}

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

This method is invoked when some references are deleted. By default, it
preserves the object.

=cut

sub free
{ dump_caller($_[0], 'FREE') if $DELETE;
  return;
}

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

This method returns the value of the given object key. If the object key does
not exist, then it returns the default value.

=cut

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

  return exists($slf->{$key})   ? $slf->{$key} :
         exists($slf->{'_inf'}) ? $slf->{'_inf'}->get_info($key, $dft) :
                                  $dft;
}

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

This method returns the trace level.

=cut

sub get_level
{ return shift->{'lvl'};
}

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

This method returns the object identifier.

=cut

sub get_oid
{ return shift->{'oid'};
}

=head2 S<$h-E<gt>get_parent($default)>

This method returns a reference to the parent object when defined. Otherwise,
it returns the default value.

=cut

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

  return (exists($slf->{'par'}) && ref($slf->{'par'})) ? $slf->{'par'} : $dft;
}

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

This method returns the value of a top object attribute or the default value
when the attribute is not defined.

It returns a reference to the top object when no attribute is specified.

=cut

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

  $slf = $slf->{'par'} while exists($slf->{'par'}) && ref($slf->{'par'});
  return !defined($nam)       ? $slf :
         exists($slf->{$nam}) ? $slf->{$nam} :
                                $dft;
}

=head2 S<RDA::Object->is_tainted($data)>

This method indicates whether the specified data is tainted.

=cut

sub is_tainted
{ my (undef, $dat) = @_;
  my ($str);

  return unless defined($dat);
  $str = substr($dat, 0, 0);
  return not eval {eval "1 || $str" || 1};  ## no critic (EVal)
}

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

This method assigns a new value to the given object attribute 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>set_top($key[,$value])>

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

It returns the previous value.

=cut

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

  $slf = $slf->{'par'} while exists($slf->{'par'}) && ref($slf->{'par'});
  if (defined($val))
  { ($slf->{$key}, $val) = ($val, $slf->{$key});
  }
  else
  { $val = delete($slf->{$key});
  }
  return $val;
}

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

This method analyzes the object interface and returns a report.

=cut

sub xref  ## no critic (Complex)
{ my ($slf, $flg) = @_;
  my ($buf, $cls, $def, $tbl, @tbl, %tbl);

  # Get the interface definition
  $cls = ref($slf) || $slf;
  return q{} unless $cls =~ m/^(RDA(::\w+)+)$/;
  eval "require $1";
  $def = {eval "\%$1::SDCL"} unless $@;  ## no critic (Eval)

  # Produce the report
  $buf = _dsp_name(get_string('TtlXref', $cls = $1));
  if (ref($def) eq 'HASH' && keys(%{$def}))
  { $buf .= _dsp_text($RPT_LST, get_string('XrfImplicit',
      join(', ', map {_dsp_link($_)} @{$def->{'dep'}})))
      if exists($def->{'dep'});
    $buf .= _dsp_text($RPT_LST, get_string('XrfClasses',
      join(', ', map {_dsp_link($_)} @{$def->{'det'}})))
      if exists($def->{'det'});
    $buf .= _dsp_text($RPT_LST, get_string('XrfMethods',
      join(', ', map {_dsp_link($_)} @{$def->{'inc'}})))
      if exists($def->{'inc'});
    $buf .= _dsp_text($RPT_LST, get_string('XrfSynonyms',
      join('``, ``', @{$def->{'syn'}})))
      if exists($def->{'syn'});
    $buf .= _dsp_text($RPT_LST, get_string('XrfObject',
      q{$[}.$def->{'top'}.q{]}))  ## no critic (Interpolation)
      if exists($def->{'top'});
    $buf .= _dsp_text($RPT_LST, get_string('XrfNew'))
      if exists($def->{'new'});
    $buf .= _dsp_text($RPT_LST, get_string('XrfPassword'))
      if exists($def->{'pwd'});
    $buf .= _dsp_text($RPT_LST, get_string('XrfTrace', $def->{'trc'}))
      if exists($def->{'trc'});
    $buf .= $RPT_NXT;

    if (exists($def->{'cmd'}))
    { %tbl = ();
      foreach my $nam (sort keys(%{$def->{'cmd'}}))
      { $tbl{$nam} = '\040';  ## no critic (Interpolation)
      }
      $buf .= _dsp_table(get_string('TtlCommands'), \%tbl);
    }

    $tbl = exists($def->{'met'}) ? $def->{'met'} : {};
    _xref_inc($tbl, {$cls => 0}, $def->{'inc'}) if exists($def->{'inc'});
    if (@tbl = keys(%{$tbl}))
    { %tbl = ();
      foreach my $nam (sort @tbl)
      { my ($typ, @arg);

        push(@arg,  $tbl->{$nam}->{'ret'}
          ? get_string('XrfList')
          : get_string('XrfScalar'));
        $typ = exists($tbl->{$nam}->{'evl'}) ? $tbl->{$nam}->{'evl'} : q{};
        push(@arg, get_string('XrfNoCode')) if $typ eq 'C';
        push(@arg, get_string('XrfAsDump')) if $typ eq 'D';
        push(@arg, get_string('XrfAsSdcl')) if $typ eq 'E';
        push(@arg, get_string('XrfAsLine')) if $typ eq 'L';
        push(@arg, get_string('XrfNoEval')) if $typ eq 'N';
        push(@arg, get_string('XrfAddBlk')) if $tbl->{$nam}->{'blk'};
        if (exists($tbl->{$nam}->{'arg'}))
        { foreach my $key (@{$tbl->{$nam}->{'arg'}})
          { push(@arg, get_string('XrfAddArg', $key));
          }
        }
        $tbl{$nam} = join(', ', @arg);
      }
      $buf .= _dsp_table(get_string('TtlMethods'), \%tbl);
      $buf .= _dsp_table(get_string('TtlMissings'),
        {map {$_ => '\040'} sort @tbl})  ## no critic (Interpolation)
        if (@tbl = grep {! $cls->can($_)} keys(%{$tbl}));
    }

    if (exists($def->{'als'}))
    { %tbl = ();
      foreach my $nam (sort keys(%{$tbl = $def->{'als'}}))
      { my ($obj, $met, @arg) = @{$tbl->{$nam}};
        $tbl{$nam} = q{``}.$obj.q{->}.$met.q{(}.join(q{,}, @arg, q{...}).q{)``};
      }
      $buf .= _dsp_table(get_string('TtlAliases'), \%tbl);
    }
  }
  else
  { $buf .= _dsp_text($RPT_XRF, get_string('XrfNoSdcl'), 1)
  }

  # Display the copyright and trademark notices
  $buf .= _dsp_title(get_string('TtlCopyright'))
    ._dsp_text($RPT_XRF, get_string('Copyright'), 1)
    ._dsp_title(get_string('TtlTrademark'))
    ._dsp_text($RPT_XRF, get_string('Trademark'))
    unless $flg;

  # Return the result
  return $buf;
}

sub _xref_inc
{ my ($tbl, $skp, $inc) = @_;
  my ($def, $src);

  foreach my $cls (@{$inc})
  { next if exists($skp->{$cls});
    $skp->{$cls} = 1;
    eval "require $cls";
    next if $@;
    $def = {eval "\%${cls}::SDCL"};  ## no critic (Eval)
    if (exists($def->{'met'}))
    { $src = $def->{'met'};
      foreach my $met (keys(%{$src}))
      { $tbl->{$met} = $src->{$met} unless exists($tbl->{$met});
      }
    }
    _xref_inc($tbl, $skp, $def->{'inc'}) if exists($def->{'inc'});
  }
  return;
}

sub _dsp_link
{ my ($cls) = @_;
  my (@tbl);

  @tbl = split(/::/, $cls);
  return q{!!api:}.join(q{/},@tbl).q{!}.$cls.q{!!};
}

sub _dsp_name
{ my ($ttl) = @_;

  return qq{.R '$ttl'\n};
}

sub _dsp_table
{ my ($ttl, $tbl) = @_;
  my ($buf);

  $buf = ".M 2 '$ttl'\n";
  foreach my $key (sort keys(%{$tbl}))
  { $buf .= "``$key``|".$tbl->{$key}.qq{\n};
  }
  return $buf.qq{\n}.$RPT_NXT;
}

sub _dsp_text
{ my ($pre, $txt, $nxt) = @_;

  $txt =~ s/\n{2,}/\n\\040\n/g;
  $txt =~ s/(\n|\\n)/\n\n.I '$pre'\n/g;
  return qq{.I '$pre'\n$txt\n\n}.($nxt ? qq{.N $nxt\n} : q{});
}

sub _dsp_title
{ my ($ttl) = @_;

  return qq{.T '$ttl'\n};
}

1;

__END__

=head1 SEE ALSO

L<RDA::Agent|RDA::Agent>,
L<RDA::Deleted|RDA::Deleted>,
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