view release on metacpan or  search on metacpan

lib/HTML/YaTmpl.pm  view on Meta::CPAN

}

sub _eval_control {
  my $I=shift;
  my $v=shift;
  my $el=shift;
  my $h=shift;

  if( 0==length $el->[1] ) {	# <: code />
    #my $rc=$I->_eval_v( $v, $el, $h );
    #use Data::Dumper; warn "$el->[1]: ", Dumper( $rc );
    #return $rc;
    return $I->_eval_v( $v, $el, $h );
  } elsif( $el->[1] eq 'include' ) {
    my $file;
    foreach my $f (@{$el->[2]}) {
      if( !ref($f) and length($f) ) {
	$file=$I->_eval_list( $v, $h, $I->_parse_cached($f) );
	last;
      }
    }
    my $nh=+{$I->_make_include_param_list( $v, $el, $h )};
    my ($sv_file, $sv_eprefix, $sv_template)=
      ($I->file, $I->eprefix, $I->template); # save
    $I->file=$file;
    $I->eprefix=join( ' ', $I->eprefix, "While including $file" );
    defined($I->open) or do {
      ($I->file, $I->eprefix, $I->template)=
	($sv_file, $sv_eprefix, $sv_template); # restore
      return $I->_report_error( "<:include $file>", "$!" );
    };

    my $rc=eval {
      $I->_eval_list( $v, $nh, $I->_parse_cached( defined($I->template)
						  ? $I->template
						  : '' ) );
    };
    my $msg=$@;
    undef $@;

    ($I->file, $I->eprefix, $I->template)=
      ($sv_file, $sv_eprefix, $sv_template); # restore

    die $msg if( $msg );	# propagate

    return $rc;
  } elsif( $el->[1] eq 'for' ) {
    my $nh=+{$I->_make_include_param_list( $v, $el, $h )};
    #warn "FOR FOR FOR: ";
    #use Data::Dumper; warn Dumper($nh);
    return $I->_eval_list( $v, $nh, $I->__get_code_list($el) );
  } elsif( $el->[1] eq 'm' or $el->[1] eq 'macro' ) { # invoke macro
    my $macro;
    foreach my $f (@{$el->[2]}) {
      if( !ref($f) and length($f) ) {
	$macro=$I->_eval_list( $v, $h, $I->_parse_cached($f) );
	last;
      }
    }
    unless( exists $I->_macros->{$macro} ) {
      return $I->_report_error( "<:macro $macro>", "Macro not defined" );
    }
    $macro=$I->_macros->{$macro};
    my $nh=+{$I->_make_include_param_list( $v, $el, $h )};
    #warn "M M M: ";
    #use Data::Dumper; warn Dumper($nh);
    return $I->_eval_list( $v, $nh, @{$macro} );
  } elsif( $el->[1] eq 'eval' ) {
    my $nh=+{$I->_make_include_param_list( $v, $el, $h )};
    my $new_tmpl=$I->_eval_list( $v, $nh, $I->__get_code_list($el) );
    #warn "new_tmpl: $new_tmpl\n";
    #use Data::Dumper; warn Dumper($nh);
    return $I->_eval_list( $v, $h, $I->_parse_cached( defined $new_tmpl
						      ? $new_tmpl
						      : '' ) );
  } elsif( $el->[1] eq 'cond' ) {
    my $vdecl='';
    foreach my $x (@{$el->[2]}) {
      unless( ref($x) ) {
	$vdecl.=q{my $}.$x.q(=$_->[2]->{').$x.q('}; );
      }
    }
    foreach my $c ($I->_parse_cached( defined $el->[3] ? $el->[3] : '' )) {
      if( $c->[0] eq ':' and
	  ($c->[1] eq '' or $c->[1] eq 'case') ) {
	my $eval=$c->[5];
	$eval=~s/\\(.)|"/$1/g;              #";#
	$eval="$vdecl $eval";
	if( $I->__eval_cached( $eval, $v, $h, 1 ) ) {
	  return $I->_eval_list( $v, $h, $I->__get_code_list($c) )
	}
      }
    }
  } elsif( $el->[1] eq 'set' ) {
    my $name;
    foreach my $f (@{$el->[2]}) {
      next if( ref($f) );
      $name=$f;
      last;
    }
    my @l=$I->_make_one_param( $v, $el, $h, [$name=>$el->[3]] );
    $h->{$l[0]}=$l[1];
  } elsif( $el->[1] eq 'defmacro' ) { # define macro
    my $macro;
    foreach my $f (@{$el->[2]}) {
      if( !ref($f) and length($f) ) {
	$macro=$I->_eval_list( $v, $h, $I->_parse_cached($f) );
	last;
      }
    }
    $I->_macros->{$macro}=[$I->__get_code_list($el)];
  }
  return;
}

sub _make_one_param {
  my $I=shift;
  my $v=shift;
  my $el=shift;
  my $h=shift;
  my $p=shift;