view release on metacpan or  search on metacpan

lib/DBIx/DR/PerlishTemplate.pm  view on Meta::CPAN

use utf8;
use strict;
use warnings;

package DBIx::DR::PerlishTemplate;
use Mouse;
use Carp;
use Scalar::Util;
use DBIx::DR::ByteStream;

has     line_tag        => (is => 'rw', isa => 'Str',   default => '%');
has     open_tag        => (is => 'rw', isa => 'Str',   default => '<%');
has     close_tag       => (is => 'rw', isa => 'Str',   default => '%>');
has     quote_mark      => (is => 'rw', isa => 'Str',   default => '=');
has     immediate_mark  => (is => 'rw', isa => 'Str',   default => '==');

has     sql             => (is => 'ro', isa => 'Str',   default => '');
has     variables       => (is => 'ro', isa => 'ArrayRef');

has     template        => (is => 'rw', isa => 'Str',   default => '');
has     template_file   => (is => 'rw', isa => 'Str',   default => '');

has     stashes         => (is => 'ro', isa => 'ArrayRef');
has     pretokens       => (is => 'ro', isa => 'ArrayRef');
has     prepretokens    => (is => 'ro', isa => 'ArrayRef');
has     parsed_template => (is => 'ro', isa => 'Str',   default => '');
has     namespace       => (is => 'rw', isa => 'Str',
                        default => 'DBIx::DR::PerlishTemplate::Sandbox');


has sql_utf8     => (is => 'ro', isa => 'Bool', default => 1);
sub _render {
    my ($_PTPL) = @_;
    my $_PTSUB;

    unless ($_PTPL->parsed_template) {
        $_PTSUB = $_PTPL->{parsed_template} = $_PTPL->_parse;
    } else {
        $_PTSUB = $_PTPL->parsed_template;
    }

    $_PTPL->{parsed_template} = $_PTSUB;

    my $esub = eval $_PTSUB;
    if (my $e = $@) {
        my $do_croak;
        my $template;
        if ($_PTPL->template_file) {
            $template = $_PTPL->template_file;
        } else {
            $do_croak = 1;
            $template = 'inline template';
        };
        $e =~ s{ at .*?line (\d+)(\.\s*|,\s+.*?)?$}
            [" at $template line " . ( $1 - $_PTPL->pre_lines )]gsme;

        if ($1) {
            $e =~ s/\s*$/\n/g;
            die $e unless $do_croak;
            croak $e;
        }

        croak "$e at $template";
    }

    $_PTPL->{sql} = '';
    $_PTPL->{variables} = [];

    $esub->( @{ $_PTPL->stashes } );
    1;
}

sub render {
    my ($self, $tpl, @args) = @_;
    $self->{parsed_template} = '';
    $self->template($tpl);
    $self->template_file('');
    $self->{stashes} = \@args;
    $self->clean_namespace;
    return $self->_render;
}

sub render_file {
    my ($self, $file, @args)  = @_;
    croak "File '@{[ $file // 'undef' ]}' not found or readable"