use strict
require 5.004;

package Parse::Template;
$Parse::ALex::VERSION = '0.30';

=head1 NAME

Parse::Template - Template Processor (0.30)

=head1 SYNOPSIS

  use Parse::Template;

  my %template = 
    (
     'TOP' =>  q!before %%$self->eval('DATA')%% after!,
     'DATA' => q!Insert data: ! .
               q!1. List: %%"@list$N"%%! .
               q!2. Hash: %%"$hash{'key_value'}$N"%%! .
               q!3. Hash: %%print <FH>%%! .
               q!4. Sub: %%&SUB()$N%%!
    );
 
  my $tmplt = new Parse::Template (%template);
  open FH, "< foo";

  $tmplt->env('var' => '(value!)');
  $tmplt->env('list' => [1, 2, 10], 
              'N' => "\n",
              'FH' => \*FH,
              'SUB' => sub { "->content generated by a sub<-" },
              'hash' => { 'key_value' => q!It\'s an hash value! });
  print $tmplt->eval('TOP'), "\n";

=head1 DESCRIPTION

The C<Parse::Template> class permits evaluating Perl expressions
placed within a template.  The template is a hash passed as an
argument to the C<new()> method :
C<Parse::Template->E<gt>C<new('someKey', '... text with expressions to
evaluate ...')>. This specification permits splitting up a template into
different parts.  Within a part, a sub-part can be including by
means of the expression :

  $self->eval('SUB_PART_NAME')

C<$self> designates the instance of the C<Parse::Template> class.
If you specify only the name of the part, a subroutine with the
name of the part will be automatically defined.  In the example given
in the synopsis, the insertion of the C<TOP> part can be rewritten:

  'TOP' => q!before %%DATA()%%after!

The subroutines can take arguments.

The expressions to be evaluated must be placed within C<%%>, 
and they are evaluated within an environment specific to
each instance of the C<Parse::Template> class.  Each instance
is defined within a specific class that is a subclass of
C<Parse::Template>. This class contains the environment specific
to the template and inherits from the C<Parse::Template> class.

The C<env()> method permits constructing the required evaluation
environment.  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.  A scalar variable containing a reference
is defined by writing C<'var' =>E<gt>C<\$variable>, where C<$variable>
is a lexical variable that contains the reference.

This package was initially created to serve as a code generator
for the C<Parse::Lex> class.  You will find examples of its use
in the classes C<Parse::Lex>, C<Parse::CLex> and C<Parse::Token>.

=head1 METHODS

=over 4

=item new HASH

Constructor for the class. C<HASH> is a hash which defines the
template text.

Example:

	use Parse::Template;
	$t = new Parse::Template('key' => 'associated text');

=item env HASH

=item env SYMBOL

Permits defining the environment that is specific to a template.
C<env(SYMBOL)> returns the reference associated with the symbol,
or C<undef> if the symbol is not defined.  The reference that is
returned is of the type indicated by the character (C<&, $, %, @, *>)
that prefixes the symbol.

Examples:

  $tmplt->env('LIST' => [1, 2, 3])}   Defines a list

  @{$tmplt->env('*LIST')}             Returns the list

  @{$tmplt->env('@LIST')}             Ditto


=item eval PART_NAME

Evaluates the template part designated by C<PART_NAME>. Returns the
string resulting from this evaluation.

=item getPart PART_NAME

Returns the designated part of the template.

=item ppregexp REGEXP

Preprocesses a regular expression so that it can be inserted into
a template where the regular expression delimiter is either the
character "/" or the character "!".

=item setPart PART_NAME => TEXT

A template is defined by a hash (associative array).  C<setPart()>
permits defining a new entry within this hash.

=back

=head1 Examples

See the C<examples> directory included in this distribution.

=head1 NOTES CONCERNING THE CURRENT VERSION

This is an experimental module.  I would be very interested
to receive your comments and suggestions.

=head1 AUTHOR

Philippe Verdret 

=head1 COPYRIGHT

Copyright (c) 1995-1999 Philippe Verdret. All rights reserved.
This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut

use constant DEBUG => 0;	

my $sym = 'Sym000';
sub genSymbol { $sym++ }	# generate: sym000, sym001, sym002, etc.

sub new {
  my $receiver = shift;
  my $class = __PACKAGE__ . '::' . genSymbol();
  my $self; 
  if (@_) {
    $self = bless {@_}, $class;
  } else {
    $self = bless {}, $class;
  }
  no strict;
  @{"${class}::ISA"} = ref $receiver || $receiver;
  %{"${class}::template"} = %{"${class}::template"} = @_ ;
  $self;
}
use vars qw/$AUTOLOAD/;
sub AUTOLOAD {
  my($class, $key) = ($AUTOLOAD =~ /(.*)::(.*)$/);
  print STDERR "[AUTOLOAD:$AUTOLOAD][class:$class][args:@_]\n" if DEBUG;
  eval "package $class; no strict; *{$AUTOLOAD} = sub { \$class->eval('$key', \@_) }";
  goto &$AUTOLOAD;
}
sub DESTROY {
  print STDERR "destroy @_" if DEBUG;
}
use constant TRACE_ENV => 0;
sub env {
  my $self = shift;
  my $class = ref $self || $self;
  my $symbol = shift;
  if ($symbol =~ /\W/) {
    require Carp;
    Carp::croak "invalid symbol name: $symbol"
  }

  no strict;
  if (@_) {
    while (@_) {
      my $value = shift;
      print STDERR "${class}::$symbol\t$value\n" if TRACE_ENV;
      if (ref $value) {
	*{"${class}::$symbol"} = $value;
      } else {			# scalar value
      	*{"${class}::$symbol"} = \$value;
      }
      $symbol = shift if @_;
      if ($symbol =~ /\W/) {
	require Carp;
	Carp::croak "invalid symbol name: $symbol"
      }
    }
  } elsif (defined *{"${class}::$symbol"}) { # borrowed from Exporter.pm
    return \&{"${class}::$symbol"} unless $symbol =~ s/^(\W)//;
    my $type = $1;
    return 
      $type eq '&' ? \&{"${class}::$symbol"} :
	$type eq "\$" ? \${"${class}::$symbol"} :
	    $type eq '@' ? \@{"${class}::$symbol"} :
	    $type eq '%' ? \%{"${class}::$symbol"} :
	    $type eq '*' ?  *{"${class}::$symbol"} :
	    do { require Carp; Carp::croak("Can\'t find symbol: $type$symbol") };
  } else {
    undef;
  }
}
# Purpose:  validate the regexp and replace "!" by "\!", and "/" by "\/"
# Arguments: a regexp
# Returns: the preprocessed regexp
sub ppregexp {
  #  my $self = $_[0]; # useless
  my $regexp = $_[1];
  eval { '' =~ /$regexp/ };
  if ($@) {			
    die "$@";			
  }
  $regexp =~ s{
    ((?:\G|[^\\])(?:\\{2,2})*)	# Context before
    ([/!\"])			# Used delimiters
  }{$1\\$2}xg;
  $regexp;
}
sub getPart {		
  my $self = shift;
  my $part = shift;
  my $class = ref $self || $self;
  no strict 'refs';
  ${"${class}::template"}{$part};
}
sub setPart {		
  my $self = shift;
  my $part = shift;
  my $class = ref $self || $self;
  no strict 'refs';
  ${"${class}::template"}{$part} = shift; 
}

use constant EVAL_TRACE => 0;
use constant SHOW_PART => 0;
use constant SIGN_PART => 1;
my $indent = 0;
sub eval {
  my $self = shift;
  print STDERR "eval(): $self\n" if DEBUG;
  my $class = ref $self || $self;
  my $part = shift;
  if (EVAL_TRACE) {
    print STDERR '..' x $indent, "$part\n";
    $indent++;
  }
  my $code = $self->getPart($part);
  unless (defined $code) {
    die "'$part' template part not defined";
  }
  print STDERR "$code\n" if SHOW_PART;
  if (SIGN_PART) {
    $code =~ s/^/# Template $part {\n/;
    $code =~ s/$/\n# } Template $part\n/;
  }
  local $^W = 0 if $^W;
  $code =~ s{%%(.*?)%%}{	# the magic substitution
    print STDERR "eval 'package $class; $1'\n" if EVAL_TRACE;
    "package $class; $1";
  }eegsx;
  die "$@" if $@;
  if (EVAL_TRACE) {
    $indent--;
  }
  $code;
}
1;
__END__
