# Template.pm: Class Used for Processing Templates

package RDA::Driver::Template;

# $Id: Template.pm,v 1.4 2015/05/08 18:09:24 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/RDA/Driver/Template.pm,v 1.4 2015/05/08 18:09:24 RDA Exp $
#
# Change History
# 20150508  MSC  Improve the documentation.

=head1 NAME

RDA::Driver::Template - Class Used for Processing Templates

=head1 SYNOPSIS

 require RDA::Driver::Template;

=head1 DESCRIPTION

The C<RDA::Driver::Template> class allows evaluating tags placed within a
text.

The principle of template-based text generation is simple. A template consists
of a text, which includes tagged areas with expressions to be
evaluated. Interpretation of these expressions generates text fragments that
are substituted in place of the tags.

With the C<RDA::Driver::Template> class, a template can be decomposed into
parts. These parts are defined by a hash passed as an argument to the C<new()>
method.

The C<eval_part> method allows to resolve the tagged areas. For example,

 $slf->eval_part('LEX_PART_NAME')

C<$slf> designates the instance of the C<RDA::Driver::Template> class.

The C<set_context()> method allows constructing the environment required for
the evaluation of a template. Each entry to be defined within the environment
must be specified using a key consisting of the name of the symbol to be
created, associated with a reference whose type is that of the created entry
(for example, a reference to an array to create an array). A scalar variable is
defined by declaring a name for the variable, associated with its value.

The part text can contain tags referring to other part names of to context
entries.

=over 2

=item *

A word prefixed by C<#> represents a part name.

=item *

A word prefixed by C<&> represents context value. When the entry is missing,
it returns an undefined value.

=item *

A word prefixed by C<@&> represents context reference. When the entry is
missing, it returns a reference to an empty array.

=item *

A word prefixed by C<%&> represents context reference. When the entry is
missing, it returns a reference to an empty associative array.

=back

For example,

 LEX_HEADER => q{%%&FROM_STRING ? #LEX_HEADER_STRING : #LEX_HEADER_STREAM%%}

The following methods are available:

=cut

use strict;

BEGIN
{ use Exporter;
  use RDA::Text qw(debug get_string);
}

# Define the global public variables
use vars qw($SIGN_BEGIN $SIGN_END $STRINGS $VERSION @ISA);
$SIGN_BEGIN    = "# Template %s {\n";
$SIGN_END      = "# } Template %s\n";
$VERSION       = sprintf('%d.%02d', q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/);
@ISA           = qw(Exporter);

# Define the global private constants
my $SIGN_PART     = 1;
my $TRACE_PART    = 2;
my $TRACE_CONTEXT = 4;
my $TRACE_EVAL    = 8;

# Define the global private variables
my $indent = 0;

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

=head2 S<$h-E<gt>new(%parts)>

Object constructor. This method takes the part definition hash as an argument.

It is represented by a blessed hash reference. The following special keys are
used:

=over 12

=item S<    B<'_cod'> > Part hash

=item S<    B<'_ctx'> > Context hash

=back

Internal keys are prefixed by an underscore.

=cut

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

  return bless {
    _cod => {@arg},
    _ctx => {},
    }, ref($cls) || $cls;
}

=head2 S<$h-E<gt>eval_part($name)>

This method evaluates the specified template part and returns the string
resulting from this evaluation.

=cut

sub eval_part
{ my ($slf, $nam) = @_;
  my ($cod, $lvl, $off);

  $lvl = $slf->{'_lvl'};
  debug($off = q{..} x ++$indent, qq{Eval part $nam})
    if $lvl & $TRACE_EVAL;                  ## no critic (Bit)

  die get_string('BAD_PART', $nam) unless exists($slf->{'_cod'}->{$nam});
  $cod = $slf->{'_cod'}->{$nam};

  debug($cod) if $lvl & $TRACE_PART;  ## no critic (Bit)
  if ($lvl & $SIGN_PART)                    ## no critic (Bit)
  { $cod =~ s{^}{sprintf($SIGN_BEGIN, $nam)}e;
    $cod =~ s{$}{sprintf($SIGN_END,   $nam)}e;
  }
  $cod =~ s{%%(.*?)%%}{_eval_expr($slf, $1, $off)}egsx;
  die $@ if $@;
  $indent-- if $off;

  # Return the resulting code
  return $cod;
}

sub _eval_expr
{ my ($slf, $str, $off) = @_;

  debug($off, qq{eval '$str'}) if $off;
  $str =~ s{\#([A-Z]+(_[A-Z]+)*)\b}{\$slf->eval_part('$1')}g;
  $str =~ s{(\@)\&([A-Z]+(_[A-Z]+)*)\b}{$1\{\$slf->get_ref('$2',[])\}}g;
  $str =~ s{(\%)\&([A-Z]+(_[A-Z]+)*)\b}{$1\{\$slf->get_ref('$2',{})\}}g;
  $str =~ s{\&([A-Z]+(_[A-Z]+)*)\b}{\$slf->get_value('$1')}g;
  debug($off, qq{exec '$str'}) if $off;
  $str = eval qq{$str};  ## no critic (Eval)
  return defined($str) ? $str : q{};
}

# Get a context reference
sub get_ref
{ my ($slf, $nam, $dft) = @_;

  return exists($slf->{'_ctx'}->{$nam})
    ? $slf->{'_ctx'}->{$nam}
    : $dft;
}

# Get a context value
sub get_value
{ my ($slf, $nam, $dft) = @_;

  return exists($slf->{'_ctx'}->{$nam})
    ? ${$slf->{'_ctx'}->{$nam}}
    : $dft;
}

=head2 S<$h-E<gt>set_context($level,%definitions)>

This method defines the trace level and the evaluation context for the
template.

=cut

sub set_context
{ my ($slf, $lvl, @arg) = @_;
  my ($cls, $nam, $trc);

  # Update the trace level
  $trc = ($slf->{'_lvl'} = $lvl) & $TRACE_CONTEXT;  ## no critic (Bit)

  # Update the context
  while (defined($nam = shift(@arg)))
  { die get_string('BAD_SYMBOL', $nam) if $nam =~ /\W/;
    my $val = shift(@arg); # Need another variable for each key
    debug(qq{\t$nam\t$val}) if $trc;
    if (ref($val))
    { $slf->{'_ctx'}->{$nam} = $val;
    }
    else
    { $slf->{'_ctx'}->{$nam} = \$val;
    }
  }

  # Return the object reference
  return $slf;
}

=head2 S<$h-E<gt>val_re($pattern)>

This method validates a regular expression and transforms it to allow its
insertion into a template where the regular expression delimiter is either
a C</> or a C<!>.

=cut

sub val_re
{ my ($slf, $pat) = @_;

  eval { q{} =~ m/$pat/ };
  die $@ if $@;
  $pat =~ s{
    ((?:\G|[^\\])(?:\\{2,2})*) # Context before
    ([/!\"])                   # Used delimiters
    }{$1\\$2}xg;
  return $pat;
}

1;

__END__

=head1 SEE ALSO

L<RDA::Agent|RDA::Agent>,
L<RDA::Object|RDA::Object>,
L<RDA::Object::Lex|RDA::Object::Lex>,
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