File Coverage

lib/Async/Template.pm

Criterion	Covered	Total	%
statement	78	106	73.5
branch	9	26	34.6
condition	8	31	25.8
subroutine	16	24	66.6
pod	0	6	0.0
total	111	193	57.5

package Async::Template;

#! @file
#! @author: Serguei Okladnikov
#! @date 28.09.2012

use 5.010001;
use strict;
use warnings;

our $VERSION = '0.14';

use Async::Template::Parser;
use Async::Template::Grammar;
use Async::Template::Context;
use Async::Template::Directive;

use Template;
use Template::Provider;
$Template::Provider::DOCUMENT = 'Async::Template::Document';



sub new {
   my $self = bless {}, shift;

   $Template::Config::CONTEXT = 'Async::Template::Context';
   $Template::Config::FACTORY = 'Async::Template::Directive';
   $Template::Config::DOCUMENT = 'Async::Template::Document';
   $Template::Config::PROVIDER = 'Async::Template::Provider';

# WARN! TODO: incompatible with original template
# impossible to solve upgrade, Template does not
# recompile unchaged modules, incomptible ...
# $output and \$output need to test mem usage
# about 2 commented string of code below
# not good idea try to solve in process:
#      my $oldoutput = $Template::Directive::OUTPUT;
#      $Template::Directive::OUTPUT = $oldoutput;
# so
      $Template::Directive::OUTPUT = '${$out} .= ';

   my $config = $_[0];

   $self->{DONE} = $config->{DONE};
   if( $config->{BLOCKER} && ! $config->{DONE} ) {
      die 'DONE config options for ' . __PACKAGE__ .
      '->new() must be specified if BLOCKER specified';
   } elsif( ! $config->{BLOCKER} && ! $config->{DONE} ) {
      require 'AnyEvent.pm';
      $self->{_ourblocker} = 1;
      $self->{BLOCKER} = sub {
          $self->{_blockcv}->recv;
      };
      $self->{DONE} = sub {
         my $output = shift;
         $self->{_output} = $output;
         $self->{_blockcv}->send;
      };
   }
   $self->{config} = $config;
   $self->{tt} = Template->new({
      %{ $self->{config} },
      PARSER  => Async::Template::Parser->new(
          %{$config},
          GRAMMAR => Async::Template::Grammar->new( %{$config } ),
          FACTORY => Async::Template::Directive->new( %{$config} ),
      ),
   });
   $self
}

sub process {
   my ($self, $template, $vars, $outstream, @opts) = @_;
   my $options = (@opts == 1) && ref($opts[0]) eq 'HASH'
      ? shift(@opts) : { @opts };
   if( $self->{_ourblocker} ) {
      require 'AnyEvent.pm';
      $self->{_blockcv} = AnyEvent->condvar;
   }
   ( defined $outstream && 'SCALAR' ne ref $outstream  ) &&
      die 'only string ref possible as outstream';
   my $context = $self->{tt}->context();
   $context->event_clear;
   my $outstr = '';
   my $output = defined $outstream && 'SCALAR' eq ref $outstream ?
      $outstream : \$outstr;
   $context->{_event_output} = $output;
   my $cb = $options->{DONE} || $self->{DONE};
   my $event = sub {
      my $context = shift;
      $cb->( ${$context->event_output()} );
   };
   $context->event_push( {
      event => $event,
      output => $output,
      resvar => undef,
   } );
#   eval{
      #return $self->{tt}->process( $template, $vars, $outstream );
      $self->{tt}->context()->process( $template, $vars );
#   };
   return $self->{tt}->error($@)
      if $@;
   $self->{BLOCKER}->()
      if( $self->{BLOCKER} );
   $outstream ||= $self->{tt}->{OUTPUT};
   return 1;
}

sub context {
   $_[0]->{tt}->context()
}

sub output {
   $_[0]->context->event_output()
}

sub error {
   my $self = shift;
   $self->{tt}->error( @_ )
}

# This tt impl give not good perforance
# will be removed or rewrited with
sub tt {
   my $cb = pop;
   my $src = pop;
   my $vars = ( 1==@_ && 'HASH' eq ref $_[0] ) ? $_[0] : {@_};
   my ($out,$err,$res);
   my $msg = 'two param or two elements array only for RESULT() or ERROR()';

   my $saveres = sub {
      if( 2 == @_ ) {
         ( $err, $res ) = ($_[0], $_[1]);
      } elsif( 1 == @_ ) {
         ( $err, $res ) = 'ARRAY' eq ref $_[0] ?
            ($_[0][0], $_[0][1]) : ($msg, $_[0]);
      } else {
         ( $err, $res ) = ($msg, \@_);
      };
   };

   $vars->{ERROR} ||= sub { $saveres->(@_); $err };
   $vars->{RESULT} ||= sub { $saveres->(@_); $res };

   my $tt = Async::Template->new( { DONE => sub {
      $cb->($err,$res,$out);
   } } );
   $src =~ s/(.*)/[%$1%]/s;
   $tt->process( \$src, $vars, \$out );
}

sub import {
   my $package = shift;
   my $caller = caller;
   no strict 'refs';
   if( $_[0] && $_[0] eq 'tt' ) {
     *{$caller.'::tt'} = \&{$package.'::tt'};
   }
}

1;

__END__