EMBED results from the CPAN

Template-EmbeddedPerl

}

sub mtrim {
  my ($self, $string) = @_;
  if ( (Scalar::Util::blessed($string)||'') eq 'Template::EmbeddedPerl::SafeString') {
    $string =~s/^[ \t]+|[ \t]+$//mg;
    return $self->raw($string);
  } else {
    $string =~s/^[ \t]+|[ \t]+$//mg;
  }
  return $string;
}

sub directory_for_package {
  my $self = shift;
  my $class = ref($self) || $self;
  my $package = @_ ? shift(@_) : $class;
 
  $package =~ s/::/\//g;
  my $path = $INC{"${package}.pm"};
  my ($volume,$directories,$file) = File::Spec->splitpath( $path );

  return $directories;
}

sub new {
  my $class = shift;
  my (%args) = (
    open_tag => '<%',
    close_tag => '%>',
    expr_marker => '=',
    line_start => '%',
    sandbox_ns => 'Template::EmbeddedPerl::Sandbox',
    directories => [],
    template_extension => 'epl',
    auto_escape => 0,
    auto_flatten_expr => 1,
    prepend => '',
    preamble => '',
    use_cache => 0,
    vars => 0,
    comment_mark => '#',
    interpolation => 0,
    @_,
  );

  %args = (%args, $class->config,) if $class->can('config');

  my $self = bless \%args, $class;

  $self->inject_helpers;
  return $self;
}

sub inject_helpers {
  my ($self) = @_;
  my %helpers = $self->get_helpers;
  foreach my $helper(keys %helpers) {
    if($self->{sandbox_ns}->can($helper)) {
      warn "Skipping injection of helper '$helper'; already exists in namespace $self->{sandbox_ns}" 
        if $ENV{DEBUG_TEMPLATE_EMBEDDED_PERL};
      next;
    }
    eval qq[
      package @{[ $self->{sandbox_ns} ]};
      sub $helper { \$self->get_helpers('$helper')->(\$self, \@_) }
    ]; die $@ if $@;
  }
}

sub get_helpers {
  my ($self, $helper) = @_;
  my %helpers = ($self->default_helpers, %{ $self->{helpers} || +{} });

  %helpers = (%helpers, $self->helpers) if $self->can('helpers');
 
  return $helpers{$helper} if defined $helper;
  return %helpers;
}

sub default_helpers {
  my $self = shift;
  return (
    raw               => sub { my ($self, @args) = @_; return $self->raw(@args); },
    safe              => sub { my ($self, @args) = @_; return $self->safe(@args); },
    safe_concat       => sub { my ($self, @args) = @_; return $self->safe_concat(@args); },
    html_escape       => sub { my ($self, @args) = @_; return $self->html_escape(@args); },
    url_encode        => sub { my ($self, @args) = @_; return $self->url_encode(@args); },
    escape_javascript => sub { my ($self, @args) = @_; return $self->escape_javascript(@args); },
    trim              => sub { my ($self, $arg) = @_; return $self->trim($arg); },
    mtrim             => sub { my ($self, $arg) = @_; return $self->mtrim($arg); },
    to_safe_string    => sub {
      my ($self, @args) = @_;
      return map {
        Scalar::Util::blessed($_) && $_->can('to_safe_string')
        ? $_->to_safe_string($self)
        : $_;
      } @args;
    },
  );
}

# Create a new template document in various ways

sub from_string {
  my ($proto, $template, %args) = @_;
  my $source = delete($args{source});
  my $self = ref($proto) ? $proto : $proto->new(%args);

  my $digest;
  if($self->{use_cache}) {
    $digest = Digest::MD5::md5_hex($template);
    if(my $cached = $self->{compiled_cache}->{$digest}) {
      return $self->{compiled_cache}->{$digest};
      return bless {
        template => $cached->{template},
        parsed => $cached->{parsed},
        code => $cached->{code},
        yat => $self,
        source => $source,
      }, 'Template::EmbeddedPerl::Compiled';

lib/Template/EmbeddedPerl.pm view on Meta::CPAN

        push @parsed, ['text', $segment];
      }
    } else {
      # Support trim with =%>
      $content = "trim $content" if $close_type eq "${expr_marker}${close_tag}";

      # ?? ==%> or maybe something else...
      # $parsed[-1][1] =~s/[ \t]+$//mg if $close_type eq "${expr_marker}${close_tag}";
 
      # Remove \ from escaped line_start, open_tag, and close_tag
      $content =~ s/\\${line_start}/${line_start}/g;
      $content =~ s/\\${open_tag}/${open_tag}/g;
      $content =~ s/\\${close_tag}/${close_tag}/g;
      $content =~ s/\\${expr_marker}${close_tag}/${expr_marker}${close_tag}/g;

      if ($open_type eq "${open_tag}${expr_marker}") {
        push @parsed, ['expr', tokenize($content)];
      } elsif ($open_type eq $open_tag) {
        push @parsed, ['code', tokenize($content)];
      }
    }
  }

  return @parsed;
}

sub compile {
  my ($self, $template, $source, @parsed) = @_;

  my $compiled = '';
  my $safe_or_not = '';
  my $flatten_or_not = '';

  if($self->{auto_escape} && $self->{auto_flatten_expr}) {
    $safe_or_not = ' safe_concat to_safe_string ';
  } else {
    $safe_or_not = $self->{auto_escape} ? ' safe to_safe_string ' : '';
    $flatten_or_not = $self->{auto_flatten_expr} ? ' join "", ' : '';
  }

  for my $block (@parsed) {
    next if $block eq '';
    my ($type, $content, $has_unmatched_open, $has_unmatched_closed) = @$block;

    if ($type eq 'expr') { # [[= ... ]]
      $compiled .= '$_O .= ' . $flatten_or_not . $safe_or_not . $content . ";";
    } elsif ($type eq 'code') { # [[ ... ]]
      $compiled .= $content . ";";
    } else {
      # if \\n is present in the content, replace it with ''
      my $escaped_newline_start = $content =~ s/^\\\n//mg;
      my $escaped_newline_end = $content =~ s/\\\n$//mg;

      $content =~ s/^\\\\/\\/mg;   
      $compiled .= "@{[$escaped_newline_start ? qq[\n]:'' ]} \$_O .= \"" . quotemeta($content) . "\";@{[$escaped_newline_end ? qq[\n]:'' ]}";
    }
  }

  $compiled = $self->compiled($compiled);

  warn "Compiled: $compiled\n" if $ENV{DEBUG_TEMPLATE_EMBEDDED_PERL};

  my $code = eval $compiled; if($@) {
    die generate_error_message($@, $template, $source);
  }

  return $code;
}

sub compiled {
  my ($self, $compiled) = @_;
  my $wrapper = "package @{[ $self->{sandbox_ns} ]}; ";
  $wrapper .= "use strict; use warnings; use utf8; @{[ $self->{preamble} ]}; ";
  $wrapper .= "sub { my \$_O = ''; @{[ $self->{prepend} ]}; ${compiled}; return \$_O; };";
  return $wrapper;
}

sub tokenize {
  my $content = shift;
  my $document = PPI::Document->new(\$content);
  my ($has_unmatched_open, $has_unmatched_closed) = mark_unclosed_blocks($document);
  return ($document, $has_unmatched_open, $has_unmatched_closed);
}

sub mark_unclosed_blocks {
  my ($element) = @_;
  my $blocks = $element->find('PPI::Structure::Block');
  my $has_unmatched_open = mark_unclosed_open_blocks($element); 
  my $has_unmatched_closed = mark_unmatched_close_blocks($element);

  return ($has_unmatched_open, $has_unmatched_closed);
}

sub is_control_block {
  my ($block) = @_;

  # Get the parent of the block
  my $parent = $block->parent;

  # Check if the parent is a control statement
  if ($parent && ($parent->isa('PPI::Statement::Compound') || $parent->isa('PPI::Statement'))) {
    my $keyword = $parent->schild(0); # Get the first child of the statement, which should be the control keyword
    if ($keyword && $keyword->isa('PPI::Token::Word')) {
      # Check if the keyword is a control structure keyword
      return 1 if $keyword->content =~ /^(if|else|elsif|while|for|foreach|unless|given|when|until)$/;
    }
  }

  return 0;
}

sub mark_unclosed_open_blocks {
  my ($element, $level) = @_;
  my $blocks = $element->find('PPI::Structure::Block');
  return unless $blocks;

  my $has_unmatched_open = 0;
  foreach my $block (@$blocks) {
    next if $block->finish; # Skip if closed
    next if is_control_block($block);
    $has_unmatched_open = 1;

lib/Template/EmbeddedPerl.pm view on Meta::CPAN


=over 4

=item * C<raw>

Returns a string as a safe string object without escaping.   Useful if you
want to return actual HTML to your template but you better be 
sure that HTML is safe.

    <%= raw '<a href="http://example.com">Example</a>' %>

=item * C<safe>

Returns a string as a safe html escaped string object that will not be 
escaped again.

=item * C<safe_concat>

Like C<safe> but for multiple strings.  This will concatenate the strings into
a single string object that will not be escaped again.

=item * C<html_escape>

Escapes HTML entities in a string.  This differs for C<safe> in that it will
just do the escaping and not wrap the string in a safe string object.

=item * C<url_encode>

Encodes a string for use in a URL.

=item * C<escape_javascript>

Escapes JavaScript entities in a string. Useful for making strings safe to use
 in JavaScript.

=item * C<trim>

Trims leading and trailing whitespace from a string.

=back

=head1 ERROR HANDLING

If an error occurs during template compilation or rendering, the module will
throw an exception with a detailed error message. The error message includes
the source of the template, the line number, and the surrounding lines of the
template to help with debugging.  Example:

Can't locate object method "input" at /path/to/templates/hello.yat line 4.

  3:     <%= label('first_name') %>
  4:     <%= input('first_name') %>
  5:     <%= errors('last_name') %>

=head1 ENVIRONMENT VARIABLES

The module respects the following environment variables: 

=over 4

=item * C<DEBUG_TEMPLATE_EMBEDDED_PERL>

Set this to a true value to print the compiled template code to the console. Useful
when trying to debug difficult compilation issues, especially given this is early
access code and you might run into bugs.

=back

=head1 REPORTING BUGS & GETTING HELP

If you find a bug, please report it on the GitHub issue tracker at
L<https://github.com/jjn1056/Template-EmbeddedPerl/issues>.  The bug tracker is
the easiest way to get help with this module from me but I'm also on irc.perl.org
under C<jnap>.

=head1 DEDICATION

This module is dedicated to the memory of my dog Bear who passed away on 17 August 2024.
He was a good companion and I miss him.

If this module is useful to you please consider donating to your local animal shelter
or rescue organization.

=head1 AUTHOR

John Napiorkowski, C<< <jjnapiork@cpan.org> >>

=head1 LICENSE AND COPYRIGHT

This library is free software; you can redistribute it and/or modify it under the
same terms as Perl itself.

=cut


__END__

%= join '', map {
  <p>%= $_</p>
} @items;
% my $X=1; my $bb = join '', map {
  <p>%= $_</p>
} @items;
% if(1)
  <span>One: %= ttt</span>
}
% my $a=[1,2,3]; foreach my $item (sub { @items }->()) {
  foreach my $index (0..2) {
    foreach my $i2 (2..3) {
    <div>
      %= $item.' '.$index. ' '.$i2
    </div>
  }}
  %= sub {
    <p>%= "A: @{[ $a->[2] ]}" %%</p>
  }->();
}
%= "BB: $bb"

( run in 1.583 second using v1.01-cache-2.11-cpan-71847e10f99 )