# Variable.pm: Class Used for Managing RDA Variables

package RDA::Value::Variable;

# $Id: Variable.pm,v 1.6 2013/11/22 11:35:03 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/Value/Variable.pm,v 1.6 2013/11/22 11:35:03 RDA Exp $
#
# Change History
# 20131021  MSC  Make code more strict.

=head1 NAME

RDA::Value::Variable - Class Used for Managing RDA Variables

=head1 SYNOPSIS

 require RDA::Value::Variable;

=head1 DESCRIPTION

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

The following methods are available:

=cut

use strict;

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

# Define the global private variables
use vars qw($STRINGS $VERSION @ISA);
$VERSION = sprintf('%d.%02d', q$Revision: 1.6 $ =~ /(\d+)\.(\d+)/);
@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::Variable-E<gt>new($ctx,$nam)>

The object constructor. It takes the execution context reference and the
variable name as extra arguments.

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

=over 12

=item S<    B<'ctx' > > Reference to the execution context

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

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

=back

=cut

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

  # Create the variable value object and return its reference
  return bless {
    ctx => $ctx,
    nam => $nam,
    var => substr($nam, 0, 1),
    }, ref($cls) || $cls;
}

=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, $txt) = @_;

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

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

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

  return q{  } x $lvl.$txt.'Variable='.$slf->{'nam'};
}

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

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

=cut

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

=head1 ASSIGN AND EVAL METHODS

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

This method deletes a variable and returns its previous content.

=cut

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

  return $slf->{'ctx'}->delete_variable($slf->{'nam'}, $flg);
}

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

This method resolves a variable. When the flag is set, it executes code values.

=cut

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

  return defined($val = $slf->{'ctx'}->get_value($slf->{'nam'}))
    ? $val->eval_value($flg)
    : $VAL_UNDEF;
}

# --- Assign mechanim ---------------------------------------------------------

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

  $typ = $slf->{'var'};
  $slf->{'ctx'}->set_value($slf->{'nam'},
    ($typ eq q{@}) ? RDA::Value::List->new(splice(@{$tbl}, 0)) :
    ($typ eq q{%}) ? RDA::Value::Hash::new_from_list($tbl) :
                     shift(@{$tbl}) || $VAL_UNDEF);
  return;
}

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

  # Treat an incrementation
  return $slf->{'ctx'}->incr_value($slf->{'nam'}, $val) if $flg;

  # Treat an assignment
  $typ = $slf->{'var'};
  if ($typ eq q{$})
  { $slf->{'ctx'}->set_value($slf->{'nam'}, $val->is_list
      ? RDA::Value::Scalar->new('N', (scalar @{$val}))
      : $val);
  }
  elsif ($typ eq q{@})
  { $slf->{'ctx'}->set_value($slf->{'nam'}, $val->is_list
      ? $val
      : RDA::Value::List->new($val));
  }
  elsif ($typ eq q{%})
  { $slf->{'ctx'}->set_value($slf->{'nam'},
      RDA::Value::Hash::new_from_list($val->is_list ? [@{$val}] : [$val]));
  }
  return;
}

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

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

  # Treat a request without creating the variable
  unless ($typ)
  { return ()
      unless ($trc =  $slf->{'ctx'}->get_content($slf->{'nam'}));
    return ($trc->[2]);
  }

  # Get the variable value, creating the variable when needed
  if ($slf->{'var'} eq $typ)
  { $val = $slf->{'ctx'}->get_value($slf->{'nam'}, 1);
    return ($val, [$slf->{'ctx'}, $slf->{'nam'}, $val]);
  }
  if ($slf->{'var'} eq q{$})
  { return ()
      unless ($trc = $slf->{'ctx'}->get_content($slf->{'nam'}, 1, ".$typ"));
    return ($trc->[2], $trc);
  }
  die get_string('INCOMPATIBLE');
}

1;

__END__

=head1 SEE ALSO

L<RDA::Agent|RDA::Agent>,
L<RDA::SDCL::Block|RDA::SDCL::Block>,
L<RDA::SDCL::Context|RDA::SDCL::Context>,
L<RDA::SDCL::Value|RDA::SDCL::Value>,
L<RDA::Text|RDA::Text>,
L<RDA::Value::Hash|RDA::Value::Hash>,
L<RDA::Value::List|RDA::Value::List>,
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