5
\$\begingroup\$

I know I never have to reinvent the wheel, but I did, because I need speed performance, also I need this features:

  • introspection or metaprogramming
  • actuate like api backend
  • private variables interpolation
  • embedded perl code inside template like text template
  • avoid in the minimal no core modules
  • work with eval in environment secure (Eval::Closure)
  • have block or macros to procces behavior like subroutines when you used block html and code perl

Template::Toolkit, has almost all features listed above but is slow

Is this code good?

package Myapp::Template;
use strict;
use warnings;

use Eval::Closure;
use B qw( perlstring );
use Carp qw( confess );

sub new {
    my $class = shift;
    return bless {}, $class;
}

sub parser {
   my ($self, $html_file, $hash ) = @_;

   my @delims =  qw( [% %] );
   my $regexp = join('|', map quotemeta($_), @delims);

   my @code;
   push @code, 'sub {';
   push @code, 'my $OUT = q();';
   map { push @code,  'my $'.$_.' = "'.$hash->{$_}.'"; ' } (keys %{$hash} );

   my @parts  = split /($regexp)/, $html_file;
   my $mode = 'text';
   while (@parts) {

     my $next = shift @parts;

     if ($next eq $delims[0]) {
       $mode = ($mode eq 'text') ? 'code' : confess("Impossible state");
       next;
     }
     if ($next eq $delims[1]) {
       $mode = ($mode eq 'code') ? 'text' : confess("Impossible state");
       next;
     }

     if ($mode eq 'text') {
       $code[-1] .= sprintf('$OUT .= %s;', perlstring($next));
     }
     elsif ($next =~ /\A=/) {
       $next =~ s/(\(\)|\(\s+?\))/\($self->{id_plugin}\)/g if exists $self->{id_plugin};
       $code[-1] .= sprintf('$OUT .= do { %s };', unpack("x1A*", $next), );
     }
     elsif ($next =~ /\A\sBLOCK/) {
       my $theblock = "sub " . unpack("x6A*", $next) . ' { my $OUT; ';
       $code[-1] .= sprintf(" %s;", $theblock);
     }
     elsif ($next =~ /\A\sPROCESS/) {
       my $runsub =  unpack("x8A*", $next);
       $code[-1] .= sprintf('$OUT .= %s;',  $runsub . "();");
     }
     elsif ($next =~ /\A\sEND/) {
       my $theblock = 'return $OUT; } ';
       $code[-1] .= sprintf(" %s;", $theblock);
     }
     else {
       $code[-1] .= sprintf(" %s;", $next);
     }

   }

   push @code, '$OUT;';
   push @code, '}';

   my ($thecode) = \@code;
   return eval_closure( source => $thecode )->();

}

sub get_blocks {
  my $self = shift;
  my $html_file = shift;
  my $thisblock = shift;
  my $id_plugin = shift;

  if (!defined $thisblock){
    my @blocks = $html_file =~ /(?>BLOCK\s+)(\w+)/g;
    return join "<br>", (@blocks);
  }
  else{

    $self->{id_plugin} = $id_plugin;
    my @blockprocess;
    my @main_block;

    my $check_block = sub {
      my $the_block = shift;

      for (split /\n/, $html_file) {

           if (/(?>BLOCK\s+)($the_block)/../(END)/){
             push @blockprocess, $1 if $_ =~ /(?>PROCESS\s+)(\w+)/;
             push @main_block, $_;
           }

      }

    };

    $check_block->($thisblock);
    map{ $check_block->($_) } @blockprocess;

    push @main_block, "[% PROCESS $thisblock %]";
    my $allbkocks = join "", @main_block;
    return  $self->parser($allbkocks);
  }

}


1;

Example html with block and process

 [% BLOCK function_sub %]
 <div class="box">example</div>
 [% use Module::Runtime;
 my $var = 'this is not printing here';
 %]<div class="another">bla</div>
 [%= $var; #print %] 
 [% END %]

<div class="dashboard widgetBox">
   <div class="widgetTopBar">
       [% PROCESS function_sub %]          
   </div>

</div>
\$\endgroup\$
  • \$\begingroup\$ Can you give an example of how you use the code in a Perl script? \$\endgroup\$ – Håkon Hægland Apr 30 at 8:51

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.