# Scalar.pm: Class Used for Managing Scalar Operators

package RDA::Operator::Scalar;

# $Id: Scalar.pm,v 1.6 2014/07/18 05:40:39 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/Operator/Scalar.pm,v 1.6 2014/07/18 05:40:39 RDA Exp $
#
# Change History
# 20140718  MSC  Improve the documentation.

=head1 NAME

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

=head1 SYNOPSIS

 require RDA::Operator::Scalar;

=head1 DESCRIPTION

This package regroups the definition of the scalar operators.

The following methods are available:

=cut

use strict;

BEGIN
{ use Exporter;
  use RDA::Text qw(get_string);
  use RDA::Value::Operator qw(del_error find_error get_error set_error);
  use RDA::Value::Scalar qw(:value);
}

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

# Define the global private constants

# Define the global private variables
my %tb_ini = (
  'concat' => \&_ini_concat,
  'decr'   => \&_ini_decr,
  'incr'   => \&_ini_incr,
  );

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

=head2 S<$h = RDA::Operator::Value-E<gt>load($tbl)>

This method loads the operator definition in the operator table.

=cut

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

  foreach my $nam (keys(%tb_ini))
  { $tbl->{$nam} = $tb_ini{$nam};
  }
  return;
}

=head1 VALUE RELATED OPERATORS

=head2 S<concat($str,...)>

This operator concatenates all text strings specified as arguments into a new
text string. It ignores invalid arguments.

=cut

sub _ini_concat
{ my (undef, $nam, $arg) = @_;

  # Create the operator
  return bless {
    arg  => $arg,
    _del => \&del_error,
    _fnd => \&find_error,
    _get => \&_get_concat,
    _lft => q{},
    _set => \&set_error,
    _typ => $nam,
    }, 'RDA::Value::Operator';
}

sub _get_concat
{ return RDA::Value::Scalar::new_text(join(q{}, grep {defined($_) && !ref($_)}
    shift->{'arg'}->eval_as_array));
}

=head2 S<decr(var[,value])>

This operator decrements a variable and returns the resulting value.

=cut

sub _ini_decr
{ my (undef, $nam, $arg) = @_;
  my ($val, $var);

  # Validate the arguments
  die get_string('NO_SCALAR', $nam)
    unless ref($var = shift(@{$arg})) && $var->is_scalar_lvalue;
  $val = shift(@{$arg}) || $VAL_ONE;
  die get_string('EXTRA_ARG', $nam) if @{$arg};

  # Create the operator
  return bless {
    val  => $val,
    var  => $var,
    _del => \&del_error,
    _fnd => \&find_error,
    _get => \&_get_decr,
    _lft => q{},
    _set => \&set_error,
    _typ => $nam,
    }, 'RDA::Value::Operator';
}

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

  return $slf->{'var'}->decr_value($slf->{'val'}->eval_as_number);
}

=head2 S<incr(var[,value])>

This operator increments a variable and returns the resulting value.

=cut

sub _ini_incr
{ my (undef, $nam, $arg) = @_;
  my ($val, $var);

  # Validate the arguments
  die get_string('NO_SCALAR', $nam)
    unless ref($var = shift(@{$arg})) && $var->is_scalar_lvalue;
  $val = shift(@{$arg}) || $VAL_ONE;
  die get_string('EXTRA_ARG', $nam) if @{$arg};

  # Create the operator
  return bless {
    val  => $val,
    var  => $var,
    _del => \&del_error,
    _fnd => \&find_error,
    _get => \&_get_incr,
    _lft => q{},
    _set => \&set_error,
    _typ => $nam,
    }, 'RDA::Value::Operator';
}

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

  return $slf->{'var'}->incr_value($slf->{'val'}->eval_as_number);
}

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::Text|RDA::Text>,
L<RDA::Value::Operator|RDA::Value::Operator>,
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