# Assoc.pm: Class Used for Managing Associative Arrays

package RDA::Value::Assoc;

# $Id: Assoc.pm,v 1.8 2014/05/11 18:38:22 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/Value/Assoc.pm,v 1.8 2014/05/11 18:38:22 RDA Exp $
#
# Change History
# 20140511  MSC  Extend the as_data method.

=head1 NAME

RDA::Value::Assoc - Class Used for Managing Associative Arrays

=head1 SYNOPSIS

 require RDA::Value::Assoc;

=head1 DESCRIPTION

The objects of the C<RDA::Value::Assoc> class are be used for storing
associative arrays.

The following methods are available:

=cut

use strict;

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

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

# Define the global private constants

# Define the global private variables

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

=head2 S<$h = RDA::Value::Assoc-E<gt>new(...)>

The object constructor. You can specify some initial content as arguments.

C<RDA::Value::Assoc> is represented by a blessed array reference.

=cut

sub new
{ my $cls = shift;

  return bless {@_}, ref($cls) || $cls;
}

=head2 S<$h = RDA::Value::Assoc::new_from_data(%hash)>

Alternative object constructor, populating the hash from a Perl hash.

=cut

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

  $slf = bless {}, __PACKAGE__;
  while (($key, $val) = splice(@tbl, 0, 2))
  { $slf->{$key} = RDA::Value::Scalar::new_from_data($val);
  }
  return $slf;
}


=head2 S<$h = RDA::Value::Assoc::new_from_list($ref)>

Alternative object constructor, populating the hash from a RDA list.

=cut

sub new_from_list
{ my ($tbl) = @_;
  my ($slf, $itm, $val);

  $slf = bless {}, __PACKAGE__;
  while ($itm = shift(@{$tbl}))
  { if (ref($itm) eq 'RDA::Value::Assoc')
    { foreach my $key (keys(%{$itm}))
      { $slf->{$key} = $itm->{$key};
      }
    }
    else
    { $slf->{$itm->eval_as_string} =
        defined($val = shift(@{$tbl})) ? $val : $VAL_UNDEF;
    }
  }
  return $slf;
}

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

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

=cut

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

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

  return dump_object($slf, {$slf => 'Hash()'}, $lvl, $txt, $trc, 'Hash(');
}

sub dump_object
{ my ($slf, $tbl, $lvl, $txt, $trc, $arg) = @_;
  my ($buf, $cnt, $pre, $val);

  $pre = q{  } x $lvl++;
  $buf = $pre.$txt.'Hash={';
  $cnt = 0;
  foreach my $key (sort keys(%{$slf}))
  { $buf .= qq{\n};
    $val = $slf->{$key};
    if (exists($tbl->{$val}))
    { $buf .= $pre."  '$key' => ".$tbl->{$val};
    }
    elsif ($arg)
    { $tbl->{$val} = "$arg'$key')";
      $buf .= $val->dump_object($tbl, $lvl, "'$key' => ", $trc, "$arg'$key',");
    }
    else
    { $buf .= $val->dump_object($tbl, $lvl, "'$key' => ", $trc);
    }
    ++$cnt;
  }
  return $cnt ? $buf.qq{\n}.$pre.'}' : $buf.'}';
}

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

This method indicates whether the value is an associative array.

=cut

sub is_hash
{ return 1;
}

=head1 ASSIGN AND EVAL METHODS

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

This method returns a copy of the data structure. When the flag is set, it
evaluates values.

=cut

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

  return RDA::SDCL::Value::copy_hash($src->new, $src, {}, $flg);
}

=head1 CONVERSION METHODS

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

This method converts the value as a list of Perl data structures.

=cut

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

  return (RDA::SDCL::Value::conv_hash({}, $slf, {}, $flg));
}

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

This method converts the value as a Perl scalar.

=cut

sub as_scalar
{ return shift;
}

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

This method returns a string listing all hash keys.

=cut

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

  return join(q{,}, sort keys(%{$slf}));
}

1;

__END__

=head1 SEE ALSO

L<RDA::Agent|RDA::Agent>,
L<RDA::SDCL::Block|RDA::SDCL::Block>,
L<RDA::SDCL::Value|RDA::SDCL::Value>,
L<RDA::Text|RDA::Text>,
L<RDA::Value::Scalar|RDA::Value::Scalar>

=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