# Action.pm: Class Used to Manage Action-Based Lexical Units

package RDA::Token::Action;

# $Id: Action.pm,v 1.3 2015/05/05 13:05:49 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/Token/Action.pm,v 1.3 2015/05/05 13:05:49 RDA Exp $
#
# Change History
# 20150505  MSC  Improve the documentation.

=head1 NAME

RDA::Token::Action - Class Used to Manage Action-Based Lexical Units

=head1 SYNOPSIS

 require RDA::Token::Action;

=head1 DESCRIPTION

The objects of the C<RDA::Token::Action> class are used to manage action-based
lexical units. It is a subclass of L<RDA::Object::Token|RDA::Object::Token>.

The following methods are available:

=cut

use strict;

BEGIN
{ use Exporter;
  use RDA::Text qw(get_string);
  use RDA::Driver::Template;
  use RDA::Object;
  use RDA::Object::Token;
}

# Define the global public variables
use vars qw($STRINGS $VERSION @DUMP @ISA %SDCL);
$VERSION = sprintf('%d.%02d', q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/);
@DUMP    = (
  hsh => {'RDA::Token::Action'  => 1,
          'RDA::Token::Complex' => 1,
          'RDA::Token::Quoted'  => 1,
          'RDA::Token::Simple'  => 1,
         },
  );
@ISA     = qw(RDA::Object::Token RDA::Object Exporter);
%SDCL    = (
  inc => [qw(RDA::Object::Token RDA::Object)]
  );

# Define the global private constants
my $TEMPLATE = RDA::Driver::Template->new(
  ## no critic (Interpolation,Newline)
  LEX_EXPRESSION => q!
    %%#CONDITION%%
    %%#EXPRESSION%%
  !
  );

# Define the global private variables

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

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

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

C<RDA::Token::Action> 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' > > Symbolic name

=item S<    B<'_act'> > Associated sub

=item S<    B<'_cnd'> > Associated conditions

=item S<    B<'_det'> > Token decoration

=item S<    B<'_exp'> > For an action token

=item S<    B<'_lex'> > Lexical analyzer instance

=item S<    B<'_pat'> > Regular expression (can be an array reference)

=item S<    B<'_sta'> > Object status

=item S<    B<'_tpl'> > Associated template

=item S<    B<'_txt'> > Recognized text

=back

Internal keys are prefixed by an underscore.

=cut

sub new
{ my ($cls, @arg) = @_;
  my ($exp, $nam, $slf);

  die get_string('NO_DEFINITION') if @arg < 2;
  ($nam, $exp) = _parse(@arg);
  $slf = $cls->SUPER::new($nam, q{}, q{}, q{}, $exp);
  $slf->set_template($TEMPLATE);
  return $slf;
}

sub _parse
{ my ($exp, $key, $nam, $val);

  while (($key, $val) = splice(@_, 0, 2))
  { next unless defined($key);
    if ($key =~ /-?[Nn]ame/)
    { $nam = $val;
    }
    elsif ($key =~ /^-?[Ee]xpr$/)
    { $exp = $val;
    }
    else
    { last;
    }
  }
  return ($nam, $exp);
}

# Generate the code
sub gen_code
{ my ($slf) = @_;
  my ($cod, $tpl);

  $tpl = $slf->get_template;
  $tpl->set_context($slf->{'lvl'},
    CONDITION  => $slf->get_lexer->gen_condition($slf->get_condition),
    EXPRESSION => $slf->get_expression,
    );
  eval {$cod = $tpl->eval_part('LEX_EXPRESSION')};
  die $@ if $@;
  return $cod;
}

1;

__END__

=head1 SEE ALSO

L<RDA::Agent|RDA::Agent>,
L<RDA::Driver::Template|RDA::Driver::Template>,
L<RDA::Object|RDA::Object>,
L<RDA::Object::Token|RDA::Object::Token>,
L<RDA::Text|RDA::Text>

=head1 COPYRIGHT NOTICE

Copyright (c) 1996, 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