File Coverage

blib/lib/Text/Template/Library.pm

Criterion	Covered	Total	%
statement	99	101	98.0
branch	31	42	73.8
condition	3	5	60.0
subroutine	14	14	100.0
pod	4	4	100.0
total	151	166	90.9

package Text::Template::Library;

use 5.008008;
use strict;
use warnings;

use Text::Template::Base ();
our @ISA=('Text::Template::Base');

use Carp qw/croak/;
use Class::Member::HASH qw/_library _output _evalcache _broken _broken_arg
			   _prepend _filename/;

use Exporter qw/import/;
our @EXPORT_OK=qw/fill_in_module/;

our $VERSION = '0.04';

sub _acquire_data {
  my $I=shift;

  return 1 if( $I->{DATA_ACQUIRED} );

  $I->_library={};

  my $rc=$I->Text::Template::Base::_acquire_data(@_);
  return unless( defined $rc );

  # NOTE: all variables used in (?{}) regexps must be real globs.
  # $c1 counts newlines up to the opening delimiter plus a possible newline
  # after the "define" line
  # $c2 counts newlines inside the definition and after it
  our ($lineno, $start_of_macro, $c1, $c2, $nl_per_delim);
  local ($lineno, $start_of_macro, $c1, $c2)=(1,0,0,0);

  my @delim=@{$I->{DELIM} || [qw/{ }/]};
  local $nl_per_delim=($delim[0]=~tr/\n//)+($delim[1]=~tr/\n//);

  use re 'eval';
  my $sp=qr/[\x20\t\r\f]+/;	           # \s without newline
  my $re=qr!(?sxm)                         # pattern modifiers same as //sxm
            (?{$c1=$c2=0})                 # init
            ((?:\n(?{local $c1=$c1+1})     # count newlines
              |.)*?)                       #   all stuff up to DELIM1 is \$1
            \Q$delim[0]\E $sp              # now we match [% define NAME %]: opening [%
            define $sp (\w+) $sp           #   define NAME (\$2)
            \Q$delim[1]\E                  #   closing %]
            (?:\s*?                        # spaces up to the first newline
             \n(?{local $c1=$c1+1}))?      #   are skipped
            ((?:\n(?{local $c2=$c2+1})     # count newlines to \$c2
              |.)*?)                       #   and save the macro to \$3
            \Q$delim[0]\E $sp              # now we match [% /define NAME %]: opening [%
            /define $sp                    #   /define
            \Q$delim[1]\E                  #   closing %]
            (?:\n(?{local $c2=$c2+1})      # count newlines
             |\s)*                         #   spaces after DELIM2
            (?{                            # save counters
                $start_of_macro=$lineno+$c1+$nl_per_delim;
                $lineno=$start_of_macro+$c2;
              })
           !;
  $I->{SOURCE}=~s/$re/
    if( exists $I->_library->{$2} ) {
      my $t=$I->{FILENAME} || 'template';
      warn "Template Library module $1 redefined at $t line $start_of_macro";
    }
    $I->_library->{$2}="$delim[0]#line $start_of_macro$delim[1]$3";
    "$1$delim[0]#line $lineno$delim[1]"/ge;

  return $rc;
}

sub fill_in {
  my $I=shift;

  croak "DELIMITERS are not allowed here"
    if( defined Text::Template::Base::_param('delimiters', @_) );

  croak "Safe comartments are not supported"
    if( defined Text::Template::Base::_param('safe', @_) );

  unless( $I->{TYPE} eq 'PREPARSED' ) {
    $I->compile or return undef;
  }

  my $varhash=Text::Template::Base::_param('hash', @_);
  my $package=Text::Template::Base::_param('package', @_) ;

  for my $name (qw/output evalcache broken broken_arg prepend filename/) {
    my $f="_$name";
    my $rc=$I->$f=Text::Template::Base::_param($name, @_);
  }

  unshift @_, $I;

  local *T=\$I;
  unless( defined $package or defined $varhash ) {
    my $package=caller;
    push @_, PACKAGE=>$package;
  }

  # cannot use "goto &fill_in" here because of "local *T"
  return &Text::Template::Base::fill_in;   # pass @_ indirectly
}

sub _probearg {
  my ($I, $name)=@_;
  my $f="_$name";
  my $rc=$I->$f;
  defined $rc and return (uc($name)=>$rc);
  $name=uc $name;
  if( exists $I->{$name} ) {
    $rc=$I->{$name};
    defined $rc and return ($name=>$rc);
  }
  return;
}

sub module {
  my ($I, $name)=@_;

  croak "Template Library module $name doesn't exist"
    unless( exists $I->_library->{$name} );

  my $tmpl=$I->_library->{$name};
  unless( ref($tmpl) ) {
    $tmpl=$I->_library->{$name}=Text::Template::Base->new
      (TYPE=>'STRING', SOURCE=>$tmpl,
       map( {$I->_probearg($_)} qw/evalcache broken
				   prepend filename/ ),
       (defined $I->{DELIM} ? (DELIMITERS=>$I->{DELIM}) : ()));
    croak "Template Library module $name failed to compile: $Text::Template::Base::ERROR"
      unless $tmpl->compile;
  }

  return $tmpl;
}

sub library {
  my ($I, $name, @p)=@_;

  my $rc=$I->module($name)->fill_in(
				    PACKAGE=>scalar caller,
				    do {
				      local $_;
				      map( {$I->_probearg($_)}
					   qw/output evalcache broken
					      broken_arg prepend filename/ )
				    },
				    @p,
				   );

  # I want the template to be able to do:
  #   $OUT.=$Text::Template::Library::T->library($module);
  # That means we must return the resulting string if no OUTPUT option
  # was given. But if an OUTPUT option was given we must return an
  # emtpy string.
  # Hence, we have to throw an exception on error.
  croak "Template Library module $name failed: $Text::Template::Base::ERROR"
    unless( $rc );
  return '' if( $I->_output );
  return $rc;
}

sub fill_in_module {
  my ($name, @p)=@_;

  our $T;
  croak "No current template" unless( defined $T );
  my $rc=$T->module($name)->fill_in(
				    PACKAGE=>scalar caller,
				    do {
				      local $_;
				      map( {$T->_probearg($_)}
					   qw/output evalcache broken
					      broken_arg prepend filename/ )
				    },
				    @p,
				   );

  # I want the template to be able to do:
  #   $OUT.=Text::Template::Library::fill_in_module($module);
  # That means we must return the resulting string if no OUTPUT option
  # was given. But if an OUTPUT option was given we must return an
  # emtpy string.
  # Hence, we have to throw an exception on error.
  croak "Template Library module $name failed: $Text::Template::Base::ERROR"
    unless( $rc );
  return '' if( $T->_output );
  return $rc;
}

1;
__END__