# Operator.pm: Class Used for Managing Value Operators

package RDA::Value::Operator;

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

=head1 NAME

RDA::Value::Operator - Class Used for Managing Value Operators

=head1 SYNOPSIS

 require RDA::Value::Operator;

=head1 DESCRIPTION

The objects of the C<RDA::Value::Operator> class are be used for storing value
operators. They are represented by a blessed hash reference. The following
internal keys are required:

=over 12

=item S<    B<'_del'> > Associated 'delete' routine

=item S<    B<'_fnd'> > Associated 'find' routine

=item S<    B<'_get'> > Associated 'get' routine

=item S<    B<'_lft'> > Left value indicator

=item S<    B<'_set'> > Associated 'set' routine

=item S<    B<'_typ'> > Operator name

=back

The following methods are available:

=cut

use strict;

BEGIN
{ use Exporter;
  use RDA::Text qw(get_string);
  use RDA::SDCL::Value qw($VALUE);
  use RDA::Value::List;
  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.7 $ =~ /(\d+)\.(\d+)/);
@EXPORT_OK = qw(del_error find_error get_error set_error);
@ISA       = qw(RDA::SDCL::Value Exporter);

# Define the global private constants

# Define the global private variables
my $OBJECT = qr/^RDA::Object::[A-Z]\w+$/i;
my $RDA    = qr/^RDA(::[A-Z]\w+){1,2}$/i;
my $VALUE  = qr/^RDA::Value::[A-Z]\w+$/i;

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

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

This method returns a copy of the operator with a merge of both argument lists.

=cut

sub clone
{ my ($src, $val) = @_;
  my ($dst);

  $dst = bless {%{$src}}, ref($src);
  $dst->{'arg'} = RDA::Value::List->new(@{$src->{'arg'}}, @{$val});
  return $dst;
}

=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, {}, $lvl, $txt, $trc);
}

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

  $pre = q{  } x $lvl++;
  $buf = $pre.$txt.'Operator=<'.$slf->{'_typ'}.'>(';
  foreach my $key (sort grep {m/^[a-z]/i} keys(%{$slf}))
  { $ref = ref($val = $slf->{$key});
    $buf .= qq{\n};
    $buf .= ($ref =~ $VALUE) ?
              $val->dump_object($tbl, $lvl, "'$key' => ", $trc) :
            ($ref =~ $OBJECT || ($ref =~ $RDA && $val->can('as_class'))) ?
              $val->dump($lvl, "'$key' => Object=", $trc) :
            $ref ?
              $pre."  '$key' => Object=bless ...,$ref" :
            $pre."  '$key' => '$val'";
  }
  return $buf.qq{\n}.$pre.q{)};
}

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

This method indicates whether it assimilates the value to a macro call or an
object method invocation.

=cut

sub is_call
{ return 1;
}

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

This method indicates whether the value is a list item.

=cut

sub is_item
{ return 0;
}

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

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

=cut

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

  return (ref($slf->{'_lft'}) eq 'CODE')
    ? &{$slf->{'_lft'}}($slf)
    : $slf->{'_lft'};
}

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

This method indicates whether the value is a method invocation.

=cut

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

  return ($slf->{'_typ'} eq '.method.') ? $slf->{'nam'} : q{};
}

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

This method indicates whether the value is an operator.

=cut

sub is_operator
{ return shift->{'_typ'};
}

=head1 ASSIGN AND EVAL METHODS

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

This method deletes a left value and return its previous content.

=cut

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

  ($val, $trc) = &{$slf->{'_del'}}($slf);
  $trc->[0]->trace_value($trc->[1], $trc->[2]) if $trc;
  return $val if defined($val);
  return () if $flg;
  return $VAL_UNDEF;
}

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

This method evaluates a value. It resolves the variables and executes
appropriate macro calls. When there is an evaluation problem, it returns an
undefined value.

When the flag is set, it executes code values.

=cut

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

  return &{$slf->{'_get'}}(@_);
}

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

sub assign_item
{ my $slf = shift;

  return &{$slf->{'_set'}}($slf, 1, @_);
}

sub assign_var
{ my $slf = shift;

  return &{$slf->{'_set'}}($slf, 0, @_);
}

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

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

  return &{$slf->{'_fnd'}}(@_);
}

# --- Error routines ----------------------------------------------------------

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

  die get_string('BAD_DELETE', $slf->{'_typ'});
}

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

  die get_string('BAD_FIND', $slf->{'_typ'});
}

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

  die get_string('BAD_GET', $slf->{'_typ'});
}

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

  die get_string('BAD_ASSIGN', $slf->{'_typ'});
}

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::Array|RDA::Value::Array>,
L<RDA::Value::Assoc|RDA::Value::Assoc>,
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